aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorYuuki Harano2021-01-10 18:49:51 +0900
committerYuuki Harano2021-01-10 18:49:51 +0900
commitaac33a8074c41354ffdb1236a342da16dca4a1bc (patch)
tree3a99478549f66d3f93a282e29d2c302995a86a49
parent78fd106653a9e4fa7c9c3c9788540e2e15552254 (diff)
parent690cf6b8d8b8827f046bc1e24b2e556afeff976c (diff)
downloademacs-aac33a8074c41354ffdb1236a342da16dca4a1bc.tar.gz
emacs-aac33a8074c41354ffdb1236a342da16dca4a1bc.zip
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
-rw-r--r--Makefile.in4
-rw-r--r--admin/charsets/cp51932.awk2
-rw-r--r--admin/charsets/eucjp-ms.awk2
-rw-r--r--admin/last-chance.el20
-rwxr-xr-xadmin/nt/dist-build/build-zips.sh10
-rwxr-xr-xadmin/unidata/blocks.awk2
-rw-r--r--configure.ac12
-rw-r--r--doc/lispref/debugging.texi2
-rw-r--r--doc/lispref/help.texi2
-rw-r--r--doc/lispref/minibuf.texi2
-rw-r--r--doc/lispref/strings.texi6
-rw-r--r--doc/lispref/syntax.texi2
-rw-r--r--doc/lispref/windows.texi6
-rw-r--r--doc/misc/widget.texi8
-rw-r--r--etc/NEWS40
-rw-r--r--lisp/arc-mode.el2
-rw-r--r--lisp/bindings.el6
-rw-r--r--lisp/calc/calc-embed.el2
-rw-r--r--lisp/calc/calc-ext.el2
-rw-r--r--lisp/calc/calc-prog.el25
-rw-r--r--lisp/calc/calc-sel.el12
-rw-r--r--lisp/calc/calc-store.el8
-rw-r--r--lisp/calc/calc-yank.el88
-rw-r--r--lisp/calendar/appt.el4
-rw-r--r--lisp/cedet/semantic/symref/grep.el3
-rw-r--r--lisp/cedet/srecode/semantic.el8
-rw-r--r--lisp/composite.el8
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/custom.el8
-rw-r--r--lisp/disp-table.el2
-rw-r--r--lisp/dos-fns.el2
-rw-r--r--lisp/dos-w32.el10
-rw-r--r--lisp/electric.el4
-rw-r--r--lisp/emacs-lisp/autoload.el25
-rw-r--r--lisp/emacs-lisp/byte-run.el29
-rw-r--r--lisp/emacs-lisp/bytecomp.el9
-rw-r--r--lisp/emacs-lisp/cl-generic.el26
-rw-r--r--lisp/emacs-lisp/cl-macs.el123
-rw-r--r--lisp/emacs-lisp/eieio-core.el3
-rw-r--r--lisp/emacs-lisp/macroexp.el29
-rw-r--r--lisp/emacs-lisp/package.el92
-rw-r--r--lisp/emacs-lisp/pcase.el27
-rw-r--r--lisp/erc/erc.el79
-rw-r--r--lisp/facemenu.el2
-rw-r--r--lisp/filesets.el477
-rw-r--r--lisp/font-core.el2
-rw-r--r--lisp/format.el5
-rw-r--r--lisp/gnus/gnus-win.el1
-rw-r--r--lisp/gnus/mm-decode.el19
-rw-r--r--lisp/gnus/nnmaildir.el2
-rw-r--r--lisp/info.el21
-rw-r--r--lisp/international/characters.el13
-rw-r--r--lisp/international/fontset.el2
-rw-r--r--lisp/international/iso-transl.el2
-rw-r--r--lisp/international/mule-conf.el2
-rw-r--r--lisp/international/mule.el2
-rw-r--r--lisp/international/ucs-normalize.el4
-rw-r--r--lisp/isearch.el8
-rw-r--r--lisp/jka-cmpr-hook.el3
-rw-r--r--lisp/json.el5
-rw-r--r--lisp/language/chinese.el2
-rw-r--r--lisp/language/cyrillic.el2
-rw-r--r--lisp/language/english.el2
-rw-r--r--lisp/language/ethiopic.el2
-rw-r--r--lisp/language/european.el2
-rw-r--r--lisp/language/hebrew.el2
-rw-r--r--lisp/language/indian.el2
-rw-r--r--lisp/language/japanese.el2
-rw-r--r--lisp/language/korean.el2
-rw-r--r--lisp/language/lao.el2
-rw-r--r--lisp/language/misc-lang.el2
-rw-r--r--lisp/language/thai.el2
-rw-r--r--lisp/language/tibetan.el2
-rw-r--r--lisp/mail/reporter.el82
-rw-r--r--lisp/mail/rmail.el11
-rw-r--r--lisp/mb-depth.el10
-rw-r--r--lisp/menu-bar.el5
-rw-r--r--lisp/net/pop3.el2
-rw-r--r--lisp/net/socks.el1
-rw-r--r--lisp/net/tramp-sh.el9
-rw-r--r--lisp/play/dunnet.el29
-rw-r--r--lisp/progmodes/flymake.el7
-rw-r--r--lisp/progmodes/perl-mode.el29
-rw-r--r--lisp/progmodes/project.el3
-rw-r--r--lisp/progmodes/ruby-mode.el9
-rw-r--r--lisp/progmodes/xref.el11
-rw-r--r--lisp/rfn-eshadow.el2
-rw-r--r--lisp/scroll-bar.el2
-rw-r--r--lisp/startup.el12
-rw-r--r--lisp/subr.el132
-rw-r--r--lisp/tab-bar.el158
-rw-r--r--lisp/term/common-win.el2
-rw-r--r--lisp/term/tty-colors.el2
-rw-r--r--lisp/textmodes/fill.el31
-rw-r--r--lisp/textmodes/paragraphs.el63
-rw-r--r--lisp/textmodes/reftex-vars.el11
-rw-r--r--lisp/w32-fns.el12
-rw-r--r--lisp/wid-edit.el1
-rw-r--r--lisp/widget.el2
-rw-r--r--lisp/window.el61
-rw-r--r--src/buffer.c12
-rw-r--r--src/callproc.c31
-rw-r--r--src/casefiddle.c13
-rw-r--r--src/cmds.c21
-rw-r--r--src/commands.h8
-rw-r--r--src/emacs.c5
-rw-r--r--src/keyboard.c8
-rw-r--r--src/keyboard.h2
-rw-r--r--src/keymap.c93
-rw-r--r--src/keymap.h2
-rw-r--r--src/lisp.h11
-rw-r--r--src/minibuf.c3
-rw-r--r--src/nsfns.m14
-rw-r--r--src/nsmenu.m21
-rw-r--r--src/nsterm.h1
-rw-r--r--src/nsterm.m106
-rw-r--r--src/pdumper.c2
-rw-r--r--src/print.c3
-rw-r--r--src/process.c13
-rw-r--r--src/terminfo.c6
-rw-r--r--src/window.c24
-rw-r--r--src/window.h1
-rw-r--r--src/xdisp.c16
-rw-r--r--src/xterm.c8
-rw-r--r--test/Makefile.in6
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el7
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el3
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el23
-rw-r--r--test/lisp/filenotify-tests.el2
-rw-r--r--test/lisp/gnus/mm-decode-resources/8bit-multipart.bin20
-rw-r--r--test/lisp/gnus/mm-decode-tests.el89
-rw-r--r--test/lisp/help-tests.el2
-rw-r--r--test/lisp/net/tramp-tests.el18
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/here-docs.pl143
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el32
-rw-r--r--test/lisp/progmodes/ruby-mode-tests.el3
-rw-r--r--test/lisp/progmodes/xref-tests.el38
-rw-r--r--test/lisp/subr-tests.el38
-rw-r--r--test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin9
-rw-r--r--test/lisp/textmodes/paragraphs-tests.el23
-rw-r--r--test/lisp/wid-edit-tests.el21
-rw-r--r--test/src/keymap-tests.el12
-rw-r--r--test/src/process-tests.el23
143 files changed, 1914 insertions, 1075 deletions
diff --git a/Makefile.in b/Makefile.in
index e766cb49f99..7ed1b6e004f 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -976,6 +976,10 @@ else
976 @echo "Maybe you used a release tarfile that lacks tests." 976 @echo "Maybe you used a release tarfile that lacks tests."
977endif 977endif
978 978
979test/%:
980 $(MAKE) -C test $*
981
982
979dist: 983dist:
980 cd ${srcdir}; ./make-dist 984 cd ${srcdir}; ./make-dist
981 985
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk
index c3555095249..22b24af1ef5 100644
--- a/admin/charsets/cp51932.awk
+++ b/admin/charsets/cp51932.awk
@@ -31,7 +31,7 @@
31# already been mapped to 1 or 3. 31# already been mapped to 1 or 3.
32 32
33BEGIN { 33BEGIN {
34 print ";;; cp51932.el -- translation table for CP51932"; 34 print ";;; cp51932.el -- translation table for CP51932 -*- lexical-binding:t -*-";
35 print ";;; Automatically generated from CP932-2BYTE.map"; 35 print ";;; Automatically generated from CP932-2BYTE.map";
36 print "(let ((map"; 36 print "(let ((map";
37 printf " '(;JISEXT<->UNICODE"; 37 printf " '(;JISEXT<->UNICODE";
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index f6a6748ce51..ca9a317611b 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -38,7 +38,7 @@ BEGIN {
38 JISX0208_FROM2 = "/xf5/xa1"; 38 JISX0208_FROM2 = "/xf5/xa1";
39 JISX0212_FROM = "/x8f/xf3/xf3"; 39 JISX0212_FROM = "/x8f/xf3/xf3";
40 40
41 print ";;; eucjp-ms.el -- translation table for eucJP-ms"; 41 print ";;; eucjp-ms.el -- translation table for eucJP-ms -*- lexical-binding:t -*-";
42 print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz"; 42 print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz";
43 print "(let ((map"; 43 print "(let ((map";
44 print " '(;JISEXT<->UNICODE"; 44 print " '(;JISEXT<->UNICODE";
diff --git a/admin/last-chance.el b/admin/last-chance.el
index fd5b8e9bd7a..e8021129e30 100644
--- a/admin/last-chance.el
+++ b/admin/last-chance.el
@@ -105,18 +105,14 @@ defaulting to the one at point."
105 "Symbol: " obarray 105 "Symbol: " obarray
106 nil nil 106 nil nil
107 one nil one))))) 107 one nil one)))))
108 (let ((default-directory (or (vc-root-dir) 108 (with-current-buffer
109 default-directory))) 109 (let ((default-directory (or (vc-root-dir)
110 (grep (format "%s %s" 110 default-directory)))
111 last-chance-grep-command 111 (grep (format "%s %s"
112 symbol))) 112 last-chance-grep-command
113 (setf (buffer-local-value 'last-chance-symbol 113 symbol)))
114 (process-buffer 114 (add-hook 'compilation-finish-functions #'last-chance-cleanup nil t)
115 (car compilation-in-progress))) 115 (setq-local last-chance-symbol symbol)))
116 symbol))
117
118(add-to-list 'compilation-finish-functions
119 'last-chance-cleanup)
120 116
121(provide 'last-chance) 117(provide 'last-chance)
122 118
diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh
index 809cbc65cac..4a9a7b596e7 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -20,7 +20,7 @@
20 20
21function git_up { 21function git_up {
22 echo [build] Making git worktree for Emacs $VERSION 22 echo [build] Making git worktree for Emacs $VERSION
23 cd $HOME/emacs-build/git/emacs-$MAJOR_VERSION 23 cd $REPO_DIR/emacs-$MAJOR_VERSION
24 git pull 24 git pull
25 git worktree add ../$BRANCH $BRANCH 25 git worktree add ../$BRANCH $BRANCH
26 26
@@ -54,7 +54,7 @@ function build_zip {
54 if [ ! -f Makefile ] || (($CONFIG)) 54 if [ ! -f Makefile ] || (($CONFIG))
55 then 55 then
56 echo [build] Configuring Emacs $ARCH 56 echo [build] Configuring Emacs $ARCH
57 ../../../git/$BRANCH/configure \ 57 $REPO_DIR/$BRANCH/configure \
58 --without-dbus \ 58 --without-dbus \
59 --host=$HOST --without-compress-install \ 59 --host=$HOST --without-compress-install \
60 $CACHE \ 60 $CACHE \
@@ -88,7 +88,7 @@ function build_installer {
88 ARCH=$1 88 ARCH=$1
89 cd $HOME/emacs-build/install/emacs-$VERSION 89 cd $HOME/emacs-build/install/emacs-$VERSION
90 echo [build] Calling makensis in `pwd` 90 echo [build] Calling makensis in `pwd`
91 cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi . 91 cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
92 92
93 makensis -v4 \ 93 makensis -v4 \
94 -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \ 94 -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
@@ -110,6 +110,10 @@ CONFIG=1
110CFLAGS="-O2 -static" 110CFLAGS="-O2 -static"
111INSTALL_TARGET="install-strip" 111INSTALL_TARGET="install-strip"
112 112
113## The location of the git repo
114REPO_DIR=$HOME/emacs-build/git/
115
116
113while getopts "36gb:hnsiV:" opt; do 117while getopts "36gb:hnsiV:" opt; do
114 case $opt in 118 case $opt in
115 3) 119 3)
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 986d299e666..4ecb233fe7b 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -203,7 +203,7 @@ function name2alias(name , w, w2) {
203} 203}
204 204
205END { 205END {
206 print ";;; charscript.el --- character script table" 206 print ";;; charscript.el --- character script table -*- lexical-binding:t -*-"
207 print ";;; Automatically generated from admin/unidata/Blocks.txt" 207 print ";;; Automatically generated from admin/unidata/Blocks.txt"
208 print "(let (script-list)" 208 print "(let (script-list)"
209 print " (dolist (elt '(" 209 print " (dolist (elt '("
diff --git a/configure.ac b/configure.ac
index 3625c4e856f..815d3c98c3a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4468,6 +4468,18 @@ TERMCAP_OBJ=tparam.o
4468if test $TERMINFO = yes; then 4468if test $TERMINFO = yes; then
4469 AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.]) 4469 AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.])
4470 TERMCAP_OBJ=terminfo.o 4470 TERMCAP_OBJ=terminfo.o
4471 AC_CACHE_CHECK([whether $LIBS_TERMCAP library defines BC],
4472 [emacs_cv_terminfo_defines_BC],
4473 [OLD_LIBS=$LIBS
4474 LIBS="$LIBS $LIBS_TERMCAP"
4475 AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern char *BC;]], [[return !*BC;]])],
4476 [emacs_cv_terminfo_defines_BC=yes],
4477 [emacs_cv_terminfo_defines_BC=no])
4478 LIBS=$OLD_LIBS])
4479 if test "$emacs_cv_terminfo_defines_BC" = yes; then
4480 AC_DEFINE([TERMINFO_DEFINES_BC], 1, [Define to 1 if the
4481 terminfo library defines the variables BC, PC, and UP.])
4482 fi
4471fi 4483fi
4472if test "X$LIBS_TERMCAP" = "X-lncurses"; then 4484if test "X$LIBS_TERMCAP" = "X-lncurses"; then
4473 AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.]) 4485 AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.])
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 1e779ac7054..8e4b0ebfe96 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -424,7 +424,7 @@ move to it and type @key{RET}, to visit the source code. You can also
424type @key{RET} while point is on any name of a function or variable 424type @key{RET} while point is on any name of a function or variable
425which is not underlined, to see help information for that symbol in a 425which is not underlined, to see help information for that symbol in a
426help buffer, if any exists. The @code{xref-find-definitions} command, 426help buffer, if any exists. The @code{xref-find-definitions} command,
427bound to @key{M-.}, can also be used on any identifier in a backtrace 427bound to @kbd{M-.}, can also be used on any identifier in a backtrace
428(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}). 428(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}).
429 429
430In backtraces, the tails of long lists and the ends of long strings, 430In backtraces, the tails of long lists and the ends of long strings,
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 2fd05b73917..298bec5230c 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -545,7 +545,7 @@ brackets.
545@end group 545@end group
546@group 546@group
547(single-key-description 'C-mouse-1) 547(single-key-description 'C-mouse-1)
548 @result{} "<C-mouse-1>" 548 @result{} "C-<mouse-1>"
549@end group 549@end group
550@group 550@group
551(single-key-description 'C-mouse-1 t) 551(single-key-description 'C-mouse-1 t)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 81139b9e746..f0036f0ccfc 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -348,7 +348,7 @@ default, it makes the following bindings:
348@item @key{RET} 348@item @key{RET}
349@code{exit-minibuffer} 349@code{exit-minibuffer}
350 350
351@item @key{M-<} 351@item @kbd{M-<}
352@code{minibuffer-beginning-of-buffer} 352@code{minibuffer-beginning-of-buffer}
353 353
354@item @kbd{C-g} 354@item @kbd{C-g}
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 897b424b187..5cae939b7bf 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -120,9 +120,9 @@ character (i.e., an integer), @code{nil} otherwise.
120@cindex string creation 120@cindex string creation
121 121
122 The following functions create strings, either from scratch, or by 122 The following functions create strings, either from scratch, or by
123putting strings together, or by taking them apart. (For functions that 123putting strings together, or by taking them apart. (For functions
124create strings based on searching the contents of other strings (like 124that create strings based on the modified contents of other strings,
125@code{string-replace} and @code{replace-regexp-in-string}), see 125like @code{string-replace} and @code{replace-regexp-in-string}, see
126@ref{Search and Replace}.) 126@ref{Search and Replace}.)
127 127
128@defun make-string count character &optional multibyte 128@defun make-string count character &optional multibyte
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index b4bd48771f0..d27053a1799 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -252,7 +252,7 @@ comment and a newline or formfeed ends one.
252 252
253@item Inherit standard syntax: @samp{@@} 253@item Inherit standard syntax: @samp{@@}
254This syntax class does not specify a particular syntax. It says to 254This syntax class does not specify a particular syntax. It says to
255look in the standard syntax table to find the syntax of this 255look in the parent syntax table to find the syntax of this
256character. 256character.
257 257
258@item Generic comment delimiters: @samp{!} 258@item Generic comment delimiters: @samp{!}
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index b0906acbad5..f305d1a8ee8 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2634,6 +2634,12 @@ window and displaying the buffer in that window. It can fail if all
2634windows are dedicated to other buffers (@pxref{Dedicated Windows}). 2634windows are dedicated to other buffers (@pxref{Dedicated Windows}).
2635@end defun 2635@end defun
2636 2636
2637@defun display-buffer-use-least-recent-window buffer alist
2638This function is like @code{display-buffer-use-some-window}, but will
2639not reuse the current window, and will use the least recently
2640switched-to window.
2641@end defun
2642
2637@defun display-buffer-in-direction buffer alist 2643@defun display-buffer-in-direction buffer alist
2638This function tries to display @var{buffer} at a location specified by 2644This function tries to display @var{buffer} at a location specified by
2639@var{alist}. For this purpose, @var{alist} should contain a 2645@var{alist}. For this purpose, @var{alist} should contain a
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index b0254e0824c..7fd9212d714 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -692,14 +692,14 @@ arguments, which will be used when creating the @code{radio-button} or
692 692
693@end table 693@end table
694 694
695@deffn {User Option} widget-glyph-directory 695@deffn {User Option} widget-image-directory
696Directory where glyphs are found. 696Directory where Widget should look for images.
697Widget will look here for a file with the same name as specified for the 697Widget will look here for a file with the same name as specified for the
698image, with either a @file{.xpm} (if supported) or @file{.xbm} extension. 698image, with either a @file{.xpm} (if supported) or @file{.xbm} extension.
699@end deffn 699@end deffn
700 700
701@deffn{User Option} widget-glyph-enable 701@deffn{User Option} widget-image-enable
702If non-@code{nil}, allow glyphs to appear on displays where they are supported. 702If non-@code{nil}, allow images to appear on displays where they are supported.
703@end deffn 703@end deffn
704 704
705 705
diff --git a/etc/NEWS b/etc/NEWS
index b294ff1d230..eaaf9bfb0ef 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -212,6 +212,19 @@ This makes debugging Emacs Lisp scripts run in batch mode easier. To
212get back the old behavior, set the new variable 212get back the old behavior, set the new variable
213'backtrace-on-error-noninteractive' to a nil value. 213'backtrace-on-error-noninteractive' to a nil value.
214 214
215** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input.
216This is another attempt to solve the problem of handling high key repeat rate
217and other "slow scrolling" situations. It is hoped it behaves better
218than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'.
219It is not enabled by default.
220
221+++
222** Modifiers now go outside angle brackets in pretty-printed key bindings.
223For example, <return> with Control and Meta modifiers is now shown as
224C-M-<return> instead of <C-M-return>. Either variant can be used as
225input; functions such as 'kbd' and 'read-kbd-macro' accept both styles
226as equivalent (they have done so for a long time).
227
215 228
216* Editing Changes in Emacs 28.1 229* Editing Changes in Emacs 28.1
217 230
@@ -360,6 +373,15 @@ disabled entirely.
360 373
361** Windows 374** Windows
362 375
376+++
377*** New 'display-buffer' function 'display-buffer-use-least-recent-window'
378This is like 'display-buffer-use-some-window', but won't reuse the
379current window, and when called repeatedly will try not to reuse a
380previously selected window.
381
382*** New function 'window-bump-use-time'.
383This updates the use time of a window.
384
363*** The key prefix 'C-x 4 1' displays next command buffer in the same window. 385*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
364It's bound to the command 'same-window-prefix' that requests the buffer 386It's bound to the command 'same-window-prefix' that requests the buffer
365of the next command to be displayed in the same window. 387of the next command to be displayed in the same window.
@@ -383,11 +405,20 @@ of the next command to be displayed in a new tab.
383+++ 405+++
384*** New command 'C-x t C-r' to open file read-only in other tab. 406*** New command 'C-x t C-r' to open file read-only in other tab.
385 407
408---
386*** The tab bar is frame-local when 'tab-bar-show' is a number. 409*** The tab bar is frame-local when 'tab-bar-show' is a number.
387Show/hide the tab bar independently for each frame, according to the 410Show/hide the tab bar independently for each frame, according to the
388value of 'tab-bar-show'. 411value of 'tab-bar-show'.
389 412
390--- 413---
414*** New command 'toggle-frame-tab-bar'.
415It can be used to enable/disable the tab bar individually on each frame
416independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
417
418---
419*** New user option 'tab-bar-tab-name-format-function'.
420
421---
391*** The tabs in the tab line can now be scrolled using horizontal scroll. 422*** The tabs in the tab line can now be scrolled using horizontal scroll.
392If your mouse or trackpad supports it, you can now scroll tabs when 423If your mouse or trackpad supports it, you can now scroll tabs when
393the mouse pointer is in the tab line by scrolling left or right. 424the mouse pointer is in the tab line by scrolling left or right.
@@ -1828,6 +1859,9 @@ also keep the type information of their arguments. Use the
1828** CPerl Mode 1859** CPerl Mode
1829 1860
1830--- 1861---
1862*** New face 'perl-heredoc', used for heredoc elements.
1863
1864---
1831*** The command 'cperl-set-style' offers the new value "PBP". 1865*** The command 'cperl-set-style' offers the new value "PBP".
1832This value customizes Emacs to use the style recommended in Damian 1866This value customizes Emacs to use the style recommended in Damian
1833Conway's book "Perl Best Practices" for indentation and formatting 1867Conway's book "Perl Best Practices" for indentation and formatting
@@ -2019,6 +2053,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
2019'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font', 2053'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
2020'wisent-lex-make-token-table'. 2054'wisent-lex-make-token-table'.
2021 2055
2056** The 'when' argument of `make-obsolete` and related functions is mandatory.
2057The use of those functions without a 'when' argument was marked
2058obsolete back in Emacs-23.1. The affected functions are:
2059make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
2060define-obsolete-variable-alias.
2061
2022 2062
2023* Lisp Changes in Emacs 28.1 2063* Lisp Changes in Emacs 28.1
2024 2064
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 52908d9fb6b..6c9ceb0b5a8 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -2237,8 +2237,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
2237;; not the GNU nor the BSD extensions. As it turns out, this is sufficient 2237;; not the GNU nor the BSD extensions. As it turns out, this is sufficient
2238;; for .deb packages. 2238;; for .deb packages.
2239 2239
2240(autoload 'tar-grind-file-mode "tar-mode")
2241
2242(defconst archive-ar-file-header-re 2240(defconst archive-ar-file-header-re
2243 "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n") 2241 "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
2244 2242
diff --git a/lisp/bindings.el b/lisp/bindings.el
index b68d55e73d8..187444af664 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1,4 +1,4 @@
1;;; bindings.el --- define standard key bindings and some variables 1;;; bindings.el --- define standard key bindings and some variables -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software 3;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -856,7 +856,7 @@ in contrast with \\[forward-char] and \\[backward-char], which
856see." 856see."
857 (interactive "^p") 857 (interactive "^p")
858 (if visual-order-cursor-movement 858 (if visual-order-cursor-movement
859 (dotimes (i (if (numberp n) (abs n) 1)) 859 (dotimes (_ (if (numberp n) (abs n) 1))
860 (move-point-visually (if (and (numberp n) (< n 0)) -1 1))) 860 (move-point-visually (if (and (numberp n) (< n 0)) -1 1)))
861 (if (eq (current-bidi-paragraph-direction) 'left-to-right) 861 (if (eq (current-bidi-paragraph-direction) 'left-to-right)
862 (forward-char n) 862 (forward-char n)
@@ -874,7 +874,7 @@ in contrast with \\[forward-char] and \\[backward-char], which
874see." 874see."
875 (interactive "^p") 875 (interactive "^p")
876 (if visual-order-cursor-movement 876 (if visual-order-cursor-movement
877 (dotimes (i (if (numberp n) (abs n) 1)) 877 (dotimes (_ (if (numberp n) (abs n) 1))
878 (move-point-visually (if (and (numberp n) (< n 0)) 1 -1))) 878 (move-point-visually (if (and (numberp n) (< n 0)) 1 -1)))
879 (if (eq (current-bidi-paragraph-direction) 'left-to-right) 879 (if (eq (current-bidi-paragraph-direction) 'left-to-right)
880 (backward-char n) 880 (backward-char n)
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index a1135726108..ea79bfa69a0 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -396,7 +396,7 @@
396 (calc-wrapper 396 (calc-wrapper
397 (setq str (math-showing-full-precision 397 (setq str (math-showing-full-precision
398 (math-format-nice-expr (aref info 8) (frame-width)))) 398 (math-format-nice-expr (aref info 8) (frame-width))))
399 (calc-edit-mode (list 'calc-embedded-finish-edit info)) 399 (calc--edit-mode (lambda () (calc-embedded-finish-edit info)))
400 (insert str "\n"))) 400 (insert str "\n")))
401 (calc-show-edit-buffer))) 401 (calc-show-edit-buffer)))
402 402
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 7c319c4d654..f4ddb840b50 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1195,7 +1195,7 @@ calc-set-xor calc-sort calc-subvector calc-tail calc-transpose
1195calc-unpack calc-unpack-bits calc-vector-find calc-vlength) 1195calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
1196 1196
1197 ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill 1197 ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
1198calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode 1198calc-copy-to-buffer calc-edit calc-edit-cancel calc--edit-mode
1199calc-kill calc-kill-region calc-yank)))) 1199calc-kill calc-kill-region calc-yank))))
1200 1200
1201(defun calc-init-prefixes () 1201(defun calc-init-prefixes ()
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 6ac554ed69c..3097b09b013 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -483,13 +483,13 @@
483 (interactive) 483 (interactive)
484 (calc-wrapper 484 (calc-wrapper
485 (let ((lang calc-language)) 485 (let ((lang calc-language))
486 (calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang)) 486 (calc--edit-mode (lambda () (calc-finish-user-syntax-edit lang))
487 t 487 t
488 (format "Editing %s-Mode Syntax Table. " 488 (format "Editing %s-Mode Syntax Table. "
489 (cond ((null lang) "Normal") 489 (cond ((null lang) "Normal")
490 ((eq lang 'tex) "TeX") 490 ((eq lang 'tex) "TeX")
491 ((eq lang 'latex) "LaTeX") 491 ((eq lang 'latex) "LaTeX")
492 (t (capitalize (symbol-name lang)))))) 492 (t (capitalize (symbol-name lang))))))
493 (calc-write-parse-table (cdr (assq lang calc-user-parse-tables)) 493 (calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
494 lang))) 494 lang)))
495 (calc-show-edit-buffer)) 495 (calc-show-edit-buffer))
@@ -696,12 +696,13 @@
696 (setq cmd (symbol-function cmd))) 696 (setq cmd (symbol-function cmd)))
697 (cond ((or (stringp cmd) 697 (cond ((or (stringp cmd)
698 (and (consp cmd) 698 (and (consp cmd)
699 (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro))) 699 (eq (car-safe (nth 3 cmd)) #'calc-execute-kbd-macro)))
700 ;; FIXME: Won't (nth 3 cmd) fail when (stringp cmd)?
700 (let* ((mac (elt (nth 1 (nth 3 cmd)) 1)) 701 (let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
701 (str (edmacro-format-keys mac t)) 702 (str (edmacro-format-keys mac t))
702 (kys (nth 3 (nth 3 cmd)))) 703 (kys (nth 3 (nth 3 cmd))))
703 (calc-edit-mode 704 (calc--edit-mode
704 (list 'calc-edit-macro-finish-edit cmdname kys) 705 (lambda () (calc-edit-macro-finish-edit cmdname kys))
705 t (format (concat 706 t (format (concat
706 "Editing keyboard macro (%s, bound to %s).\n" 707 "Editing keyboard macro (%s, bound to %s).\n"
707 "Original keys: %s \n") 708 "Original keys: %s \n")
@@ -719,8 +720,8 @@
719 (if (and defn (calc-valid-formula-func func)) 720 (if (and defn (calc-valid-formula-func func))
720 (let ((niceexpr (math-format-nice-expr defn (frame-width)))) 721 (let ((niceexpr (math-format-nice-expr defn (frame-width))))
721 (calc-wrapper 722 (calc-wrapper
722 (calc-edit-mode 723 (calc--edit-mode
723 (list 'calc-finish-formula-edit (list 'quote func)) 724 (lambda () (calc-finish-formula-edit func))
724 nil 725 nil
725 (format (concat 726 (format (concat
726 "Editing formula (%s, %s, bound to %s).\n" 727 "Editing formula (%s, %s, bound to %s).\n"
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index e6c6337f969..2b317ac3696 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -675,12 +675,12 @@
675 (entry (calc-top num 'entry)) 675 (entry (calc-top num 'entry))
676 (expr (car entry)) 676 (expr (car entry))
677 (sel (or (calc-auto-selection entry) expr)) 677 (sel (or (calc-auto-selection entry) expr))
678 ) ;; alg 678 ;; alg
679 (let ((str (math-showing-full-precision 679 (str (math-showing-full-precision
680 (math-format-nice-expr sel (frame-width))))) 680 (math-format-nice-expr sel (frame-width))))
681 (calc-edit-mode (list 'calc-finish-selection-edit 681 (csr calc-sel-reselect))
682 num (list 'quote sel) calc-sel-reselect)) 682 (calc--edit-mode (lambda () (calc-finish-selection-edit num sel csr)))
683 (insert str "\n")))) 683 (insert str "\n")))
684 (calc-show-edit-buffer)) 684 (calc-show-edit-buffer))
685 685
686(defvar calc-original-buffer) 686(defvar calc-original-buffer)
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index a5e9012dec6..ee29c440fe4 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -437,10 +437,10 @@
437 (if (eq (car-safe value) 'special-const) 437 (if (eq (car-safe value) 'special-const)
438 (error "%s is a special constant" var)) 438 (error "%s is a special constant" var))
439 (setq calc-last-edited-variable var) 439 (setq calc-last-edited-variable var)
440 (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var)) 440 (calc--edit-mode (lambda () (calc-finish-stack-edit var))
441 t 441 t
442 (format-message 442 (format-message
443 "Editing variable `%s'" (calc-var-name var))) 443 "Editing variable `%s'" (calc-var-name var)))
444 (and value 444 (and value
445 (insert (math-format-nice-expr value (frame-width)) "\n"))))) 445 (insert (math-format-nice-expr value (frame-width)) "\n")))))
446 (calc-show-edit-buffer)) 446 (calc-show-edit-buffer))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index 8267340a3ec..e5f05236f3a 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -651,14 +651,14 @@ Interactively, reads the register using `register-read-with-preview'."
651 (if (> n 0) 651 (if (> n 0)
652 (calc-top-list n) 652 (calc-top-list n)
653 (calc-top-list 1 (- n))))))) 653 (calc-top-list 1 (- n)))))))
654 (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret) 654 (calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n))) allow-ret)
655 (while list 655 (while list
656 (insert (car list) "\n") 656 (insert (car list) "\n")
657 (setq list (cdr list))))) 657 (setq list (cdr list)))))
658 (calc-show-edit-buffer)) 658 (calc-show-edit-buffer))
659 659
660(defun calc-alg-edit (str) 660(defun calc-alg-edit (str)
661 (calc-edit-mode '(calc-finish-stack-edit 0)) 661 (calc--edit-mode (lambda () (calc-finish-stack-edit 0)))
662 (calc-show-edit-buffer) 662 (calc-show-edit-buffer)
663 (insert str "\n") 663 (insert str "\n")
664 (backward-char 1) 664 (backward-char 1)
@@ -666,54 +666,47 @@ Interactively, reads the register using `register-read-with-preview'."
666 666
667(defvar calc-edit-mode-map 667(defvar calc-edit-mode-map
668 (let ((map (make-sparse-keymap))) 668 (let ((map (make-sparse-keymap)))
669 (define-key map "\n" 'calc-edit-finish) 669 (define-key map "\n" #'calc-edit-finish)
670 (define-key map "\r" 'calc-edit-return) 670 (define-key map "\r" #'calc-edit-return)
671 (define-key map "\C-c\C-c" 'calc-edit-finish) 671 (define-key map "\C-c\C-c" #'calc-edit-finish)
672 map) 672 map)
673 "Keymap for use by the calc-edit command.") 673 "Keymap for use by the `calc-edit' command.")
674 674
675(defvar calc-original-buffer) 675(defvar calc-original-buffer nil)
676(defvar calc-return-buffer) 676(defvar calc-return-buffer nil)
677(defvar calc-one-window) 677(defvar calc-one-window nil)
678(defvar calc-edit-handler) 678(defvar calc-edit-handler nil)
679(defvar calc-restore-trail) 679(defvar calc-restore-trail nil)
680(defvar calc-allow-ret) 680(defvar calc-allow-ret nil)
681(defvar calc-edit-top) 681(defvar calc-edit-top nil)
682 682
683(defun calc-edit-mode (&optional handler allow-ret title) 683(put 'calc-edit-mode 'mode-class 'special)
684(define-derived-mode calc-edit-mode nil "Calc Edit"
684 "Calculator editing mode. Press RET, LFD, or C-c C-c to finish. 685 "Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
685To cancel the edit, simply kill the *Calc Edit* buffer." 686To cancel the edit, simply kill the *Calc Edit* buffer."
686 (interactive) 687 (setq-local buffer-read-only nil)
688 (setq-local truncate-lines nil))
689
690(defun calc--edit-mode (handler &optional allow-ret title)
687 (unless handler 691 (unless handler
688 (error "This command can be used only indirectly through calc-edit")) 692 (error "This command can be used only indirectly through calc-edit"))
689 (let ((oldbuf (current-buffer)) 693 (let ((oldbuf (current-buffer))
690 (buf (get-buffer-create "*Calc Edit*"))) 694 (buf (get-buffer-create "*Calc Edit*")))
691 (set-buffer buf) 695 (set-buffer buf)
692 (kill-all-local-variables) 696 (calc-edit-mode)
693 (use-local-map calc-edit-mode-map) 697 (setq-local calc-original-buffer oldbuf)
694 (setq buffer-read-only nil) 698 (setq-local calc-return-buffer oldbuf)
695 (setq truncate-lines nil) 699 (setq-local calc-one-window (and (one-window-p t) pop-up-windows))
696 (setq major-mode 'calc-edit-mode) 700 (setq-local calc-edit-handler handler)
697 (setq mode-name "Calc Edit") 701 (setq-local calc-restore-trail (get-buffer-window (calc-trail-buffer)))
698 (run-mode-hooks 'calc-edit-mode-hook) 702 (setq-local calc-allow-ret allow-ret)
699 (make-local-variable 'calc-original-buffer)
700 (setq calc-original-buffer oldbuf)
701 (make-local-variable 'calc-return-buffer)
702 (setq calc-return-buffer oldbuf)
703 (make-local-variable 'calc-one-window)
704 (setq calc-one-window (and (one-window-p t) pop-up-windows))
705 (make-local-variable 'calc-edit-handler)
706 (setq calc-edit-handler handler)
707 (make-local-variable 'calc-restore-trail)
708 (setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
709 (make-local-variable 'calc-allow-ret)
710 (setq calc-allow-ret allow-ret)
711 (let ((inhibit-read-only t)) 703 (let ((inhibit-read-only t))
712 (erase-buffer)) 704 (erase-buffer))
713 (add-hook 'kill-buffer-hook (lambda () 705 (add-hook 'kill-buffer-hook (lambda ()
714 (let ((calc-edit-handler nil)) 706 (let ((calc-edit-handler nil))
715 (calc-edit-finish t)) 707 (calc-edit-finish t))
716 (message "(Canceled)")) t t) 708 (message "(Canceled)"))
709 t t)
717 (insert (propertize 710 (insert (propertize
718 (concat 711 (concat
719 (or title title "Calc Edit Mode. ") 712 (or title title "Calc Edit Mode. ")
@@ -721,9 +714,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
721 (if allow-ret "" " or RET") 714 (if allow-ret "" " or RET")
722 (format-message " to finish, `C-x k RET' to cancel.\n\n")) 715 (format-message " to finish, `C-x k RET' to cancel.\n\n"))
723 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t)) 716 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
724 (make-local-variable 'calc-edit-top) 717 (setq-local calc-edit-top (point))))
725 (setq calc-edit-top (point))))
726(put 'calc-edit-mode 'mode-class 'special)
727 718
728(defun calc-show-edit-buffer () 719(defun calc-show-edit-buffer ()
729 (let ((buf (current-buffer))) 720 (let ((buf (current-buffer)))
@@ -743,24 +734,19 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
743 734
744(defun calc-edit-return () 735(defun calc-edit-return ()
745 (interactive) 736 (interactive)
746 (if (and (boundp 'calc-allow-ret) calc-allow-ret) 737 (if calc-allow-ret
747 (newline) 738 (newline)
748 (calc-edit-finish))) 739 (calc-edit-finish)))
749 740
750;; The variable calc-edit-disp-trail is local to calc-edit finish, but 741;; The variable `calc-edit-disp-trail' is local to `calc-edit-finish', but
751;; is used by calc-finish-selection-edit and calc-finish-stack-edit. 742;; is used by `calc-finish-selection-edit' and `calc-finish-stack-edit'.
752(defvar calc-edit-disp-trail) 743(defvar calc-edit-disp-trail)
753 744
754(defun calc-edit-finish (&optional keep) 745(defun calc-edit-finish (&optional keep)
755 "Finish calc-edit mode. Parse buffer contents and push them on the stack." 746 "Finish `calc-edit' mode. Parse buffer contents and push them on the stack."
756 (interactive "P") 747 (interactive "P")
757 (message "Working...") 748 (message "Working...")
758 (or (and (boundp 'calc-original-buffer) 749 (or (derived-mode-p 'calc-edit-mode)
759 (boundp 'calc-return-buffer)
760 (boundp 'calc-one-window)
761 (boundp 'calc-edit-handler)
762 (boundp 'calc-restore-trail)
763 (eq major-mode 'calc-edit-mode))
764 (error "This command is valid only in buffers created by calc-edit")) 750 (error "This command is valid only in buffers created by calc-edit"))
765 (let ((buf (current-buffer)) 751 (let ((buf (current-buffer))
766 (original calc-original-buffer) 752 (original calc-original-buffer)
@@ -775,7 +761,11 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
775 (error "Original calculator buffer has been corrupted"))) 761 (error "Original calculator buffer has been corrupted")))
776 (goto-char calc-edit-top) 762 (goto-char calc-edit-top)
777 (if (buffer-modified-p) 763 (if (buffer-modified-p)
778 (eval calc-edit-handler t)) 764 (if (functionp calc-edit-handler)
765 (funcall calc-edit-handler)
766 (message "Deprecated handler expression in calc-edit-handler: %S"
767 calc-edit-handler)
768 (eval calc-edit-handler t)))
779 (if (and one-window (not (one-window-p t))) 769 (if (and one-window (not (one-window-p t)))
780 (delete-window)) 770 (delete-window))
781 (if (get-buffer-window return) 771 (if (get-buffer-window return)
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 29bcd6de2ce..281b89e088f 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -700,7 +700,7 @@ ARG is positive, otherwise off."
700 (let ((appt-active appt-timer)) 700 (let ((appt-active appt-timer))
701 (setq appt-active (if arg (> (prefix-numeric-value arg) 0) 701 (setq appt-active (if arg (> (prefix-numeric-value arg) 0)
702 (not appt-active))) 702 (not appt-active)))
703 (remove-hook 'write-file-functions #'appt-update-list) 703 (remove-hook 'write-file-functions #'appt-update-list 'local)
704 (or global-mode-string (setq global-mode-string '(""))) 704 (or global-mode-string (setq global-mode-string '("")))
705 (delq 'appt-mode-string global-mode-string) 705 (delq 'appt-mode-string global-mode-string)
706 (when appt-timer 706 (when appt-timer
@@ -708,7 +708,7 @@ ARG is positive, otherwise off."
708 (setq appt-timer nil)) 708 (setq appt-timer nil))
709 (if appt-active 709 (if appt-active
710 (progn 710 (progn
711 (add-hook 'write-file-functions #'appt-update-list) 711 (add-hook 'write-file-functions #'appt-update-list nil t)
712 (setq appt-timer (run-at-time t 60 #'appt-check) 712 (setq appt-timer (run-at-time t 60 #'appt-check)
713 global-mode-string 713 global-mode-string
714 (append global-mode-string '(appt-mode-string))) 714 (append global-mode-string '(appt-mode-string)))
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index 5f9a3fa352e..9f0ac38ec75 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -168,7 +168,8 @@ This shell should support pipe redirect syntax."
168 (erase-buffer) 168 (erase-buffer)
169 (setq default-directory rootdir) 169 (setq default-directory rootdir)
170 (let ((cmd (semantic-symref-grep-use-template 170 (let ((cmd (semantic-symref-grep-use-template
171 (file-local-name rootdir) filepattern grepflags greppat))) 171 (file-name-as-directory (file-local-name rootdir))
172 filepattern grepflags greppat)))
172 (process-file semantic-symref-grep-shell nil b nil 173 (process-file semantic-symref-grep-shell nil b nil
173 shell-command-switch cmd))) 174 shell-command-switch cmd)))
174 (setq ans (semantic-symref-parse-tool-output tool b)) 175 (setq ans (semantic-symref-parse-tool-output tool b))
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 21ed1f96ae6..101246cae6f 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -1,4 +1,4 @@
1;;; srecode/semantic.el --- Semantic specific extensions to SRecode. 1;;; srecode/semantic.el --- Semantic specific extensions to SRecode -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
4 4
@@ -57,7 +57,7 @@ This class will be used to derive dictionary values.")
57 57
58(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag) 58(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
59 function 59 function
60 dictionary) 60 _dictionary)
61 "Convert the compound dictionary value CP to a string. 61 "Convert the compound dictionary value CP to a string.
62If FUNCTION is non-nil, then FUNCTION is somehow applied to an 62If FUNCTION is non-nil, then FUNCTION is somehow applied to an
63aspect of the compound value." 63aspect of the compound value."
@@ -410,7 +410,9 @@ as `function' will leave point where code might be inserted."
410 ;; Insert the template. 410 ;; Insert the template.
411 (let ((endpt (srecode-insert-fcn temp dict nil t))) 411 (let ((endpt (srecode-insert-fcn temp dict nil t)))
412 412
413 (run-hook-with-args 'point-insert-fcn tag) 413 (if (functionp point-insert-fcn)
414 (funcall point-insert-fcn tag)
415 (dolist (f point-insert-fcn) (funcall f tag)))
414 ;;(sit-for 1) 416 ;;(sit-for 1)
415 417
416 (cond 418 (cond
diff --git a/lisp/composite.el b/lisp/composite.el
index 7337605d4a9..6f654df15aa 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,4 +1,4 @@
1;;; composite.el --- support character composition 1;;; composite.el --- support character composition -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4 4
@@ -593,7 +593,6 @@ All non-spacing characters have this function in
593 (as (lglyph-ascent glyph)) 593 (as (lglyph-ascent glyph))
594 (de (lglyph-descent glyph)) 594 (de (lglyph-descent glyph))
595 (ce (/ (+ lb rb) 2)) 595 (ce (/ (+ lb rb) 2))
596 (w (lglyph-width glyph))
597 xoff yoff) 596 xoff yoff)
598 (cond 597 (cond
599 ((and class (>= class 200) (<= class 240)) 598 ((and class (>= class 200) (<= class 240))
@@ -653,7 +652,8 @@ All non-spacing characters have this function in
653 ((and (= class 0) 652 ((and (= class 0)
654 (eq (get-char-code-property (lglyph-char glyph) 653 (eq (get-char-code-property (lglyph-char glyph)
655 ;; Me = enclosing mark 654 ;; Me = enclosing mark
656 'general-category) 'Me)) 655 'general-category)
656 'Me))
657 ;; Artificially laying out glyphs in an enclosing 657 ;; Artificially laying out glyphs in an enclosing
658 ;; mark is difficult. All we can do is to adjust 658 ;; mark is difficult. All we can do is to adjust
659 ;; the x-offset and width of the base glyph to 659 ;; the x-offset and width of the base glyph to
@@ -695,9 +695,7 @@ All non-spacing characters have this function in
695 695
696(defun compose-gstring-for-dotted-circle (gstring direction) 696(defun compose-gstring-for-dotted-circle (gstring direction)
697 (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle 697 (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
698 (dc-id (lglyph-code dc))
699 (fc (lgstring-glyph gstring 1)) ; glyph of the following char 698 (fc (lgstring-glyph gstring 1)) ; glyph of the following char
700 (fc-id (lglyph-code fc))
701 (gstr (and nil (font-shape-gstring gstring direction)))) 699 (gstr (and nil (font-shape-gstring gstring direction))))
702 (if (and gstr 700 (if (and gstr
703 (or (= (lgstring-glyph-len gstr) 1) 701 (or (= (lgstring-glyph-len gstr) 1)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 7d9d1fe13ae..5dcb2842a21 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,4 +1,4 @@
1;;; cus-face.el --- customization support for faces 1;;; cus-face.el --- customization support for faces -*- lexical-binding: t; -*-
2;; 2;;
3;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
4;; 4;;
diff --git a/lisp/custom.el b/lisp/custom.el
index dfa8539c44f..d9d0898dcb7 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -161,7 +161,9 @@ set to nil, as the value is no longer rogue."
161 ;; Whether automatically buffer-local. 161 ;; Whether automatically buffer-local.
162 buffer-local) 162 buffer-local)
163 (unless (memq :group args) 163 (unless (memq :group args)
164 (custom-add-to-group (custom-current-group) symbol 'custom-variable)) 164 (let ((cg (custom-current-group)))
165 (when cg
166 (custom-add-to-group cg symbol 'custom-variable))))
165 (while args 167 (while args
166 (let ((keyword (pop args))) 168 (let ((keyword (pop args)))
167 (unless (symbolp keyword) 169 (unless (symbolp keyword)
@@ -525,7 +527,9 @@ If no such group is found, return nil."
525 "For customization option SYMBOL, handle keyword arguments ARGS. 527 "For customization option SYMBOL, handle keyword arguments ARGS.
526Third argument TYPE is the custom option type." 528Third argument TYPE is the custom option type."
527 (unless (memq :group args) 529 (unless (memq :group args)
528 (custom-add-to-group (custom-current-group) symbol type)) 530 (let ((cg (custom-current-group)))
531 (when cg
532 (custom-add-to-group cg symbol type))))
529 (while args 533 (while args
530 (let ((arg (car args))) 534 (let ((arg (car args)))
531 (setq args (cdr args)) 535 (setq args (cdr args))
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 6de14b1d297..a7fc8f0a76e 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -1,4 +1,4 @@
1;;; disp-table.el --- functions for dealing with char tables 1;;; disp-table.el --- functions for dealing with char tables -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software 3;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 5d4aa7843f1..255edd0f371 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -1,4 +1,4 @@
1;;; dos-fns.el --- MS-Dos specific functions 1;;; dos-fns.el --- MS-Dos specific functions -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software 3;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index e902491446c..cf753214624 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,4 +1,4 @@
1;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms 1;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -154,13 +154,15 @@ when writing the file."
154 ;; FIXME: Can't we use find-file-literally for the same purposes? 154 ;; FIXME: Can't we use find-file-literally for the same purposes?
155 (interactive "FFind file binary: ") 155 (interactive "FFind file binary: ")
156 (let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix? 156 (let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix?
157 (find-file filename))) 157 (with-suppressed-warnings ((interactive-only find-file))
158 (find-file filename))))
158 159
159(defun find-file-text (filename) 160(defun find-file-text (filename)
160 "Visit file FILENAME and treat it as a text file." 161 "Visit file FILENAME and treat it as a text file."
161 (interactive "FFind file text: ") 162 (interactive "FFind file text: ")
162 (let ((coding-system-for-read 'undecided-dos)) 163 (let ((coding-system-for-read 'undecided-dos))
163 (find-file filename))) 164 (with-suppressed-warnings ((interactive-only find-file))
165 (find-file filename))))
164 166
165(defun w32-find-file-not-found-set-buffer-file-coding-system () 167(defun w32-find-file-not-found-set-buffer-file-coding-system ()
166 (with-current-buffer (current-buffer) 168 (with-current-buffer (current-buffer)
@@ -261,6 +263,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
261 :group 'dos-fns 263 :group 'dos-fns
262 :group 'w32) 264 :group 'w32)
263 265
266(defvar w32-quote-process-args)
267
264;; Function to actually send data to the printer port. 268;; Function to actually send data to the printer port.
265;; Supports writing directly, and using various programs. 269;; Supports writing directly, and using various programs.
266(defun w32-direct-print-region-helper (printer 270(defun w32-direct-print-region-helper (printer
diff --git a/lisp/electric.el b/lisp/electric.el
index 506e9aa0f7c..6701a36d8bb 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -1,4 +1,4 @@
1;;; electric.el --- window maker and Command loop for `electric' modes 1;;; electric.el --- window maker and Command loop for `electric' modes -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation, 3;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation,
4;; Inc. 4;; Inc.
@@ -385,6 +385,8 @@ If multiple rules match, only first one is executed.")
385 (when electric-layout-mode 385 (when electric-layout-mode
386 (electric-layout-post-self-insert-function-1))) 386 (electric-layout-post-self-insert-function-1)))
387 387
388(defvar electric-pair-open-newline-between-pairs)
389
388;; for edebug's sake, a separate function 390;; for edebug's sake, a separate function
389(defun electric-layout-post-self-insert-function-1 () 391(defun electric-layout-post-self-insert-function-1 ()
390 (let* ((pos (electric--after-char-pos)) 392 (let* ((pos (electric--after-char-pos))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 1786b5cd6a8..ec7492dd4b1 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -220,16 +220,27 @@ expression, in which case we want to handle forms differently."
220 220
221 ;; Convert defcustom to less space-consuming data. 221 ;; Convert defcustom to less space-consuming data.
222 ((eq car 'defcustom) 222 ((eq car 'defcustom)
223 (let ((varname (car-safe (cdr-safe form))) 223 (let* ((varname (car-safe (cdr-safe form)))
224 (init (car-safe (cdr-safe (cdr-safe form)))) 224 (props (nthcdr 4 form))
225 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) 225 (initializer (plist-get props :initialize))
226 ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))) 226 (init (car-safe (cdr-safe (cdr-safe form))))
227 ) 227 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
228 ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
229 )
228 `(progn 230 `(progn
229 (defvar ,varname ,init ,doc) 231 ,(if (not (member initializer '(nil 'custom-initialize-default
232 #'custom-initialize-default
233 'custom-initialize-reset
234 #'custom-initialize-reset)))
235 form
236 `(defvar ,varname ,init ,doc))
237 ;; When we include the complete `form', this `custom-autoload'
238 ;; is not indispensable, but it still helps in case the `defcustom'
239 ;; doesn't specify its group explicitly, and probably in a few other
240 ;; corner cases.
230 (custom-autoload ',varname ,file 241 (custom-autoload ',varname ,file
231 ,(condition-case nil 242 ,(condition-case nil
232 (null (cadr (memq :set form))) 243 (null (plist-get props :set))
233 (error nil)))))) 244 (error nil))))))
234 245
235 ((eq car 'defgroup) 246 ((eq car 'defgroup)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 8334c09bf9f..0f8dd5a2842 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -372,7 +372,7 @@ convention was modified."
372 (puthash (indirect-function function) signature 372 (puthash (indirect-function function) signature
373 advertised-signature-table)) 373 advertised-signature-table))
374 374
375(defun make-obsolete (obsolete-name current-name &optional when) 375(defun make-obsolete (obsolete-name current-name when)
376 "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete. 376 "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
377OBSOLETE-NAME should be a function name or macro name (a symbol). 377OBSOLETE-NAME should be a function name or macro name (a symbol).
378 378
@@ -381,17 +381,14 @@ If CURRENT-NAME is a string, that is the `use instead' message
381\(it should end with a period, and not start with a capital). 381\(it should end with a period, and not start with a capital).
382WHEN should be a string indicating when the function 382WHEN should be a string indicating when the function
383was first made obsolete, for example a date or a release number." 383was first made obsolete, for example a date or a release number."
384 (declare (advertised-calling-convention
385 ;; New code should always provide the `when' argument.
386 (obsolete-name current-name when) "23.1"))
387 (put obsolete-name 'byte-obsolete-info 384 (put obsolete-name 'byte-obsolete-info
388 ;; The second entry used to hold the `byte-compile' handler, but 385 ;; The second entry used to hold the `byte-compile' handler, but
389 ;; is not used any more nowadays. 386 ;; is not used any more nowadays.
390 (purecopy (list current-name nil when))) 387 (purecopy (list current-name nil when)))
391 obsolete-name) 388 obsolete-name)
392 389
393(defmacro define-obsolete-function-alias (obsolete-name current-name 390(defmacro define-obsolete-function-alias ( obsolete-name current-name when
394 &optional when docstring) 391 &optional docstring)
395 "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete. 392 "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete.
396 393
397\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\") 394\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\")
@@ -405,15 +402,13 @@ WHEN should be a string indicating when the function was first
405made obsolete, for example a date or a release number. 402made obsolete, for example a date or a release number.
406 403
407See the docstrings of `defalias' and `make-obsolete' for more details." 404See the docstrings of `defalias' and `make-obsolete' for more details."
408 (declare (doc-string 4) 405 (declare (doc-string 4))
409 (advertised-calling-convention
410 ;; New code should always provide the `when' argument.
411 (obsolete-name current-name when &optional docstring) "23.1"))
412 `(progn 406 `(progn
413 (defalias ,obsolete-name ,current-name ,docstring) 407 (defalias ,obsolete-name ,current-name ,docstring)
414 (make-obsolete ,obsolete-name ,current-name ,when))) 408 (make-obsolete ,obsolete-name ,current-name ,when)))
415 409
416(defun make-obsolete-variable (obsolete-name current-name &optional when access-type) 410(defun make-obsolete-variable ( obsolete-name current-name when
411 &optional access-type)
417 "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. 412 "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
418The warning will say that CURRENT-NAME should be used instead. 413The warning will say that CURRENT-NAME should be used instead.
419If CURRENT-NAME is a string, that is the `use instead' message. 414If CURRENT-NAME is a string, that is the `use instead' message.
@@ -421,16 +416,13 @@ WHEN should be a string indicating when the variable
421was first made obsolete, for example a date or a release number. 416was first made obsolete, for example a date or a release number.
422ACCESS-TYPE if non-nil should specify the kind of access that will trigger 417ACCESS-TYPE if non-nil should specify the kind of access that will trigger
423 obsolescence warnings; it can be either `get' or `set'." 418 obsolescence warnings; it can be either `get' or `set'."
424 (declare (advertised-calling-convention
425 ;; New code should always provide the `when' argument.
426 (obsolete-name current-name when &optional access-type) "23.1"))
427 (put obsolete-name 'byte-obsolete-variable 419 (put obsolete-name 'byte-obsolete-variable
428 (purecopy (list current-name access-type when))) 420 (purecopy (list current-name access-type when)))
429 obsolete-name) 421 obsolete-name)
430 422
431 423
432(defmacro define-obsolete-variable-alias (obsolete-name current-name 424(defmacro define-obsolete-variable-alias ( obsolete-name current-name when
433 &optional when docstring) 425 &optional docstring)
434 "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. 426 "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
435 427
436WHEN should be a string indicating when the variable was first 428WHEN should be a string indicating when the variable was first
@@ -459,10 +451,7 @@ For the benefit of Customize, if OBSOLETE-NAME has
459any of the following properties, they are copied to 451any of the following properties, they are copied to
460CURRENT-NAME, if it does not already have them: 452CURRENT-NAME, if it does not already have them:
461`saved-value', `saved-variable-comment'." 453`saved-value', `saved-variable-comment'."
462 (declare (doc-string 4) 454 (declare (doc-string 4))
463 (advertised-calling-convention
464 ;; New code should always provide the `when' argument.
465 (obsolete-name current-name when &optional docstring) "23.1"))
466 `(progn 455 `(progn
467 (defvaralias ,obsolete-name ,current-name ,docstring) 456 (defvaralias ,obsolete-name ,current-name ,docstring)
468 ;; See Bug#4706. 457 ;; See Bug#4706.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 76457814acd..360da6b6ba6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3441,10 +3441,11 @@ for symbols generated by the byte compiler itself."
3441 (and od 3441 (and od
3442 (not (memq var byte-compile-not-obsolete-vars)) 3442 (not (memq var byte-compile-not-obsolete-vars))
3443 (not (memq var byte-compile-global-not-obsolete-vars)) 3443 (not (memq var byte-compile-global-not-obsolete-vars))
3444 (or (pcase (nth 1 od) 3444 (not (memq var byte-compile-lexical-variables))
3445 ('set (not (eq access-type 'reference))) 3445 (pcase (nth 1 od)
3446 ('get (eq access-type 'reference)) 3446 ('set (not (eq access-type 'reference)))
3447 (_ t))))) 3447 ('get (eq access-type 'reference))
3448 (_ t))))
3448 (byte-compile-warn-obsolete var)))) 3449 (byte-compile-warn-obsolete var))))
3449 3450
3450(defsubst byte-compile-dynamic-variable-op (base-op var) 3451(defsubst byte-compile-dynamic-variable-op (base-op var)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 19dd54c8645..8e36dbe4a36 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY."
304 (lambda ,args ,@body)))) 304 (lambda ,args ,@body))))
305 305
306(eval-and-compile ;Needed while compiling the cl-defmethod calls below! 306(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
307 (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
308 "Check which of the symbols VARS appear in SEXP."
309 (let ((res '()))
310 (while (consp sexp)
311 (dolist (var (cl--generic-fgrep vars (pop sexp)))
312 (unless (memq var res) (push var res))))
313 (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
314 res))
315
316 (defun cl--generic-split-args (args) 307 (defun cl--generic-split-args (args)
317 "Return (SPEC-ARGS . PLAIN-ARGS)." 308 "Return (SPEC-ARGS . PLAIN-ARGS)."
318 (let ((plain-args ()) 309 (let ((plain-args ())
@@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY."
375 ;; is used. 366 ;; is used.
376 ;; FIXME: Also, optimize the case where call-next-method is 367 ;; FIXME: Also, optimize the case where call-next-method is
377 ;; only called with explicit arguments. 368 ;; only called with explicit arguments.
378 (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) 369 (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
379 (cons (not (not uses-cnm)) 370 (cons (not (not uses-cnm))
380 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) 371 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
381 ,@(car parsed-body) 372 ,@(car parsed-body)
382 ,(if (not (memq nmp uses-cnm)) 373 ,(if (not (assq nmp uses-cnm))
383 nbody 374 nbody
384 `(let ((,nmp (lambda () 375 `(let ((,nmp (lambda ()
385 (cl--generic-isnot-nnm-p ,cnm)))) 376 (cl--generic-isnot-nnm-p ,cnm))))
@@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
617 (lambda (,@fixedargs &rest args) 608 (lambda (,@fixedargs &rest args)
618 (let ,bindings 609 (let ,bindings
619 (apply (cl--generic-with-memoization 610 (apply (cl--generic-with-memoization
620 (gethash ,tag-exp method-cache) 611 (gethash ,tag-exp method-cache)
621 (cl--generic-cache-miss 612 (cl--generic-cache-miss
622 generic ',dispatch-arg dispatches-left methods 613 generic ',dispatch-arg dispatches-left methods
623 ,(if (cdr typescodes) 614 ,(if (cdr typescodes)
624 `(append ,@typescodes) (car typescodes)))) 615 `(append ,@typescodes) (car typescodes))))
625 ,@fixedargs args))))))))) 616 ,@fixedargs args)))))))))
626 617
627(defun cl--generic-make-function (generic) 618(defun cl--generic-make-function (generic)
@@ -1110,7 +1101,8 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
1110 (if (not (eq (car-safe specializer) 'head)) 1101 (if (not (eq (car-safe specializer) 'head))
1111 (cl-call-next-method) 1102 (cl-call-next-method)
1112 (cl--generic-with-memoization 1103 (cl--generic-with-memoization
1113 (gethash (cadr specializer) cl--generic-head-used) specializer) 1104 (gethash (cadr specializer) cl--generic-head-used)
1105 specializer)
1114 (list cl--generic-head-generalizer))) 1106 (list cl--generic-head-generalizer)))
1115 1107
1116(cl--generic-prefill-dispatchers 0 (head eql)) 1108(cl--generic-prefill-dispatchers 0 (head eql))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 1cb195d1296..c2bf02ccece 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2060,10 +2060,99 @@ Like `cl-flet' but the definitions can refer to previous ones.
2060 ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) 2060 ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
2061 (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) 2061 (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
2062 2062
2063(defun cl--self-tco (var fargs body)
2064 ;; This tries to "optimize" tail calls for the specific case
2065 ;; of recursive self-calls by replacing them with a `while' loop.
2066 ;; It is quite far from a general tail-call optimization, since it doesn't
2067 ;; even handle mutually recursive functions.
2068 (letrec
2069 ((done nil) ;; Non-nil if some TCO happened.
2070 (retvar (make-symbol "retval"))
2071 (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
2072 (make-symbol (symbol-name s))))
2073 fargs))
2074 (opt-exps (lambda (exps) ;; `exps' is in tail position!
2075 (append (butlast exps)
2076 (list (funcall opt (car (last exps)))))))
2077 (opt
2078 (lambda (exp) ;; `exp' is in tail position!
2079 (pcase exp
2080 ;; FIXME: Optimize `apply'?
2081 (`(funcall ,(pred (eq var)) . ,aargs)
2082 ;; This is a self-recursive call in tail position.
2083 (let ((sets nil)
2084 (fargs ofargs))
2085 (while fargs
2086 (pcase (pop fargs)
2087 ('&rest
2088 (push (pop fargs) sets)
2089 (push `(list . ,aargs) sets)
2090 ;; (cl-assert (null fargs))
2091 )
2092 ('&optional nil)
2093 (farg
2094 (push farg sets)
2095 (push (pop aargs) sets))))
2096 (setq done t)
2097 `(progn (setq . ,(nreverse sets))
2098 :recurse)))
2099 (`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
2100 (`(if ,cond ,then . ,else)
2101 `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
2102 (`(cond . ,conds)
2103 (let ((cs '()))
2104 (while conds
2105 (pcase (pop conds)
2106 (`(,exp)
2107 (push (if conds
2108 ;; This returns the value of `exp' but it's
2109 ;; only in tail position if it's the
2110 ;; last condition.
2111 `((setq ,retvar ,exp) nil)
2112 `(,(funcall opt exp)))
2113 cs))
2114 (exps
2115 (push (funcall opt-exps exps) cs))))
2116 (if (eq t (caar cs))
2117 `(cond . ,(nreverse cs))
2118 `(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
2119 ((and `(,(or 'let 'let*) ,bindings . ,exps)
2120 (guard
2121 ;; Note: it's OK for this `let' to shadow any
2122 ;; of the formal arguments since we will only
2123 ;; setq the fresh new `ofargs' vars instead ;-)
2124 (let ((shadowings
2125 (mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
2126 ;; If `var' is shadowed, then it clearly can't be
2127 ;; tail-called any more.
2128 (not (memq var shadowings)))))
2129 `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
2130 (_
2131 `(progn (setq ,retvar ,exp) nil))))))
2132
2133 (let ((optimized-body (funcall opt-exps body)))
2134 (if (not done)
2135 (cons fargs body)
2136 ;; We use two sets of vars: `ofargs' and `fargs' because we need
2137 ;; to be careful that if a closure captures a formal argument
2138 ;; in one iteration, it needs to capture a different binding
2139 ;; then that of other iterations, e.g.
2140 (cons
2141 ofargs
2142 `((let (,retvar)
2143 (while (let ,(delq nil
2144 (cl-mapcar
2145 (lambda (a oa)
2146 (unless (memq a cl--lambda-list-keywords)
2147 (list a oa)))
2148 fargs ofargs))
2149 . ,optimized-body))
2150 ,retvar)))))))
2151
2063;;;###autoload 2152;;;###autoload
2064(defmacro cl-labels (bindings &rest body) 2153(defmacro cl-labels (bindings &rest body)
2065 "Make local (recursive) function definitions. 2154 "Make local (recursive) function definitions.
2066Each definition can take the form (FUNC ARGLIST BODY...) where 2155+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
2067FUNC is the function name, ARGLIST its arguments, and BODY the 2156FUNC is the function name, ARGLIST its arguments, and BODY the
2068forms of the function body. FUNC is defined in any BODY, as well 2157forms of the function body. FUNC is defined in any BODY, as well
2069as FORM, so you can write recursive and mutually recursive 2158as FORM, so you can write recursive and mutually recursive
@@ -2075,17 +2164,33 @@ details.
2075 (let ((binds ()) (newenv macroexpand-all-environment)) 2164 (let ((binds ()) (newenv macroexpand-all-environment))
2076 (dolist (binding bindings) 2165 (dolist (binding bindings)
2077 (let ((var (make-symbol (format "--cl-%s--" (car binding))))) 2166 (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
2078 (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) 2167 (push (cons var (cdr binding)) binds)
2079 (push (cons (car binding) 2168 (push (cons (car binding)
2080 (lambda (&rest args) 2169 (lambda (&rest args)
2081 (if (eq (car args) cl--labels-magic) 2170 (if (eq (car args) cl--labels-magic)
2082 (list cl--labels-magic var) 2171 (list cl--labels-magic var)
2083 (cl-list* 'funcall var args)))) 2172 (cl-list* 'funcall var args))))
2084 newenv))) 2173 newenv)))
2085 (macroexpand-all `(letrec ,(nreverse binds) ,@body) 2174 ;; Don't override lexical-let's macro-expander.
2086 ;; Don't override lexical-let's macro-expander. 2175 (unless (assq 'function newenv)
2087 (if (assq 'function newenv) newenv 2176 (push (cons 'function #'cl--labels-convert) newenv))
2088 (cons (cons 'function #'cl--labels-convert) newenv))))) 2177 ;; Perform self-tail call elimination.
2178 (setq binds (mapcar
2179 (lambda (bind)
2180 (pcase-let*
2181 ((`(,var ,sargs . ,sbody) bind)
2182 (`(function (lambda ,fargs . ,ebody))
2183 (macroexpand-all `(cl-function (lambda ,sargs . ,sbody))
2184 newenv))
2185 (`(,ofargs . ,obody)
2186 (cl--self-tco var fargs ebody)))
2187 `(,var (function (lambda ,ofargs . ,obody)))))
2188 (nreverse binds)))
2189 `(letrec ,binds
2190 . ,(macroexp-unprogn
2191 (macroexpand-all
2192 (macroexp-progn body)
2193 newenv)))))
2089 2194
2090;; The following ought to have a better definition for use with newer 2195;; The following ought to have a better definition for use with newer
2091;; byte compilers. 2196;; byte compilers.
@@ -3383,8 +3488,8 @@ macro that returns its `&whole' argument."
3383 (put y 'side-effect-free t)) 3488 (put y 'side-effect-free t))
3384 3489
3385;;; Things that are inline. 3490;;; Things that are inline.
3386(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany 3491(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend
3387 cl-notevery cl-revappend cl-nreconc gethash)) 3492 cl-nreconc gethash))
3388 3493
3389;;; Things that are side-effect-free. 3494;;; Things that are side-effect-free.
3390(mapc (lambda (x) (function-put x 'side-effect-free t)) 3495(mapc (lambda (x) (function-put x 'side-effect-free t))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 3e5e9b95235..a8361c0d4b4 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -215,7 +215,8 @@ It creates an autoload function for CNAME's constructor."
215 ;; turn this into a usable self-pointing symbol 215 ;; turn this into a usable self-pointing symbol
216 (when eieio-backward-compatibility 216 (when eieio-backward-compatibility
217 (set cname cname) 217 (set cname cname)
218 (make-obsolete-variable cname (format "use \\='%s instead" cname) 218 (make-obsolete-variable cname (format "\
219use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
219 "25.1")) 220 "25.1"))
220 221
221 (setf (cl--find-class cname) newc) 222 (setf (cl--find-class cname) newc)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 82a8cd2d777..37844977f8f 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -480,6 +480,35 @@ itself or not."
480 v 480 v
481 (list 'quote v))) 481 (list 'quote v)))
482 482
483(defun macroexp--fgrep (bindings sexp)
484 "Return those of the BINDINGS which might be used in SEXP.
485It is used as a poor-man's \"free variables\" test. It differs from a true
486test of free variables in the following ways:
487- It does not distinguish variables from functions, so it can be used
488 both to detect whether a given variable is used by SEXP and to
489 detect whether a given function is used by SEXP.
490- It does not actually know ELisp syntax, so it only looks for the presence
491 of symbols in SEXP and can't distinguish if those symbols are truly
492 references to the given variable (or function). That can make the result
493 include bindings which actually aren't used.
494- For the same reason it may cause the result to fail to include bindings
495 which will be used if SEXP is not yet fully macro-expanded and the
496 use of the binding will only be revealed by macro expansion."
497 (let ((res '()))
498 (while (and (consp sexp) bindings)
499 (dolist (binding (macroexp--fgrep bindings (pop sexp)))
500 (push binding res)
501 (setq bindings (remove binding bindings))))
502 (if (or (vectorp sexp) (byte-code-function-p sexp))
503 ;; With backquote, code can appear within vectors as well.
504 ;; This wouldn't be needed if we `macroexpand-all' before
505 ;; calling macroexp--fgrep, OTOH.
506 (macroexp--fgrep bindings (mapcar #'identity sexp))
507 (let ((tmp (assq sexp bindings)))
508 (if tmp
509 (cons tmp res)
510 res)))))
511
483;;; Load-time macro-expansion. 512;;; Load-time macro-expansion.
484 513
485;; Because macro-expansion used to be more lazy, eager macro-expansion 514;; Because macro-expansion used to be more lazy, eager macro-expansion
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 40ba1355513..453e86c7831 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -173,12 +173,12 @@ with \"-q\").
173 173
174Even if the value is nil, you can type \\[package-initialize] to 174Even if the value is nil, you can type \\[package-initialize] to
175make installed packages available at any time, or you can 175make installed packages available at any time, or you can
176call (package-initialize) in your init-file." 176call (package-activate-all) in your init-file."
177 :type 'boolean 177 :type 'boolean
178 :version "24.1") 178 :version "24.1")
179 179
180(defcustom package-load-list '(all) 180(defcustom package-load-list '(all)
181 "List of packages for `package-initialize' to make available. 181 "List of packages for `package-activate-all' to make available.
182Each element in this list should be a list (NAME VERSION), or the 182Each element in this list should be a list (NAME VERSION), or the
183symbol `all'. The symbol `all' says to make available the latest 183symbol `all'. The symbol `all' says to make available the latest
184installed versions of all packages not specified by other 184installed versions of all packages not specified by other
@@ -292,15 +292,18 @@ the package will be unavailable."
292 :risky t 292 :risky t
293 :version "24.4") 293 :version "24.4")
294 294
295;;;###autoload
295(defcustom package-user-dir (locate-user-emacs-file "elpa") 296(defcustom package-user-dir (locate-user-emacs-file "elpa")
296 "Directory containing the user's Emacs Lisp packages. 297 "Directory containing the user's Emacs Lisp packages.
297The directory name should be absolute. 298The directory name should be absolute.
298Apart from this directory, Emacs also looks for system-wide 299Apart from this directory, Emacs also looks for system-wide
299packages in `package-directory-list'." 300packages in `package-directory-list'."
300 :type 'directory 301 :type 'directory
302 :initialize #'custom-initialize-delay
301 :risky t 303 :risky t
302 :version "24.1") 304 :version "24.1")
303 305
306;;;###autoload
304(defcustom package-directory-list 307(defcustom package-directory-list
305 ;; Defaults are subdirs named "elpa" in the site-lisp dirs. 308 ;; Defaults are subdirs named "elpa" in the site-lisp dirs.
306 (let (result) 309 (let (result)
@@ -315,6 +318,7 @@ Each directory name should be absolute.
315These directories contain packages intended for system-wide; in 318These directories contain packages intended for system-wide; in
316contrast, `package-user-dir' contains packages for personal use." 319contrast, `package-user-dir' contains packages for personal use."
317 :type '(repeat directory) 320 :type '(repeat directory)
321 :initialize #'custom-initialize-delay
318 :risky t 322 :risky t
319 :version "24.1") 323 :version "24.1")
320 324
@@ -587,9 +591,8 @@ package."
587;;; Installed packages 591;;; Installed packages
588;; The following variables store information about packages present in 592;; The following variables store information about packages present in
589;; the system. The most important of these is `package-alist'. The 593;; the system. The most important of these is `package-alist'. The
590;; command `package-initialize' is also closely related to this 594;; command `package-activate-all' is also closely related to this
591;; section, but it is left for a later section because it also affects 595;; section.
592;; other stuff.
593 596
594(defvar package--builtins nil 597(defvar package--builtins nil
595 "Alist of built-in packages. 598 "Alist of built-in packages.
@@ -608,7 +611,7 @@ name (a symbol) and DESCS is a non-empty list of `package-desc'
608structures, sorted by decreasing versions. 611structures, sorted by decreasing versions.
609 612
610This variable is set automatically by `package-load-descriptor', 613This variable is set automatically by `package-load-descriptor',
611called via `package-initialize'. To change which packages are 614called via `package-activate-all'. To change which packages are
612loaded and/or activated, customize `package-load-list'.") 615loaded and/or activated, customize `package-load-list'.")
613(put 'package-alist 'risky-local-variable t) 616(put 'package-alist 'risky-local-variable t)
614 617
@@ -869,6 +872,20 @@ DIR, sorted by most recently loaded last."
869 (lambda (x y) (< (cdr x) (cdr y)))))))) 872 (lambda (x y) (< (cdr x) (cdr y))))))))
870 873
871;;;; `package-activate' 874;;;; `package-activate'
875
876(defun package--get-activatable-pkg (pkg-name)
877 ;; Is "activatable" a word?
878 (let ((pkg-descs (cdr (assq pkg-name package-alist))))
879 ;; Check if PACKAGE is available in `package-alist'.
880 (while
881 (when pkg-descs
882 (let ((available-version (package-desc-version (car pkg-descs))))
883 (or (package-disabled-p pkg-name available-version)
884 ;; Prefer a builtin package.
885 (package-built-in-p pkg-name available-version))))
886 (setq pkg-descs (cdr pkg-descs)))
887 (car pkg-descs)))
888
872;; This function activates a newer version of a package if an older 889;; This function activates a newer version of a package if an older
873;; one was already activated. It also loads a features of this 890;; one was already activated. It also loads a features of this
874;; package which were already loaded. 891;; package which were already loaded.
@@ -876,24 +893,16 @@ DIR, sorted by most recently loaded last."
876 "Activate the package named PACKAGE. 893 "Activate the package named PACKAGE.
877If FORCE is true, (re-)activate it if it's already activated. 894If FORCE is true, (re-)activate it if it's already activated.
878Newer versions are always activated, regardless of FORCE." 895Newer versions are always activated, regardless of FORCE."
879 (let ((pkg-descs (cdr (assq package package-alist)))) 896 (let ((pkg-desc (package--get-activatable-pkg package)))
880 ;; Check if PACKAGE is available in `package-alist'.
881 (while
882 (when pkg-descs
883 (let ((available-version (package-desc-version (car pkg-descs))))
884 (or (package-disabled-p package available-version)
885 ;; Prefer a builtin package.
886 (package-built-in-p package available-version))))
887 (setq pkg-descs (cdr pkg-descs)))
888 (cond 897 (cond
889 ;; If no such package is found, maybe it's built-in. 898 ;; If no such package is found, maybe it's built-in.
890 ((null pkg-descs) 899 ((null pkg-desc)
891 (package-built-in-p package)) 900 (package-built-in-p package))
892 ;; If the package is already activated, just return t. 901 ;; If the package is already activated, just return t.
893 ((and (memq package package-activated-list) (not force)) 902 ((and (memq package package-activated-list) (not force))
894 t) 903 t)
895 ;; Otherwise, proceed with activation. 904 ;; Otherwise, proceed with activation.
896 (t (package-activate-1 (car pkg-descs) nil 'deps))))) 905 (t (package-activate-1 pkg-desc nil 'deps)))))
897 906
898 907
899;;; Installation -- Local operations 908;;; Installation -- Local operations
@@ -1616,9 +1625,8 @@ that code in the early init-file."
1616 ;; `package--initialized' is t. 1625 ;; `package--initialized' is t.
1617 (package--build-compatibility-table)) 1626 (package--build-compatibility-table))
1618 1627
1619(defvar package-quickstart-file)
1620
1621;;;###autoload 1628;;;###autoload
1629(progn ;; Make the function usable without loading `package.el'.
1622(defun package-activate-all () 1630(defun package-activate-all ()
1623 "Activate all installed packages. 1631 "Activate all installed packages.
1624The variable `package-load-list' controls which packages to load." 1632The variable `package-load-list' controls which packages to load."
@@ -1632,13 +1640,19 @@ The variable `package-load-list' controls which packages to load."
1632 ;; 2 when loading the .el file (this assumes we were careful to 1640 ;; 2 when loading the .el file (this assumes we were careful to
1633 ;; save this file so it doesn't need any decoding). 1641 ;; save this file so it doesn't need any decoding).
1634 (let ((load-source-file-function nil)) 1642 (let ((load-source-file-function nil))
1643 (unless (boundp 'package-activated-list)
1644 (setq package-activated-list nil))
1635 (load qs nil 'nomessage)) 1645 (load qs nil 'nomessage))
1636 (dolist (elt (package--alist)) 1646 (require 'package)
1637 (condition-case err 1647 (package--activate-all)))))
1638 (package-activate (car elt)) 1648
1639 ;; Don't let failure of activation of a package arbitrarily stop 1649(defun package--activate-all ()
1640 ;; activation of further packages. 1650 (dolist (elt (package--alist))
1641 (error (message "%s" (error-message-string err)))))))) 1651 (condition-case err
1652 (package-activate (car elt))
1653 ;; Don't let failure of activation of a package arbitrarily stop
1654 ;; activation of further packages.
1655 (error (message "%s" (error-message-string err))))))
1642 1656
1643;;;; Populating `package-archive-contents' from archives 1657;;;; Populating `package-archive-contents' from archives
1644;; This subsection populates the variables listed above from the 1658;; This subsection populates the variables listed above from the
@@ -2066,6 +2080,13 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
2066using `package-compute-transaction'." 2080using `package-compute-transaction'."
2067 (mapc #'package-install-from-archive packages)) 2081 (mapc #'package-install-from-archive packages))
2068 2082
2083(defun package--archives-initialize ()
2084 "Make sure the list of installed and remote packages are initialized."
2085 (unless package--initialized
2086 (package-initialize t))
2087 (unless package-archive-contents
2088 (package-refresh-contents)))
2089
2069;;;###autoload 2090;;;###autoload
2070(defun package-install (pkg &optional dont-select) 2091(defun package-install (pkg &optional dont-select)
2071 "Install the package PKG. 2092 "Install the package PKG.
@@ -2086,10 +2107,7 @@ to install it but still mark it as selected."
2086 (progn 2107 (progn
2087 ;; Initialize the package system to get the list of package 2108 ;; Initialize the package system to get the list of package
2088 ;; symbols for completion. 2109 ;; symbols for completion.
2089 (unless package--initialized 2110 (package--archives-initialize)
2090 (package-initialize t))
2091 (unless package-archive-contents
2092 (package-refresh-contents))
2093 (list (intern (completing-read 2111 (list (intern (completing-read
2094 "Install package: " 2112 "Install package: "
2095 (delq nil 2113 (delq nil
@@ -2099,6 +2117,7 @@ to install it but still mark it as selected."
2099 package-archive-contents)) 2117 package-archive-contents))
2100 nil t)) 2118 nil t))
2101 nil))) 2119 nil)))
2120 (package--archives-initialize)
2102 (add-hook 'post-command-hook #'package-menu--post-refresh) 2121 (add-hook 'post-command-hook #'package-menu--post-refresh)
2103 (let ((name (if (package-desc-p pkg) 2122 (let ((name (if (package-desc-p pkg)
2104 (package-desc-name pkg) 2123 (package-desc-name pkg)
@@ -3714,7 +3733,7 @@ short description."
3714 (package-menu--generate nil t))) 3733 (package-menu--generate nil t)))
3715 ;; The package menu buffer has keybindings. If the user types 3734 ;; The package menu buffer has keybindings. If the user types
3716 ;; `M-x list-packages', that suggests it should become current. 3735 ;; `M-x list-packages', that suggests it should become current.
3717 (switch-to-buffer buf))) 3736 (pop-to-buffer-same-window buf)))
3718 3737
3719;;;###autoload 3738;;;###autoload
3720(defalias 'package-list-packages 'list-packages) 3739(defalias 'package-list-packages 'list-packages)
@@ -4042,10 +4061,12 @@ activations need to be changed, such as when `package-load-list' is modified."
4042 :type 'boolean 4061 :type 'boolean
4043 :version "27.1") 4062 :version "27.1")
4044 4063
4064;;;###autoload
4045(defcustom package-quickstart-file 4065(defcustom package-quickstart-file
4046 (locate-user-emacs-file "package-quickstart.el") 4066 (locate-user-emacs-file "package-quickstart.el")
4047 "Location of the file used to speed up activation of packages at startup." 4067 "Location of the file used to speed up activation of packages at startup."
4048 :type 'file 4068 :type 'file
4069 :initialize #'custom-initialize-delay
4049 :version "27.1") 4070 :version "27.1")
4050 4071
4051(defun package--quickstart-maybe-refresh () 4072(defun package--quickstart-maybe-refresh ()
@@ -4111,6 +4132,8 @@ activations need to be changed, such as when `package-load-list' is modified."
4111;; no-update-autoloads: t 4132;; no-update-autoloads: t
4112;; End: 4133;; End:
4113")) 4134"))
4135 ;; FIXME: Do it asynchronously in an Emacs subprocess, and
4136 ;; don't show the byte-compiler warnings.
4114 (byte-compile-file package-quickstart-file))) 4137 (byte-compile-file package-quickstart-file)))
4115 4138
4116(defun package--imenu-prev-index-position-function () 4139(defun package--imenu-prev-index-position-function ()
@@ -4131,6 +4154,15 @@ beginning of the line."
4131 (package-version-join (package-desc-version package-desc)) 4154 (package-version-join (package-desc-version package-desc))
4132 (package-desc-summary package-desc)))) 4155 (package-desc-summary package-desc))))
4133 4156
4157;;;; Introspection
4158
4159(defun package-get-descriptor (pkg-name)
4160 "Return the `package-desc' of PKG-NAME."
4161 (unless package--initialized (package-initialize 'no-activate))
4162 (or (package--get-activatable-pkg pkg-name)
4163 (cadr (assq pkg-name package-alist))
4164 (cadr (assq pkg-name package-archive-contents))))
4165
4134(provide 'package) 4166(provide 'package)
4135 4167
4136;;; package.el ends here 4168;;; package.el ends here
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 8fb79d220de..72ea1ba0188 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,7 @@ of the elements of LIST is performed as if by `pcase-let'.
344 (seen '()) 344 (seen '())
345 (codegen 345 (codegen
346 (lambda (code vars) 346 (lambda (code vars)
347 (let ((vars (pcase--fgrep vars code)) 347 (let ((vars (macroexp--fgrep vars code))
348 (prev (assq code seen))) 348 (prev (assq code seen)))
349 (if (not prev) 349 (if (not prev)
350 (let ((res (pcase-codegen code vars))) 350 (let ((res (pcase-codegen code vars)))
@@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'.
401 ;; occurrences of this leaf since it's small. 401 ;; occurrences of this leaf since it's small.
402 (lambda (code vars) 402 (lambda (code vars)
403 (pcase-codegen code 403 (pcase-codegen code
404 (pcase--fgrep vars code))) 404 (macroexp--fgrep vars code)))
405 codegen) 405 codegen)
406 (cdr case) 406 (cdr case)
407 vars)))) 407 vars))))
@@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form:
668 ;; run, but we don't have the environment in which `pat' will 668 ;; run, but we don't have the environment in which `pat' will
669 ;; run, so we can't do a reliable verification. But let's try 669 ;; run, so we can't do a reliable verification. But let's try
670 ;; and catch at least the easy cases such as (bug#14773). 670 ;; and catch at least the easy cases such as (bug#14773).
671 (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) 671 (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
672 '(:pcase--succeed . :pcase--fail)) 672 '(:pcase--succeed . :pcase--fail))
673 ((and (eq 'pred (car upat)) 673 ((and (eq 'pred (car upat))
674 (let ((otherpred 674 (let ((otherpred
@@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form:
692 '(nil . :pcase--fail) 692 '(nil . :pcase--fail)
693 '(:pcase--fail . nil)))))) 693 '(:pcase--fail . nil))))))
694 694
695(defun pcase--fgrep (bindings sexp)
696 "Return those of the BINDINGS which might be used in SEXP."
697 (let ((res '()))
698 (while (and (consp sexp) bindings)
699 (dolist (binding (pcase--fgrep bindings (pop sexp)))
700 (push binding res)
701 (setq bindings (remove binding bindings))))
702 (if (vectorp sexp)
703 ;; With backquote, code can appear within vectors as well.
704 ;; This wouldn't be needed if we `macroexpand-all' before
705 ;; calling pcase--fgrep, OTOH.
706 (pcase--fgrep bindings (mapcar #'identity sexp))
707 (let ((tmp (assq sexp bindings)))
708 (if tmp
709 (cons tmp res)
710 res)))))
711
712(defun pcase--self-quoting-p (upat) 695(defun pcase--self-quoting-p (upat)
713 (or (keywordp upat) (integerp upat) (stringp upat))) 696 (or (keywordp upat) (integerp upat) (stringp upat)))
714 697
@@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form:
749 `(,fun ,arg) 732 `(,fun ,arg)
750 (let* (;; `env' is an upper bound on the bindings we need. 733 (let* (;; `env' is an upper bound on the bindings we need.
751 (env (mapcar (lambda (x) (list (car x) (cdr x))) 734 (env (mapcar (lambda (x) (list (car x) (cdr x)))
752 (pcase--fgrep vars fun))) 735 (macroexp--fgrep vars fun)))
753 (call (progn 736 (call (progn
754 (when (assq arg env) 737 (when (assq arg env)
755 ;; `arg' is shadowed by `env'. 738 ;; `arg' is shadowed by `env'.
@@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form:
770 "Build an expression that will evaluate EXP." 753 "Build an expression that will evaluate EXP."
771 (let* ((found (assq exp vars))) 754 (let* ((found (assq exp vars)))
772 (if found (cdr found) 755 (if found (cdr found)
773 (let* ((env (pcase--fgrep vars exp))) 756 (let* ((env (macroexp--fgrep vars exp)))
774 (if env 757 (if env
775 (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) 758 (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
776 env) 759 env)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 1044acff8d5..bb68173b6dc 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1046,8 +1046,8 @@ anyway."
1046(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") 1046(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
1047 1047
1048(defcustom erc-pre-send-functions nil 1048(defcustom erc-pre-send-functions nil
1049 "List of functions called to possibly alter the string that is sent. 1049 "Special hook run to possibly alter the string that is sent.
1050The functions are called with one argument, a `erc-input' struct, 1050The functions are called with one argument, an `erc-input' struct,
1051and should alter that struct. 1051and should alter that struct.
1052 1052
1053The struct has three slots: 1053The struct has three slots:
@@ -1056,7 +1056,7 @@ The struct has three slots:
1056 `insertp': Whether the string should be inserted into the erc buffer. 1056 `insertp': Whether the string should be inserted into the erc buffer.
1057 `sendp': Whether the string should be sent to the irc server." 1057 `sendp': Whether the string should be sent to the irc server."
1058 :group 'erc 1058 :group 'erc
1059 :type '(repeat function) 1059 :type 'hook
1060 :version "27.1") 1060 :version "27.1")
1061 1061
1062(defvar erc-insert-this t 1062(defvar erc-insert-this t
@@ -1295,9 +1295,9 @@ Example:
1295 (define-erc-module replace nil 1295 (define-erc-module replace nil
1296 \"This mode replaces incoming text according to `erc-replace-alist'.\" 1296 \"This mode replaces incoming text according to `erc-replace-alist'.\"
1297 ((add-hook \\='erc-insert-modify-hook 1297 ((add-hook \\='erc-insert-modify-hook
1298 \\='erc-replace-insert)) 1298 #\\='erc-replace-insert))
1299 ((remove-hook \\='erc-insert-modify-hook 1299 ((remove-hook \\='erc-insert-modify-hook
1300 \\='erc-replace-insert)))" 1300 #\\='erc-replace-insert)))"
1301 (declare (doc-string 3)) 1301 (declare (doc-string 3))
1302 (let* ((sn (symbol-name name)) 1302 (let* ((sn (symbol-name name))
1303 (mode (intern (format "erc-%s-mode" (downcase sn)))) 1303 (mode (intern (format "erc-%s-mode" (downcase sn))))
@@ -1495,7 +1495,7 @@ Defaults to the server buffer."
1495 (setq-local paragraph-start 1495 (setq-local paragraph-start
1496 (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) 1496 (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
1497 (setq-local completion-ignore-case t) 1497 (setq-local completion-ignore-case t)
1498 (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t)) 1498 (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
1499 1499
1500;; activation 1500;; activation
1501 1501
@@ -2585,7 +2585,7 @@ This function adds `erc-lurker-update-status' to
2585most recent PRIVMSG as well as initializing the state variable 2585most recent PRIVMSG as well as initializing the state variable
2586storing this information." 2586storing this information."
2587 (setq erc-lurker-state (make-hash-table :test 'equal)) 2587 (setq erc-lurker-state (make-hash-table :test 'equal))
2588 (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status)) 2588 (add-hook 'erc-insert-pre-hook #'erc-lurker-update-status))
2589 2589
2590(defun erc-lurker-cleanup () 2590(defun erc-lurker-cleanup ()
2591 "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'. 2591 "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
@@ -2694,7 +2694,7 @@ otherwise `erc-server-announced-name'. SERVER is matched against
2694(defun erc-add-targets (scope target-list) 2694(defun erc-add-targets (scope target-list)
2695 (let ((targets 2695 (let ((targets
2696 (mapcar (lambda (targets) (member scope targets)) target-list))) 2696 (mapcar (lambda (targets) (member scope targets)) target-list)))
2697 (cdr (apply 'append (delete nil targets))))) 2697 (cdr (apply #'append (delete nil targets)))))
2698 2698
2699(defun erc-hide-current-message-p (parsed) 2699(defun erc-hide-current-message-p (parsed)
2700 "Predicate indicating whether the parsed ERC response PARSED should be hidden. 2700 "Predicate indicating whether the parsed ERC response PARSED should be hidden.
@@ -3038,7 +3038,7 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
3038 (erc-display-message 3038 (erc-display-message
3039 nil 'notice (current-buffer) 'ops 3039 nil 'notice (current-buffer) 'ops
3040 ?i (length ops) ?s (if (> (length ops) 1) "s" "") 3040 ?i (length ops) ?s (if (> (length ops) 1) "s" "")
3041 ?o (mapconcat 'identity ops " ")) 3041 ?o (mapconcat #'identity ops " "))
3042 (erc-display-message nil 'notice (current-buffer) 'ops-none))) 3042 (erc-display-message nil 'notice (current-buffer) 'ops-none)))
3043 t) 3043 t)
3044 3044
@@ -3209,7 +3209,7 @@ command."
3209(defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords) 3209(defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
3210 "Kick the user indicated in LINE from the current channel. 3210 "Kick the user indicated in LINE from the current channel.
3211LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"." 3211LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
3212 (let ((reasonstring (mapconcat 'identity reasonwords " "))) 3212 (let ((reasonstring (mapconcat #'identity reasonwords " ")))
3213 (if (string= "" reasonstring) 3213 (if (string= "" reasonstring)
3214 (setq reasonstring (format "Kicked by %s" (erc-current-nick)))) 3214 (setq reasonstring (format "Kicked by %s" (erc-current-nick))))
3215 (if (erc-channel-p target) 3215 (if (erc-channel-p target)
@@ -3744,7 +3744,7 @@ the message given by REASON."
3744 " -" 3744 " -"
3745 (make-string (length people) ?o) 3745 (make-string (length people) ?o)
3746 " " 3746 " "
3747 (mapconcat 'identity people " "))) 3747 (mapconcat #'identity people " ")))
3748 t)) 3748 t))
3749 3749
3750(defun erc-cmd-OP (&rest people) 3750(defun erc-cmd-OP (&rest people)
@@ -3754,7 +3754,7 @@ the message given by REASON."
3754 " +" 3754 " +"
3755 (make-string (length people) ?o) 3755 (make-string (length people) ?o)
3756 " " 3756 " "
3757 (mapconcat 'identity people " "))) 3757 (mapconcat #'identity people " ")))
3758 t)) 3758 t))
3759 3759
3760(defun erc-cmd-TIME (&optional line) 3760(defun erc-cmd-TIME (&optional line)
@@ -3952,7 +3952,7 @@ Unban all currently banned users in the current channel."
3952 (erc-server-send 3952 (erc-server-send
3953 (format "MODE %s -%s %s" (erc-default-target) 3953 (format "MODE %s -%s %s" (erc-default-target)
3954 (make-string (length x) ?b) 3954 (make-string (length x) ?b)
3955 (mapconcat 'identity x " ")))) 3955 (mapconcat #'identity x " "))))
3956 (erc-group-list bans 3)))) 3956 (erc-group-list bans 3))))
3957 t)))) 3957 t))))
3958 3958
@@ -4183,7 +4183,7 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
4183 (erc-display-message 4183 (erc-display-message
4184 parsed 'notice proc 4184 parsed 'notice proc
4185 (mapconcat 4185 (mapconcat
4186 'identity 4186 #'identity
4187 (let (res) 4187 (let (res)
4188 (mapc #'(lambda (x) 4188 (mapc #'(lambda (x)
4189 (if (stringp x) 4189 (if (stringp x)
@@ -5553,12 +5553,10 @@ This returns non-nil only if we actually send anything."
5553 ;; Instead `erc-pre-send-functions' is used as a filter to do 5553 ;; Instead `erc-pre-send-functions' is used as a filter to do
5554 ;; allow both changing and suppressing the string. 5554 ;; allow both changing and suppressing the string.
5555 (run-hook-with-args 'erc-send-pre-hook input) 5555 (run-hook-with-args 'erc-send-pre-hook input)
5556 (setq state (make-erc-input :string str 5556 (setq state (make-erc-input :string str ;May be != from `input' now!
5557 :insertp erc-insert-this 5557 :insertp erc-insert-this
5558 :sendp erc-send-this)) 5558 :sendp erc-send-this))
5559 (dolist (func erc-pre-send-functions) 5559 (run-hook-with-args 'erc-pre-send-functions state)
5560 ;; The functions can return nil to inhibit sending.
5561 (funcall func state))
5562 (when (and (erc-input-sendp state) 5560 (when (and (erc-input-sendp state)
5563 erc-send-this) 5561 erc-send-this)
5564 (let ((string (erc-input-string state))) 5562 (let ((string (erc-input-string state)))
@@ -5579,26 +5577,26 @@ This returns non-nil only if we actually send anything."
5579 (erc-process-input-line (concat string "\n") t nil)) 5577 (erc-process-input-line (concat string "\n") t nil))
5580 t)))))) 5578 t))))))
5581 5579
5582(defun erc-display-command (line) 5580;; (defun erc-display-command (line)
5583 (when erc-insert-this 5581;; (when erc-insert-this
5584 (let ((insert-position (point))) 5582;; (let ((insert-position (point)))
5585 (unless erc-hide-prompt 5583;; (unless erc-hide-prompt
5586 (erc-display-prompt nil nil (erc-command-indicator) 5584;; (erc-display-prompt nil nil (erc-command-indicator)
5587 (and (erc-command-indicator) 5585;; (and (erc-command-indicator)
5588 'erc-command-indicator-face))) 5586;; 'erc-command-indicator-face)))
5589 (let ((beg (point))) 5587;; (let ((beg (point)))
5590 (insert line) 5588;; (insert line)
5591 (erc-put-text-property beg (point) 5589;; (erc-put-text-property beg (point)
5592 'font-lock-face 'erc-command-indicator-face) 5590;; 'font-lock-face 'erc-command-indicator-face)
5593 (insert "\n")) 5591;; (insert "\n"))
5594 (when (processp erc-server-process) 5592;; (when (processp erc-server-process)
5595 (set-marker (process-mark erc-server-process) (point))) 5593;; (set-marker (process-mark erc-server-process) (point)))
5596 (set-marker erc-insert-marker (point)) 5594;; (set-marker erc-insert-marker (point))
5597 (save-excursion 5595;; (save-excursion
5598 (save-restriction 5596;; (save-restriction
5599 (narrow-to-region insert-position (point)) 5597;; (narrow-to-region insert-position (point))
5600 (run-hooks 'erc-send-modify-hook) 5598;; (run-hooks 'erc-send-modify-hook)
5601 (run-hooks 'erc-send-post-hook)))))) 5599;; (run-hooks 'erc-send-post-hook))))))
5602 5600
5603(defun erc-display-msg (line) 5601(defun erc-display-msg (line)
5604 "Display LINE as a message of the user to the current target at the 5602 "Display LINE as a message of the user to the current target at the
@@ -6563,7 +6561,7 @@ If optional argument HERE is non-nil, insert version number at point."
6563If optional argument HERE is non-nil, insert version number at point." 6561If optional argument HERE is non-nil, insert version number at point."
6564 (interactive "P") 6562 (interactive "P")
6565 (let ((string 6563 (let ((string
6566 (mapconcat 'identity 6564 (mapconcat #'identity
6567 (let (modes (case-fold-search nil)) 6565 (let (modes (case-fold-search nil))
6568 (dolist (var (apropos-internal "^erc-.*mode$")) 6566 (dolist (var (apropos-internal "^erc-.*mode$"))
6569 (when (and (boundp var) 6567 (when (and (boundp var)
@@ -6817,7 +6815,8 @@ See also `format-spec'."
6817 6815
6818;;; Various hook functions 6816;;; Various hook functions
6819 6817
6820(add-hook 'kill-buffer-hook 'erc-kill-buffer-function) 6818;; FIXME: Don't set the hook globally!
6819(add-hook 'kill-buffer-hook #'erc-kill-buffer-function)
6821 6820
6822(defcustom erc-kill-server-hook '(erc-kill-server) 6821(defcustom erc-kill-server-hook '(erc-kill-server)
6823 "Invoked whenever a server buffer is killed via `kill-buffer'." 6822 "Invoked whenever a server buffer is killed via `kill-buffer'."
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index d362adcc9b7..2609397b0d9 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,4 +1,4 @@
1;;; facemenu.el --- create a face menu for interactively adding fonts to text 1;;; facemenu.el --- create a face menu for interactively adding fonts to text -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 7c01b15b345..2ef13ae8320 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,4 +1,4 @@
1;;; filesets.el --- handle group of files 1;;; filesets.el --- handle group of files -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2002-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
4 4
@@ -88,7 +88,8 @@
88 88
89;;; Code: 89;;; Code:
90 90
91(eval-when-compile (require 'cl-lib)) 91(require 'cl-lib)
92(require 'seq)
92(require 'easymenu) 93(require 'easymenu)
93 94
94;;; Some variables 95;;; Some variables
@@ -153,52 +154,25 @@ COND-FN takes one argument: the current element."
153; (cl-remove 'dummy lst :test (lambda (dummy elt) 154; (cl-remove 'dummy lst :test (lambda (dummy elt)
154; (not (funcall cond-fn elt))))) 155; (not (funcall cond-fn elt)))))
155 (let ((rv nil)) 156 (let ((rv nil))
156 (dolist (elt lst rv) 157 (dolist (elt lst)
157 (when (funcall cond-fn elt) 158 (when (funcall cond-fn elt)
158 (setq rv (append rv (list elt))))))) 159 (push elt rv)))
160 (nreverse rv)))
159 161
160(defun filesets-ormap (fsom-pred lst) 162(defun filesets-ormap (fsom-pred lst)
161 "Return the tail of LST for the head of which FSOM-PRED is non-nil." 163 "Return the tail of LST for the head of which FSOM-PRED is non-nil."
162 (let ((fsom-lst lst) 164 (let ((fsom-lst lst)
163 (fsom-rv nil)) 165 (fsom-rv nil))
164 (while (and (not (null fsom-lst)) 166 (while (and fsom-lst
165 (null fsom-rv)) 167 (null fsom-rv))
166 (if (funcall fsom-pred (car fsom-lst)) 168 (if (funcall fsom-pred (car fsom-lst))
167 (setq fsom-rv fsom-lst) 169 (setq fsom-rv fsom-lst)
168 (setq fsom-lst (cdr fsom-lst)))) 170 (setq fsom-lst (cdr fsom-lst))))
169 fsom-rv)) 171 fsom-rv))
170 172
171(defun filesets-some (fss-pred fss-lst) 173(define-obsolete-function-alias 'filesets-some #'cl-some "28.1")
172 "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST. 174(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
173Like `some', return the first value of FSS-PRED that is non-nil." 175(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
174 (catch 'exit
175 (dolist (fss-this fss-lst nil)
176 (let ((fss-rv (funcall fss-pred fss-this)))
177 (when fss-rv
178 (throw 'exit fss-rv))))))
179;(fset 'filesets-some 'cl-some) ;; or use the cl function
180
181(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
182 "Find the first occurrence of FSM-ITEM in FSM-LST.
183It is supposed to work like cl's `member*'. At the moment only the :test
184key is supported."
185 (let ((fsm-test (or (plist-get fsm-keys ':test)
186 (function equal))))
187 (filesets-ormap (lambda (fsm-this)
188 (funcall fsm-test fsm-item fsm-this))
189 fsm-lst)))
190;(fset 'filesets-member 'cl-member) ;; or use the cl function
191
192(defun filesets-sublist (lst beg &optional end)
193 "Get the sublist of LST from BEG to END - 1."
194 (let ((rv nil)
195 (i beg)
196 (top (or end
197 (length lst))))
198 (while (< i top)
199 (setq rv (append rv (list (nth i lst))))
200 (setq i (+ i 1)))
201 rv))
202 176
203(defun filesets-select-command (cmd-list) 177(defun filesets-select-command (cmd-list)
204 "Select one command from CMD-LIST -- a string with space separated names." 178 "Select one command from CMD-LIST -- a string with space separated names."
@@ -222,7 +196,7 @@ key is supported."
222(defun filesets-message (level &rest args) 196(defun filesets-message (level &rest args)
223 "Show a message only if LEVEL is greater or equal then `filesets-verbosity'." 197 "Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
224 (when (<= level (abs filesets-verbosity)) 198 (when (<= level (abs filesets-verbosity))
225 (apply 'message args))) 199 (apply #'message args)))
226 200
227 201
228;;; config file 202;;; config file
@@ -233,9 +207,9 @@ key is supported."
233 207
234(defun filesets-reset-fileset (&optional fileset no-cache) 208(defun filesets-reset-fileset (&optional fileset no-cache)
235 "Reset the cached values for one or all filesets." 209 "Reset the cached values for one or all filesets."
236 (if fileset 210 (setq filesets-submenus (if fileset
237 (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil)) 211 (lax-plist-put filesets-submenus fileset nil)
238 (setq filesets-submenus nil)) 212 nil))
239 (setq filesets-has-changed-flag t) 213 (setq filesets-has-changed-flag t)
240 (setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag 214 (setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
241 (not no-cache)))) 215 (not no-cache))))
@@ -303,50 +277,46 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with
303 277
304(defcustom filesets-menu-name "Filesets" 278(defcustom filesets-menu-name "Filesets"
305 "Filesets' menu name." 279 "Filesets' menu name."
306 :set (function filesets-set-default) 280 :set #'filesets-set-default
307 :type 'string 281 :type 'string)
308 :group 'filesets)
309 282
310(defcustom filesets-menu-path '("File") ; cf recentf-menu-path 283(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
311 "The menu under which the filesets menu should be inserted. 284 "The menu under which the filesets menu should be inserted.
312See `easy-menu-add-item' for documentation." 285See `easy-menu-add-item' for documentation."
313 :set (function filesets-set-default) 286 :set #'filesets-set-default
314 :type '(choice (const :tag "Top Level" nil) 287 :type '(choice (const :tag "Top Level" nil)
315 (sexp :tag "Menu Path")) 288 (sexp :tag "Menu Path"))
316 :version "23.1" ; was nil 289 :version "23.1" ; was nil
317 :group 'filesets) 290 )
318 291
319(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before 292(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
320 "The name of a menu before which this menu should be added. 293 "The name of a menu before which this menu should be added.
321See `easy-menu-add-item' for documentation." 294See `easy-menu-add-item' for documentation."
322 :set (function filesets-set-default) 295 :set #'filesets-set-default
323 :type '(choice (string :tag "Name") 296 :type '(choice (string :tag "Name")
324 (const :tag "Last" nil)) 297 (const :tag "Last" nil))
325 :version "23.1" ; was "File" 298 :version "23.1" ; was "File"
326 :group 'filesets) 299 )
327 300
328(defcustom filesets-menu-in-menu nil 301(defcustom filesets-menu-in-menu nil
329 "Use that instead of `current-menubar' as the menu to change. 302 "Use that instead of `current-menubar' as the menu to change.
330See `easy-menu-add-item' for documentation." 303See `easy-menu-add-item' for documentation."
331 :set (function filesets-set-default) 304 :set #'filesets-set-default
332 :type 'sexp 305 :type 'sexp)
333 :group 'filesets)
334 306
335(defcustom filesets-menu-shortcuts-flag t 307(defcustom filesets-menu-shortcuts-flag t
336 "Non-nil means to prepend menus with hopefully unique shortcuts." 308 "Non-nil means to prepend menus with hopefully unique shortcuts."
337 :set (function filesets-set-default!) 309 :set #'filesets-set-default!
338 :type 'boolean 310 :type 'boolean)
339 :group 'filesets)
340 311
341(defcustom filesets-menu-shortcuts-marker "%_" 312(defcustom filesets-menu-shortcuts-marker "%_"
342 "String for marking menu shortcuts." 313 "String for marking menu shortcuts."
343 :set (function filesets-set-default!) 314 :set #'filesets-set-default!
344 :type 'string 315 :type 'string)
345 :group 'filesets)
346 316
347;;(defcustom filesets-menu-cnvfp-flag nil 317;;(defcustom filesets-menu-cnvfp-flag nil
348;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus." 318;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
349;; :set (function filesets-set-default!) 319;; :set #'filesets-set-default!
350;; :type 'boolean 320;; :type 'boolean
351;; :group 'filesets) 321;; :group 'filesets)
352 322
@@ -355,9 +325,8 @@ See `easy-menu-add-item' for documentation."
355 "File to be used for saving the filesets menu between sessions. 325 "File to be used for saving the filesets menu between sessions.
356Set this to \"\", to disable caching of menus. 326Set this to \"\", to disable caching of menus.
357Don't forget to check out `filesets-menu-ensure-use-cached'." 327Don't forget to check out `filesets-menu-ensure-use-cached'."
358 :set (function filesets-set-default) 328 :set #'filesets-set-default
359 :type 'file 329 :type 'file)
360 :group 'filesets)
361(put 'filesets-menu-cache-file 'risky-local-variable t) 330(put 'filesets-menu-cache-file 'risky-local-variable t)
362 331
363(defcustom filesets-menu-cache-contents 332(defcustom filesets-menu-cache-contents
@@ -383,7 +352,7 @@ If you want caching to work properly, at least `filesets-submenus',
383list. 352list.
384 353
385Don't forget to check out `filesets-menu-ensure-use-cached'." 354Don't forget to check out `filesets-menu-ensure-use-cached'."
386 :set (function filesets-set-default) 355 :set #'filesets-set-default
387 :type '(repeat 356 :type '(repeat
388 (choice :tag "Variable" 357 (choice :tag "Variable"
389 (const :tag "filesets-submenus" 358 (const :tag "filesets-submenus"
@@ -400,8 +369,7 @@ Don't forget to check out `filesets-menu-ensure-use-cached'."
400 :value filesets-ingroup-patterns) 369 :value filesets-ingroup-patterns)
401 (const :tag "filesets-be-docile-flag" 370 (const :tag "filesets-be-docile-flag"
402 :value filesets-be-docile-flag) 371 :value filesets-be-docile-flag)
403 (sexp :tag "Other" :value nil))) 372 (sexp :tag "Other" :value nil))))
404 :group 'filesets)
405 373
406(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks 374(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
407 'filesets-cache-fill-content-hook "24.3") 375 'filesets-cache-fill-content-hook "24.3")
@@ -423,48 +391,43 @@ configuration file, you can add a something like this
423to this hook. 391to this hook.
424 392
425Don't forget to check out `filesets-menu-ensure-use-cached'." 393Don't forget to check out `filesets-menu-ensure-use-cached'."
426 :set (function filesets-set-default) 394 :set #'filesets-set-default
427 :type 'hook 395 :type 'hook)
428 :group 'filesets)
429 396
430(defcustom filesets-cache-hostname-flag nil 397(defcustom filesets-cache-hostname-flag nil
431 "Non-nil means cache the hostname. 398 "Non-nil means cache the hostname.
432If the current name differs from the cached one, 399If the current name differs from the cached one,
433rebuild the menu and create a new cache file." 400rebuild the menu and create a new cache file."
434 :set (function filesets-set-default) 401 :set #'filesets-set-default
435 :type 'boolean 402 :type 'boolean)
436 :group 'filesets)
437 403
438(defcustom filesets-cache-save-often-flag nil 404(defcustom filesets-cache-save-often-flag nil
439 "Non-nil means save buffer on every change of the filesets menu. 405 "Non-nil means save buffer on every change of the filesets menu.
440If this variable is set to nil and if Emacs crashes, the cache and 406If this variable is set to nil and if Emacs crashes, the cache and
441filesets-data could get out of sync. Set this to t if this happens from 407filesets-data could get out of sync. Set this to t if this happens from
442time to time or if the fileset cache causes troubles." 408time to time or if the fileset cache causes troubles."
443 :set (function filesets-set-default) 409 :set #'filesets-set-default
444 :type 'boolean 410 :type 'boolean)
445 :group 'filesets)
446 411
447(defcustom filesets-max-submenu-length 25 412(defcustom filesets-max-submenu-length 25
448 "Maximum length of submenus. 413 "Maximum length of submenus.
449Set this value to 0 to turn menu splitting off. BTW, parts of submenus 414Set this value to 0 to turn menu splitting off. BTW, parts of submenus
450will not be rewrapped if their length exceeds this value." 415will not be rewrapped if their length exceeds this value."
451 :set (function filesets-set-default) 416 :set #'filesets-set-default
452 :type 'integer 417 :type 'integer)
453 :group 'filesets)
454 418
455(defcustom filesets-max-entry-length 50 419(defcustom filesets-max-entry-length 50
456 "Truncate names of split submenus to this length." 420 "Truncate names of split submenus to this length."
457 :set (function filesets-set-default) 421 :set #'filesets-set-default
458 :type 'integer 422 :type 'integer)
459 :group 'filesets)
460 423
461(defcustom filesets-browse-dir-function 'dired 424(defcustom filesets-browse-dir-function #'dired
462 "A function or command used for browsing directories. 425 "A function or command used for browsing directories.
463When using an external command, \"%s\" will be replaced with the 426When using an external command, \"%s\" will be replaced with the
464directory's name. 427directory's name.
465 428
466Note: You have to manually rebuild the menu if you change this value." 429Note: You have to manually rebuild the menu if you change this value."
467 :set (function filesets-set-default) 430 :set #'filesets-set-default
468 :type '(choice :tag "Function:" 431 :type '(choice :tag "Function:"
469 (const :tag "dired" 432 (const :tag "dired"
470 :value dired) 433 :value dired)
@@ -473,10 +436,9 @@ Note: You have to manually rebuild the menu if you change this value."
473 (string :tag "Name") 436 (string :tag "Name")
474 (string :tag "Arguments")) 437 (string :tag "Arguments"))
475 (function :tag "Function" 438 (function :tag "Function"
476 :value nil)) 439 :value nil)))
477 :group 'filesets)
478 440
479(defcustom filesets-open-file-function 'filesets-find-or-display-file 441(defcustom filesets-open-file-function #'filesets-find-or-display-file
480 "The function used for opening files. 442 "The function used for opening files.
481 443
482`filesets-find-or-display-file' ... Filesets' default function for 444`filesets-find-or-display-file' ... Filesets' default function for
@@ -489,26 +451,24 @@ for a specific file type. Either this viewer, if defined, or
489readable, will not be opened. 451readable, will not be opened.
490 452
491Caveat: Changes will take effect only after rebuilding the menu." 453Caveat: Changes will take effect only after rebuilding the menu."
492 :set (function filesets-set-default) 454 :set #'filesets-set-default
493 :type '(choice :tag "Function:" 455 :type '(choice :tag "Function:"
494 (const :tag "filesets-find-or-display-file" 456 (const :tag "filesets-find-or-display-file"
495 :value filesets-find-or-display-file) 457 :value filesets-find-or-display-file)
496 (const :tag "filesets-find-file" 458 (const :tag "filesets-find-file"
497 :value filesets-find-file) 459 :value filesets-find-file)
498 (function :tag "Function" 460 (function :tag "Function"
499 :value nil)) 461 :value nil)))
500 :group 'filesets)
501 462
502(defcustom filesets-save-buffer-function 'save-buffer 463(defcustom filesets-save-buffer-function #'save-buffer
503 "The function used to save a buffer. 464 "The function used to save a buffer.
504Caveat: Changes will take effect after rebuilding the menu." 465Caveat: Changes will take effect after rebuilding the menu."
505 :set (function filesets-set-default) 466 :set #'filesets-set-default
506 :type '(choice :tag "Function:" 467 :type '(choice :tag "Function:"
507 (const :tag "save-buffer" 468 (const :tag "save-buffer"
508 :value save-buffer) 469 :value save-buffer)
509 (function :tag "Function" 470 (function :tag "Function"
510 :value nil)) 471 :value nil)))
511 :group 'filesets)
512 472
513(defcustom filesets-find-file-delay 473(defcustom filesets-find-file-delay
514 (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p) 474 (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
@@ -519,29 +479,25 @@ This is for calls via `filesets-find-or-display-file'
519or `filesets-find-file'. 479or `filesets-find-file'.
520 480
521Set this to 0, if you don't use XEmacs's buffer tabs." 481Set this to 0, if you don't use XEmacs's buffer tabs."
522 :set (function filesets-set-default) 482 :set #'filesets-set-default
523 :type 'number 483 :type 'number)
524 :group 'filesets)
525 484
526(defcustom filesets-be-docile-flag nil 485(defcustom filesets-be-docile-flag nil
527 "Non-nil means don't complain if a file or a directory doesn't exist. 486 "Non-nil means don't complain if a file or a directory doesn't exist.
528This is useful if you want to use the same startup files in different 487This is useful if you want to use the same startup files in different
529computer environments." 488computer environments."
530 :set (function filesets-set-default) 489 :set #'filesets-set-default
531 :type 'boolean 490 :type 'boolean)
532 :group 'filesets)
533 491
534(defcustom filesets-sort-menu-flag t 492(defcustom filesets-sort-menu-flag t
535 "Non-nil means sort the filesets menu alphabetically." 493 "Non-nil means sort the filesets menu alphabetically."
536 :set (function filesets-set-default) 494 :set #'filesets-set-default
537 :type 'boolean 495 :type 'boolean)
538 :group 'filesets)
539 496
540(defcustom filesets-sort-case-sensitive-flag t 497(defcustom filesets-sort-case-sensitive-flag t
541 "Non-nil means sorting of the filesets menu is case sensitive." 498 "Non-nil means sorting of the filesets menu is case sensitive."
542 :set (function filesets-set-default) 499 :set #'filesets-set-default
543 :type 'boolean 500 :type 'boolean)
544 :group 'filesets)
545 501
546(defcustom filesets-tree-max-level 3 502(defcustom filesets-tree-max-level 3
547 "Maximum scan depth for directory trees. 503 "Maximum scan depth for directory trees.
@@ -561,9 +517,8 @@ i.e. how deep the menu should be. Try something like
561 517
562and it should become clear what this option is about. In any case, 518and it should become clear what this option is about. In any case,
563including directory trees to the menu can take a lot of memory." 519including directory trees to the menu can take a lot of memory."
564 :set (function filesets-set-default) 520 :set #'filesets-set-default
565 :type 'integer 521 :type 'integer)
566 :group 'filesets)
567 522
568(defcustom filesets-commands 523(defcustom filesets-commands
569 '(("Isearch" 524 '(("Isearch"
@@ -590,7 +545,7 @@ function that returns one) to be run on a filesets' files.
590 545
591The argument <file-name> or <<file-name>> (quoted) will be replaced with 546The argument <file-name> or <<file-name>> (quoted) will be replaced with
592the filename." 547the filename."
593 :set (function filesets-set-default+) 548 :set #'filesets-set-default+
594 :type '(repeat :tag "Commands" 549 :type '(repeat :tag "Commands"
595 (list :tag "Definition" :value ("") 550 (list :tag "Definition" :value ("")
596 (string "Name") 551 (string "Name")
@@ -606,8 +561,7 @@ the filename."
606 (string :tag "Quoted File Name" 561 (string :tag "Quoted File Name"
607 :value "<<file-name>>") 562 :value "<<file-name>>")
608 (function :tag "Function" 563 (function :tag "Function"
609 :value nil))))) 564 :value nil))))))
610 :group 'filesets)
611(put 'filesets-commands 'risky-local-variable t) 565(put 'filesets-commands 'risky-local-variable t)
612 566
613(defcustom filesets-external-viewers 567(defcustom filesets-external-viewers
@@ -627,28 +581,33 @@ the filename."
627 (dvi-cmd "xdvi") 581 (dvi-cmd "xdvi")
628 (doc-cmd "antiword") 582 (doc-cmd "antiword")
629 (pic-cmd "gqview")) 583 (pic-cmd "gqview"))
630 `(("^.+\\..?html?$" browse-url 584 `((".\\..?html?\\'" browse-url
631 ((:ignore-on-open-all t))) 585 ((:ignore-on-open-all t)))
632 ("^.+\\.pdf$" ,pdf-cmd 586 (".\\.pdf\\'" ,pdf-cmd
633 ((:ignore-on-open-all t) 587 ((:ignore-on-open-all t)
634 (:ignore-on-read-text t) 588 (:ignore-on-read-text t)
635 (:constraint-flag ,pdf-cmd))) 589 ;; (:constraintp ,pdf-cmd)
636 ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd 590 ))
591 (".\\.e?ps\\(?:\\.gz\\)?\\'" ,ps-cmd
637 ((:ignore-on-open-all t) 592 ((:ignore-on-open-all t)
638 (:ignore-on-read-text t) 593 (:ignore-on-read-text t)
639 (:constraint-flag ,ps-cmd))) 594 ;; (:constraintp ,ps-cmd)
640 ("^.+\\.dvi$" ,dvi-cmd 595 ))
596 (".\\.dvi\\'" ,dvi-cmd
641 ((:ignore-on-open-all t) 597 ((:ignore-on-open-all t)
642 (:ignore-on-read-text t) 598 (:ignore-on-read-text t)
643 (:constraint-flag ,dvi-cmd))) 599 ;; (:constraintp ,dvi-cmd)
644 ("^.+\\.doc$" ,doc-cmd 600 ))
601 (".\\.doc\\'" ,doc-cmd
645 ((:capture-output t) 602 ((:capture-output t)
646 (:ignore-on-read-text t) 603 (:ignore-on-read-text t)
647 (:constraint-flag ,doc-cmd))) 604 ;; (:constraintp ,doc-cmd)
648 ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd 605 ))
606 (".\\.\\(tiff\\|xpm\\|gif\\|pgn\\)\\'" ,pic-cmd
649 ((:ignore-on-open-all t) 607 ((:ignore-on-open-all t)
650 (:ignore-on-read-text t) 608 (:ignore-on-read-text t)
651 (:constraint-flag ,pic-cmd))))) 609 ;; (:constraintp ,pic-cmd)
610 ))))
652 "Association list of file patterns and external viewers for use with 611 "Association list of file patterns and external viewers for use with
653`filesets-find-or-display-file'. 612`filesets-find-or-display-file'.
654 613
@@ -665,10 +624,8 @@ i.e. on open-all-files-events or when running commands
665 624
666:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil 625:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
667 626
668:constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil 627:open-hook FUNCTIONs ... run FUNCTIONs after spawning the viewer -- mainly
669 628useful in conjunction with :capture-output
670:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
671in conjunction with :capture-output
672 629
673:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments 630:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
674\(defaults to (list \"%S\")) when using shell commands 631\(defaults to (list \"%S\")) when using shell commands
@@ -693,7 +650,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
693 (:constraintp (lambda () 650 (:constraintp (lambda ()
694 (and (filesets-which-command-p \"rtf2htm\") 651 (and (filesets-which-command-p \"rtf2htm\")
695 (filesets-which-command-p \"w3m\"))))))" 652 (filesets-which-command-p \"w3m\"))))))"
696 :set (function filesets-set-default) 653 :set #'filesets-set-default
697 :type '(repeat :tag "Viewer" 654 :type '(repeat :tag "Viewer"
698 (list :tag "Definition" 655 (list :tag "Definition"
699 :value ("^.+\\.suffix$" "") 656 :value ("^.+\\.suffix$" "")
@@ -708,7 +665,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
708 (const :format "" 665 (const :format ""
709 :value :constraintp) 666 :value :constraintp)
710 (function :tag "Function")) 667 (function :tag "Function"))
711 (list :tag ":constraint-flag" 668 (list :tag ":constraint-flag (obsolete)"
712 :value (:constraint-flag) 669 :value (:constraint-flag)
713 (const :format "" 670 (const :format ""
714 :value :constraint-flag) 671 :value :constraint-flag)
@@ -749,8 +706,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
749 :value (:capture-output t) 706 :value (:capture-output t)
750 (const :format "" 707 (const :format ""
751 :value :capture-output) 708 :value :capture-output)
752 (boolean :tag "Boolean")))))) 709 (boolean :tag "Boolean")))))))
753 :group 'filesets)
754(put 'filesets-external-viewers 'risky-local-variable t) 710(put 'filesets-external-viewers 'risky-local-variable t)
755 711
756(defcustom filesets-ingroup-patterns 712(defcustom filesets-ingroup-patterns
@@ -891,7 +847,7 @@ With duplicates removed, it would be:
891 847
892 M + A - X 848 M + A - X
893 B" 849 B"
894 :set (function filesets-set-default) 850 :set #'filesets-set-default
895 :type '(repeat 851 :type '(repeat
896 :tag "Include" 852 :tag "Include"
897 (list 853 (list
@@ -937,8 +893,7 @@ With duplicates removed, it would be:
937 (list :tag ":preprocess" 893 (list :tag ":preprocess"
938 :value (:preprocess) 894 :value (:preprocess)
939 (const :format "" :value :preprocess) 895 (const :format "" :value :preprocess)
940 (function :tag "Function"))))))) 896 (function :tag "Function"))))))))
941 :group 'filesets)
942(put 'filesets-ingroup-patterns 'risky-local-variable t) 897(put 'filesets-ingroup-patterns 'risky-local-variable t)
943 898
944(defcustom filesets-data nil 899(defcustom filesets-data nil
@@ -1009,8 +964,7 @@ is used.
1009 964
1010Before using :ingroup, make sure that the file type is already 965Before using :ingroup, make sure that the file type is already
1011defined in `filesets-ingroup-patterns'." 966defined in `filesets-ingroup-patterns'."
1012 :group 'filesets 967 :set #'filesets-data-set-default
1013 :set (function filesets-data-set-default)
1014 :type '(repeat 968 :type '(repeat
1015 (cons :tag "Fileset" 969 (cons :tag "Fileset"
1016 (string :tag "Name" :value "") 970 (string :tag "Name" :value "")
@@ -1072,9 +1026,8 @@ defined in `filesets-ingroup-patterns'."
1072 1026
1073(defcustom filesets-query-user-limit 15 1027(defcustom filesets-query-user-limit 15
1074 "Query the user before opening a fileset with that many files." 1028 "Query the user before opening a fileset with that many files."
1075 :set (function filesets-set-default) 1029 :set #'filesets-set-default
1076 :type 'integer 1030 :type 'integer)
1077 :group 'filesets)
1078 1031
1079 1032
1080(defun filesets-filter-dir-names (lst &optional negative) 1033(defun filesets-filter-dir-names (lst &optional negative)
@@ -1127,16 +1080,16 @@ Return full path if FULL-FLAG is non-nil."
1127 (string-match-p pattern this)) 1080 (string-match-p pattern this))
1128 (filesets-message 5 "Filesets: matched dir %S with pattern %S" 1081 (filesets-message 5 "Filesets: matched dir %S with pattern %S"
1129 this pattern) 1082 this pattern)
1130 (setq dirs (cons this dirs)))) 1083 (push this dirs)))
1131 (t 1084 (t
1132 (when (or (not pattern) 1085 (when (or (not pattern)
1133 (string-match-p pattern this)) 1086 (string-match-p pattern this))
1134 (filesets-message 5 "Filesets: matched file %S with pattern %S" 1087 (filesets-message 5 "Filesets: matched file %S with pattern %S"
1135 this pattern) 1088 this pattern)
1136 (setq files (cons (if full-flag 1089 (push (if full-flag
1137 (concat (file-name-as-directory dir) this) 1090 (concat (file-name-as-directory dir) this)
1138 this) 1091 this)
1139 files)))))) 1092 files)))))
1140 (cond 1093 (cond
1141 ((equal what ':dirs) 1094 ((equal what ':dirs)
1142 (filesets-conditional-sort dirs)) 1095 (filesets-conditional-sort dirs))
@@ -1193,7 +1146,7 @@ Return full path if FULL-FLAG is non-nil."
1193(defun filesets-convert-path-list (string) 1146(defun filesets-convert-path-list (string)
1194 "Return a path-list given as STRING as list." 1147 "Return a path-list given as STRING as list."
1195 (if string 1148 (if string
1196 (mapcar (lambda (x) (file-name-as-directory x)) 1149 (mapcar #'file-name-as-directory
1197 (split-string string path-separator)) 1150 (split-string string path-separator))
1198 nil)) 1151 nil))
1199 1152
@@ -1203,17 +1156,17 @@ Return full path if FULL-FLAG is non-nil."
1203 filename))) 1156 filename)))
1204 (if (file-exists-p f) 1157 (if (file-exists-p f)
1205 f 1158 f
1206 (filesets-some 1159 (cl-some
1207 (lambda (dir) 1160 (lambda (dir)
1208 (let ((dir (file-name-as-directory dir)) 1161 (let ((dir (file-name-as-directory dir))
1209 (files (if (file-exists-p dir) 1162 (files (if (file-exists-p dir)
1210 (filesets-directory-files dir nil ':files) 1163 (filesets-directory-files dir nil ':files)
1211 nil))) 1164 nil)))
1212 (filesets-some (lambda (file) 1165 (cl-some (lambda (file)
1213 (if (equal filename (file-name-nondirectory file)) 1166 (if (equal filename (file-name-nondirectory file))
1214 (concat dir file) 1167 (concat dir file)
1215 nil)) 1168 nil))
1216 files))) 1169 files)))
1217 path-list)))) 1170 path-list))))
1218 1171
1219 1172
@@ -1223,12 +1176,14 @@ Return full path if FULL-FLAG is non-nil."
1223 1176
1224(defun filesets-eviewer-constraint-p (entry) 1177(defun filesets-eviewer-constraint-p (entry)
1225 (let* ((props (filesets-eviewer-get-props entry)) 1178 (let* ((props (filesets-eviewer-get-props entry))
1226 (constraint (assoc ':constraintp props)) 1179 (constraint (assoc :constraintp props))
1227 (constraint-flag (assoc ':constraint-flag props))) 1180 (constraint-flag (assoc :constraint-flag props)))
1228 (cond 1181 (cond
1229 (constraint 1182 (constraint
1230 (funcall (cadr constraint))) 1183 (funcall (cadr constraint)))
1231 (constraint-flag 1184 (constraint-flag
1185 (message "Obsolete :constraint-flag %S, use :constraintp instead"
1186 (cadr constraint-flag))
1232 (eval (cadr constraint-flag))) 1187 (eval (cadr constraint-flag)))
1233 (t 1188 (t
1234 t)))) 1189 t))))
@@ -1236,7 +1191,7 @@ Return full path if FULL-FLAG is non-nil."
1236(defun filesets-get-external-viewer (file) 1191(defun filesets-get-external-viewer (file)
1237 "Find an external viewer for FILE." 1192 "Find an external viewer for FILE."
1238 (let ((filename (file-name-nondirectory file))) 1193 (let ((filename (file-name-nondirectory file)))
1239 (filesets-some 1194 (cl-some
1240 (lambda (entry) 1195 (lambda (entry)
1241 (when (and (string-match-p (nth 0 entry) filename) 1196 (when (and (string-match-p (nth 0 entry) filename)
1242 (filesets-eviewer-constraint-p entry)) 1197 (filesets-eviewer-constraint-p entry))
@@ -1246,7 +1201,7 @@ Return full path if FULL-FLAG is non-nil."
1246(defun filesets-get-external-viewer-by-name (name) 1201(defun filesets-get-external-viewer-by-name (name)
1247 "Get the external viewer definition called NAME." 1202 "Get the external viewer definition called NAME."
1248 (when name 1203 (when name
1249 (filesets-some 1204 (cl-some
1250 (lambda (entry) 1205 (lambda (entry)
1251 (when (and (string-equal (nth 1 entry) name) 1206 (when (and (string-equal (nth 1 entry) name)
1252 (filesets-eviewer-constraint-p entry)) 1207 (filesets-eviewer-constraint-p entry))
@@ -1308,17 +1263,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
1308 (oh (filesets-filetype-get-prop ':open-hook file entry)) 1263 (oh (filesets-filetype-get-prop ':open-hook file entry))
1309 (args (let ((fmt (filesets-filetype-get-prop ':args file entry))) 1264 (args (let ((fmt (filesets-filetype-get-prop ':args file entry)))
1310 (if fmt 1265 (if fmt
1311 (let ((rv "")) 1266 (mapconcat
1312 (dolist (this fmt rv) 1267 (lambda (this)
1313 (setq rv (concat rv 1268 (if (stringp this) (format this file)
1314 (cond 1269 (format "%S" (if (functionp this)
1315 ((stringp this) 1270 (funcall this)
1316 (format this file)) 1271 this))))
1317 ((and (symbolp this) 1272 fmt "")
1318 (fboundp this))
1319 (format "%S" (funcall this)))
1320 (t
1321 (format "%S" this)))))))
1322 (format "%S" file)))) 1273 (format "%S" file))))
1323 (output 1274 (output
1324 (cond 1275 (cond
@@ -1338,13 +1289,15 @@ Use the viewer defined in EV-ENTRY (a valid element of
1338 (insert output) 1289 (insert output)
1339 (setq-local filesets-output-buffer-flag t) 1290 (setq-local filesets-output-buffer-flag t)
1340 (set-visited-file-name file t) 1291 (set-visited-file-name file t)
1341 (when oh 1292 (if (functionp oh)
1342 (run-hooks 'oh)) 1293 (funcall oh)
1294 (mapc #'funcall oh))
1343 (set-buffer-modified-p nil) 1295 (set-buffer-modified-p nil)
1344 (setq buffer-read-only t) 1296 (setq buffer-read-only t)
1345 (goto-char (point-min))) 1297 (goto-char (point-min)))
1346 (when oh 1298 (if (functionp oh)
1347 (run-hooks 'oh)))) 1299 (funcall oh)
1300 (mapc #'funcall oh))))
1348 (error "Filesets: general error when spawning external viewer")))) 1301 (error "Filesets: general error when spawning external viewer"))))
1349 1302
1350(defun filesets-find-file (file) 1303(defun filesets-find-file (file)
@@ -1355,7 +1308,8 @@ not be opened."
1355 (when (or (file-readable-p file) 1308 (when (or (file-readable-p file)
1356 (not filesets-be-docile-flag)) 1309 (not filesets-be-docile-flag))
1357 (sit-for filesets-find-file-delay) 1310 (sit-for filesets-find-file-delay)
1358 (find-file file))) 1311 (with-suppressed-warnings ((interactive-only find-file))
1312 (find-file file))))
1359 1313
1360(defun filesets-find-or-display-file (&optional file viewer) 1314(defun filesets-find-or-display-file (&optional file viewer)
1361 "Visit FILE using an external VIEWER or open it in an Emacs buffer." 1315 "Visit FILE using an external VIEWER or open it in an Emacs buffer."
@@ -1394,7 +1348,8 @@ not be opened."
1394 (if (functionp filesets-browse-dir-function) 1348 (if (functionp filesets-browse-dir-function)
1395 (funcall filesets-browse-dir-function dir) 1349 (funcall filesets-browse-dir-function dir)
1396 (let ((name (car filesets-browse-dir-function)) 1350 (let ((name (car filesets-browse-dir-function))
1397 (args (format (cadr filesets-browse-dir-function) (expand-file-name dir)))) 1351 (args (format (cadr filesets-browse-dir-function)
1352 (expand-file-name dir))))
1398 (with-temp-buffer 1353 (with-temp-buffer
1399 (start-process (concat "Filesets:" name) 1354 (start-process (concat "Filesets:" name)
1400 "*Filesets external directory browser*" 1355 "*Filesets external directory browser*"
@@ -1445,7 +1400,7 @@ Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
1445 "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup. 1400 "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
1446See `filesets-data'." 1401See `filesets-data'."
1447 (let ((data (filesets-data-get-data entry))) 1402 (let ((data (filesets-data-get-data entry)))
1448 (filesets-some 1403 (cl-some
1449 (lambda (x) 1404 (lambda (x)
1450 (if (assoc x data) 1405 (if (assoc x data)
1451 x)) 1406 x))
@@ -1557,16 +1512,15 @@ SAVE-FUNCTION takes no argument, but works on the current buffer."
1557 (assoc cmd-name filesets-commands)) 1512 (assoc cmd-name filesets-commands))
1558 1513
1559(defun filesets-cmd-get-args (cmd-name) 1514(defun filesets-cmd-get-args (cmd-name)
1560 (let ((args (let ((def (filesets-cmd-get-def cmd-name))) 1515 (mapcan (lambda (this)
1561 (nth 2 def))) 1516 (cond
1562 (rv nil)) 1517 ((and (symbolp this) (fboundp this))
1563 (dolist (this args rv) 1518 (let ((x (funcall this)))
1564 (cond 1519 (if (listp x) x (list x))))
1565 ((and (symbolp this) (fboundp this)) 1520 (t
1566 (let ((x (funcall this))) 1521 (list this))))
1567 (setq rv (append rv (if (listp x) x (list x)))))) 1522 (let ((def (filesets-cmd-get-def cmd-name)))
1568 (t 1523 (nth 2 def))))
1569 (setq rv (append rv (list this))))))))
1570 1524
1571(defun filesets-cmd-get-fn (cmd-name) 1525(defun filesets-cmd-get-fn (cmd-name)
1572 (let ((def (filesets-cmd-get-def cmd-name))) 1526 (let ((def (filesets-cmd-get-def cmd-name)))
@@ -1628,28 +1582,24 @@ Replace <file-name> or <<file-name>> with filename."
1628 (cond 1582 (cond
1629 ((stringp fn) 1583 ((stringp fn)
1630 (let* ((args 1584 (let* ((args
1631 (let ((txt "")) 1585 (mapconcat
1632 (dolist (this args txt) 1586 (lambda (this)
1633 (setq txt 1587 (filesets-run-cmd--repl-fn
1634 (concat txt
1635 (if (equal txt "") "" " ")
1636 (filesets-run-cmd--repl-fn
1637 this 1588 this
1638 (lambda (this) 1589 (lambda (this)
1639 (format "%s" this)))))))) 1590 (format "%s" this))))
1591 args
1592 " "))
1640 (cmd (concat fn " " args))) 1593 (cmd (concat fn " " args)))
1641 (filesets-cmd-show-result 1594 (filesets-cmd-show-result
1642 cmd (shell-command-to-string cmd)))) 1595 cmd (shell-command-to-string cmd))))
1643 ((symbolp fn) 1596 ((symbolp fn)
1644 (let ((args 1597 (apply fn
1645 (let ((argl nil)) 1598 (mapcan (lambda (this)
1646 (dolist (this args argl) 1599 (filesets-run-cmd--repl-fn
1647 (setq argl 1600 this
1648 (append argl 1601 'list))
1649 (filesets-run-cmd--repl-fn 1602 args)))))))))))))))))
1650 this
1651 'list)))))))
1652 (apply fn args)))))))))))))))))
1653 1603
1654(defun filesets-get-cmd-menu () 1604(defun filesets-get-cmd-menu ()
1655 "Create filesets command menu." 1605 "Create filesets command menu."
@@ -1832,8 +1782,8 @@ User will be queried, if no fileset name is provided."
1832 (if entry 1782 (if entry
1833 (let* ((files (filesets-entry-get-files entry)) 1783 (let* ((files (filesets-entry-get-files entry))
1834 (this (buffer-file-name buffer)) 1784 (this (buffer-file-name buffer))
1835 (inlist (filesets-member this files 1785 (inlist (cl-member this files
1836 :test 'filesets-files-equalp))) 1786 :test #'filesets-files-equalp)))
1837 (cond 1787 (cond
1838 (inlist 1788 (inlist
1839 (message "Filesets: `%s' is already in `%s'" this name)) 1789 (message "Filesets: `%s' is already in `%s'" this name))
@@ -1858,8 +1808,8 @@ User will be queried, if no fileset name is provided."
1858 (if entry 1808 (if entry
1859 (let* ((files (filesets-entry-get-files entry)) 1809 (let* ((files (filesets-entry-get-files entry))
1860 (this (buffer-file-name buffer)) 1810 (this (buffer-file-name buffer))
1861 (inlist (filesets-member this files 1811 (inlist (cl-member this files
1862 :test 'filesets-files-equalp))) 1812 :test #'filesets-files-equalp)))
1863 ;;(message "%s %s %s" files this inlist) 1813 ;;(message "%s %s %s" files this inlist)
1864 (if (and files this inlist) 1814 (if (and files this inlist)
1865 (let ((new (list (cons ':files (delete (car inlist) files))))) 1815 (let ((new (list (cons ':files (delete (car inlist) files)))))
@@ -1908,7 +1858,7 @@ User will be queried, if no fileset name is provided."
1908 (substring (elt submenu 0) 2)))) 1858 (substring (elt submenu 0) 2))))
1909 (if (listp submenu) 1859 (if (listp submenu)
1910 (cons name (cdr submenu)) 1860 (cons name (cdr submenu))
1911 (apply 'vector (list name (cadr (append submenu nil))))))) 1861 (apply #'vector (list name (cadr (append submenu nil)))))))
1912; (vconcat `[,name] (subseq submenu 1))))) 1862; (vconcat `[,name] (subseq submenu 1)))))
1913 1863
1914(defun filesets-wrap-submenu (submenu-body) 1864(defun filesets-wrap-submenu (submenu-body)
@@ -1926,12 +1876,14 @@ User will be queried, if no fileset name is provided."
1926 ((or (> count bl) 1876 ((or (> count bl)
1927 (null data))) 1877 (null data)))
1928 ;; (let ((sl (subseq submenu-body count 1878 ;; (let ((sl (subseq submenu-body count
1929 (let ((sl (filesets-sublist submenu-body count 1879 (let ((sl (seq-subseq submenu-body count
1930 (let ((x (+ count factor))) 1880 (let ((x (+ count factor)))
1931 (if (>= bl x) 1881 (if (>= bl x)
1932 x 1882 x
1933 nil))))) 1883 nil)))))
1934 (when sl 1884 (when sl
1885 ;; FIXME: O(n²) performance bug because of repeated `append':
1886 ;; use `mapcan'?
1935 (setq result 1887 (setq result
1936 (append 1888 (append
1937 result 1889 result
@@ -1948,6 +1900,8 @@ User will be queried, if no fileset name is provided."
1948 (if (null (cdr x)) 1900 (if (null (cdr x))
1949 "" 1901 ""
1950 ", ")))) 1902 ", "))))
1903 ;; FIXME: O(n²) performance bug because of
1904 ;; repeated `concat': use `mapconcat'?
1951 (setq rv 1905 (setq rv
1952 (concat 1906 (concat
1953 rv 1907 rv
@@ -2023,11 +1977,11 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
2023 (and (stringp a) 1977 (and (stringp a)
2024 (stringp b) 1978 (stringp b)
2025 (string-match-p a b)))))) 1979 (string-match-p a b))))))
2026 (filesets-some (lambda (x) 1980 (cl-some (lambda (x)
2027 (if (funcall fn (car x) masterfile) 1981 (if (funcall fn (car x) masterfile)
2028 (nth pos x) 1982 (nth pos x)
2029 nil)) 1983 nil))
2030 filesets-ingroup-patterns))) 1984 filesets-ingroup-patterns)))
2031 1985
2032(defun filesets-ingroup-get-pattern (master) 1986(defun filesets-ingroup-get-pattern (master)
2033 "Access to `filesets-ingroup-patterns'. Extract patterns." 1987 "Access to `filesets-ingroup-patterns'. Extract patterns."
@@ -2039,12 +1993,8 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
2039 1993
2040(defun filesets-ingroup-collect-finder (patt case-sensitivep) 1994(defun filesets-ingroup-collect-finder (patt case-sensitivep)
2041 "Helper function for `filesets-ingroup-collect'. Find pattern PATT." 1995 "Helper function for `filesets-ingroup-collect'. Find pattern PATT."
2042 (let ((cfs case-fold-search) 1996 (let ((case-fold-search (not case-sensitivep)))
2043 (rv (progn 1997 (re-search-forward patt nil t)))
2044 (setq case-fold-search (not case-sensitivep))
2045 (re-search-forward patt nil t))))
2046 (setq case-fold-search cfs)
2047 rv))
2048 1998
2049(defun filesets-ingroup-cache-get (master) 1999(defun filesets-ingroup-cache-get (master)
2050 "Access to `filesets-ingroup-cache'." 2000 "Access to `filesets-ingroup-cache'."
@@ -2102,9 +2052,9 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
2102 (when (and f 2052 (when (and f
2103 (not (member f flist)) 2053 (not (member f flist))
2104 (or (not remdupl-flag) 2054 (or (not remdupl-flag)
2105 (not (filesets-member 2055 (not (cl-member
2106 f filesets-ingroup-files 2056 f filesets-ingroup-files
2107 :test 'filesets-files-equalp)))) 2057 :test #'filesets-files-equalp))))
2108 (let ((no-stub-flag 2058 (let ((no-stub-flag
2109 (and (not this-stub-flag) 2059 (and (not this-stub-flag)
2110 (if this-stubp 2060 (if this-stubp
@@ -2116,16 +2066,18 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
2116 (cons f filesets-ingroup-files)) 2066 (cons f filesets-ingroup-files))
2117 (when no-stub-flag 2067 (when no-stub-flag
2118 (filesets-ingroup-cache-put master f)) 2068 (filesets-ingroup-cache-put master f))
2119 (setq lst (append lst (list f)))))))) 2069 (push f lst))))))
2120 (when lst 2070 (when lst
2121 (setq rv 2071 (setq rv
2072 ;; FIXME: O(n²) performance bug because of repeated
2073 ;; `nconc'.
2122 (nconc rv 2074 (nconc rv
2123 (mapcar (lambda (this) 2075 (mapcar (lambda (this)
2124 `((,this ,this-name) 2076 `((,this ,this-name)
2125 ,@(filesets-ingroup-collect-files 2077 ,@(filesets-ingroup-collect-files
2126 fs remdupl-flag this 2078 fs remdupl-flag this
2127 (- this-sd 1)))) 2079 (- this-sd 1))))
2128 lst)))))))) 2080 (nreverse lst)))))))))
2129 (filesets-message 2 "Filesets: no patterns defined for %S" master))))) 2081 (filesets-message 2 "Filesets: no patterns defined for %S" master)))))
2130 2082
2131(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count) 2083(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
@@ -2135,42 +2087,41 @@ FS is a fileset's name. FLIST is a list returned by
2135 (if (null flist) 2087 (if (null flist)
2136 nil 2088 nil
2137 (let ((count 0) 2089 (let ((count 0)
2138 (fsn fs) 2090 (fsn fs))
2139 (rv nil)) 2091 (mapcan (lambda (this)
2140 (dolist (this flist rv) 2092 (setq count (+ count 1))
2141 (setq count (+ count 1)) 2093 (let* ((def (if (listp this) (car this) (list this "")))
2142 (let* ((def (if (listp this) (car this) (list this ""))) 2094 (files (if (listp this) (cdr this) nil))
2143 (files (if (listp this) (cdr this) nil)) 2095 (master (nth 0 def))
2144 (master (nth 0 def)) 2096 (name (nth 1 def))
2145 (name (nth 1 def)) 2097 (nm (concat (filesets-get-shortcut
2146 (nm (concat (filesets-get-shortcut (if (or (not other-count) files) 2098 (if (or (not other-count) files)
2147 count other-count)) 2099 count other-count))
2148 (if (or (null name) (equal name "")) 2100 (if (or (null name) (equal name ""))
2149 "" 2101 ""
2150 (format "%s: " name)) 2102 (format "%s: " name))
2151 (file-name-nondirectory master)))) 2103 (file-name-nondirectory master))))
2152 (setq rv 2104 (if files
2153 (append rv 2105 `((,nm
2154 (if files 2106 [,(concat "Inclusion Group: "
2155 `((,nm 2107 (file-name-nondirectory master))
2156 [,(concat "Inclusion Group: " 2108 (filesets-open ':ingroup ',master ',fsn)]
2157 (file-name-nondirectory master)) 2109 "---"
2158 (filesets-open ':ingroup ',master ',fsn)] 2110 [,master (filesets-file-open nil ',master ',fsn)]
2159 "---" 2111 "---"
2160 [,master (filesets-file-open nil ',master ',fsn)] 2112 ,@(let ((count 0))
2161 "---" 2113 (mapcar
2162 ,@(let ((count 0)) 2114 (lambda (this)
2163 (mapcar 2115 (setq count (+ count 1))
2164 (lambda (this) 2116 (let ((ff (filesets-ingroup-collect-build-menu
2165 (setq count (+ count 1)) 2117 fs (list this) count)))
2166 (let ((ff (filesets-ingroup-collect-build-menu 2118 (if (= (length ff) 1)
2167 fs (list this) count))) 2119 (car ff)
2168 (if (= (length ff) 1) 2120 ff)))
2169 (car ff) 2121 files))
2170 ff))) 2122 ,@(filesets-get-menu-epilog master ':ingroup fsn)))
2171 files)) 2123 `([,nm (filesets-file-open nil ',master ',fsn)]))))
2172 ,@(filesets-get-menu-epilog master ':ingroup fsn))) 2124 flist))))
2173 `([,nm (filesets-file-open nil ',master ',fsn)])))))))))
2174 2125
2175(defun filesets-ingroup-collect (fs remdupl-flag master) 2126(defun filesets-ingroup-collect (fs remdupl-flag master)
2176 "Collect names of included files and build submenu." 2127 "Collect names of included files and build submenu."
@@ -2275,7 +2226,7 @@ Construct a shortcut from COUNT."
2275 (:pattern 2226 (:pattern
2276 (let* ((files (filesets-get-filelist entry mode 'on-ls)) 2227 (let* ((files (filesets-get-filelist entry mode 'on-ls))
2277 (dirpatt (filesets-entry-get-pattern entry)) 2228 (dirpatt (filesets-entry-get-pattern entry))
2278 (pattname (apply 'concat (cons "Pattern: " dirpatt))) 2229 (pattname (apply #'concat (cons "Pattern: " dirpatt)))
2279 (count 0)) 2230 (count 0))
2280 ;;(filesets-message 3 "Filesets: scanning %S" pattname) 2231 ;;(filesets-message 3 "Filesets: scanning %S" pattname)
2281 `([,pattname 2232 `([,pattname
@@ -2418,14 +2369,14 @@ fileset thinks this is necessary or not."
2418 (dolist (this filesets-menu-cache-contents) 2369 (dolist (this filesets-menu-cache-contents)
2419 (if (get this 'custom-type) 2370 (if (get this 'custom-type)
2420 (progn 2371 (progn
2421 (insert (format "(setq-default %s '%S)" this (eval this))) 2372 (insert (format "(setq-default %s '%S)" this (eval this t)))
2422 (when filesets-menu-ensure-use-cached 2373 (when filesets-menu-ensure-use-cached
2423 (newline) 2374 (newline)
2424 (insert (format "(setq %s (cons '%s %s))" 2375 (insert (format "(setq %s (cons '%s %s))"
2425 'filesets-ignore-next-set-default 2376 'filesets-ignore-next-set-default
2426 this 2377 this
2427 'filesets-ignore-next-set-default)))) 2378 'filesets-ignore-next-set-default))))
2428 (insert (format "(setq %s '%S)" this (eval this)))) 2379 (insert (format "(setq %s '%S)" this (eval this t))))
2429 (newline 2)) 2380 (newline 2))
2430 (insert (format "(setq filesets-cache-version %S)" filesets-version)) 2381 (insert (format "(setq filesets-cache-version %S)" filesets-version))
2431 (newline 2) 2382 (newline 2)
@@ -2526,9 +2477,9 @@ We apologize for the inconvenience.")))
2526 "Filesets initialization. 2477 "Filesets initialization.
2527Set up hooks, load the cache file -- if existing -- and build the menu." 2478Set up hooks, load the cache file -- if existing -- and build the menu."
2528 (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe) 2479 (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
2529 (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl)) 2480 (add-hook 'kill-buffer-hook #'filesets-remove-from-ubl)
2530 (add-hook 'first-change-hook (function filesets-reset-filename-on-change)) 2481 (add-hook 'first-change-hook #'filesets-reset-filename-on-change)
2531 (add-hook 'kill-emacs-hook (function filesets-exit)) 2482 (add-hook 'kill-emacs-hook #'filesets-exit)
2532 (if (filesets-menu-cache-file-load) 2483 (if (filesets-menu-cache-file-load)
2533 (progn 2484 (progn
2534 (filesets-build-menu-maybe) 2485 (filesets-build-menu-maybe)
@@ -2542,7 +2493,7 @@ Set up hooks, load the cache file -- if existing -- and build the menu."
2542(defun filesets-error (_class &rest args) 2493(defun filesets-error (_class &rest args)
2543 "`error' wrapper." 2494 "`error' wrapper."
2544 (declare (obsolete error "28.1")) 2495 (declare (obsolete error "28.1"))
2545 (error "%s" (mapconcat 'identity args " "))) 2496 (error "%s" (mapconcat #'identity args " ")))
2546 2497
2547(provide 'filesets) 2498(provide 'filesets)
2548 2499
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 38307bb1576..0f1a3d1c364 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -1,4 +1,4 @@
1;;; font-core.el --- Core interface to font-lock 1;;; font-core.el --- Core interface to font-lock -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/format.el b/lisp/format.el
index df3bc462c92..4209fc6401a 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -1,4 +1,4 @@
1;;; format.el --- read and save files in multiple formats 1;;; format.el --- read and save files in multiple formats -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software 3;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -419,7 +419,8 @@ If FORMAT is nil then do not do any format conversion."
419 (file-name-nondirectory file))))) 419 (file-name-nondirectory file)))))
420 (list file fmt))) 420 (list file fmt)))
421 (let ((format-alist nil)) 421 (let ((format-alist nil))
422 (find-file filename)) 422 (with-suppressed-warnings ((interactive-only find-file))
423 (find-file filename)))
423 (if format 424 (if format
424 (format-decode-buffer format))) 425 (format-decode-buffer format)))
425 426
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 18924a3ad0e..3fb8e469d04 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -145,7 +145,6 @@ used to display Gnus windows."
145 (,shell-command-buffer-name 1.0))) 145 (,shell-command-buffer-name 1.0)))
146 (bug 146 (bug
147 (vertical 1.0 147 (vertical 1.0
148 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
149 ("*Gnus Bug*" 1.0 point))) 148 ("*Gnus Bug*" 1.0 point)))
150 (score-trace 149 (score-trace
151 (vertical 1.0 150 (vertical 1.0
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 61946aa5811..2b0b61bfac6 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1264,11 +1264,20 @@ in HANDLE."
1264 (when (and (mm-handle-buffer handle) 1264 (when (and (mm-handle-buffer handle)
1265 (buffer-name (mm-handle-buffer handle))) 1265 (buffer-name (mm-handle-buffer handle)))
1266 (with-temp-buffer 1266 (with-temp-buffer
1267 (mm-disable-multibyte) 1267 (if (and (eq (mm-handle-encoding handle) '8bit)
1268 (insert-buffer-substring (mm-handle-buffer handle)) 1268 (with-current-buffer (mm-handle-buffer handle)
1269 (mm-decode-content-transfer-encoding 1269 enable-multibyte-characters))
1270 (mm-handle-encoding handle) 1270 ;; Due to unfortunate historical reasons, we may have a
1271 (mm-handle-media-type handle)) 1271 ;; multibyte buffer here, but if it's using an 8bit
1272 ;; Content-Transfer-Encoding, then work around that by
1273 ;; just ignoring the situation.
1274 (insert-buffer-substring (mm-handle-buffer handle))
1275 ;; Do the decoding.
1276 (mm-disable-multibyte)
1277 (insert-buffer-substring (mm-handle-buffer handle))
1278 (mm-decode-content-transfer-encoding
1279 (mm-handle-encoding handle)
1280 (mm-handle-media-type handle)))
1272 ,@forms)))) 1281 ,@forms))))
1273(put 'mm-with-part 'lisp-indent-function 1) 1282(put 'mm-with-part 'lisp-indent-function 1)
1274(put 'mm-with-part 'edebug-form-spec '(body)) 1283(put 'mm-with-part 'edebug-form-spec '(body))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 68c31dc4510..e4fd976742c 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -494,7 +494,7 @@ This variable is set by `nnmaildir-request-article'.")
494 (delete-char 1) 494 (delete-char 1)
495 (setq nov (nnheader-parse-head t) 495 (setq nov (nnheader-parse-head t)
496 field (or (mail-header-lines nov) 0))) 496 field (or (mail-header-lines nov) 0)))
497 (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) 497 (unless (or (<= field 0) (nnmaildir--param pgname 'distrust-Lines:))
498 (setq nov-mid field)) 498 (setq nov-mid field))
499 (setq nov-mid (number-to-string nov-mid) 499 (setq nov-mid (number-to-string nov-mid)
500 nov-mid (concat (number-to-string attr) "\t" nov-mid)) 500 nov-mid (concat (number-to-string attr) "\t" nov-mid))
diff --git a/lisp/info.el b/lisp/info.el
index ef94aa945f2..62d7b583ff2 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -160,17 +160,14 @@ A header-line does not scroll with the rest of the buffer."
160 :version "24.4") 160 :version "24.4")
161 161
162;; This is a defcustom largely so that we can get the benefit 162;; This is a defcustom largely so that we can get the benefit
163;; of custom-initialize-delay. Perhaps it would work to make it a 163;; of `custom-initialize-delay'. Perhaps it would work to make it a
164;; defvar and explicitly give it a standard-value property, and 164;; `defvar' and explicitly give it a `standard-value' property, and
165;; call custom-initialize-delay on it. 165;; call `custom-initialize-delay' on it.
166;; The progn forces the autoloader to include the whole thing, not 166;; The value is initialized at startup time, when command-line calls
167;; just an abbreviated version. The value is initialized at startup 167;; `custom-reevaluate-setting' on all the defcustoms in
168;; time, when command-line calls custom-reevaluate-setting on all 168;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally
169;; the defcustoms in custom-delayed-init-variables. This is 169;; this should be done when Info mode is first invoked.
170;; somewhat sub-optimal, as ideally this should be done when Info
171;; mode is first invoked.
172;;;###autoload 170;;;###autoload
173(progn
174(defcustom Info-default-directory-list 171(defcustom Info-default-directory-list
175 (let* ((config-dir 172 (let* ((config-dir
176 (file-name-as-directory 173 (file-name-as-directory
@@ -232,8 +229,8 @@ the environment variable INFOPATH is set.
232Although this is a customizable variable, that is mainly for technical 229Although this is a customizable variable, that is mainly for technical
233reasons. Normally, you should either set INFOPATH or customize 230reasons. Normally, you should either set INFOPATH or customize
234`Info-additional-directory-list', rather than changing this variable." 231`Info-additional-directory-list', rather than changing this variable."
235 :initialize 'custom-initialize-delay 232 :initialize #'custom-initialize-delay
236 :type '(repeat directory))) 233 :type '(repeat directory))
237 234
238(defvar Info-directory-list nil 235(defvar Info-directory-list nil
239 "List of directories to search for Info documentation files. 236 "List of directories to search for Info documentation files.
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 6924e1c06db..9bce419b489 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1,4 +1,4 @@
1;;; characters.el --- set syntax and category for multibyte characters 1;;; characters.el --- set syntax and category for multibyte characters -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -526,9 +526,6 @@ with L, LRE, or LRO Unicode bidi character type.")
526 ;; FIXME: We should probably just use the Unicode properties to set 526 ;; FIXME: We should probably just use the Unicode properties to set
527 ;; up the syntax table. 527 ;; up the syntax table.
528 528
529 ;; NBSP isn't semantically interchangeable with other whitespace chars,
530 ;; so it's more like punctuation.
531 (set-case-syntax ?  "." tbl)
532 (set-case-syntax ?¡ "." tbl) 529 (set-case-syntax ?¡ "." tbl)
533 (set-case-syntax ?¦ "_" tbl) 530 (set-case-syntax ?¦ "_" tbl)
534 (set-case-syntax ?§ "." tbl) 531 (set-case-syntax ?§ "." tbl)
@@ -602,11 +599,17 @@ with L, LRE, or LRO Unicode bidi character type.")
602 ;; Cyrillic Extended-C 599 ;; Cyrillic Extended-C
603 (modify-category-entry '(#x1C80 . #x1C8F) ?y) 600 (modify-category-entry '(#x1C80 . #x1C8F) ?y)
604 601
605 ;; general punctuation 602 ;; space characters (see section 6.2 in the Unicode Standard)
603 (set-case-syntax ?  " " tbl)
606 (setq c #x2000) 604 (setq c #x2000)
607 (while (<= c #x200b) 605 (while (<= c #x200b)
608 (set-case-syntax c " " tbl) 606 (set-case-syntax c " " tbl)
609 (setq c (1+ c))) 607 (setq c (1+ c)))
608 (let ((chars '(#x202F #x205F #x3000)))
609 (while chars
610 (set-case-syntax (car chars) " " tbl)
611 (setq chars (cdr chars))))
612 ;; general punctuation
610 (while (<= c #x200F) 613 (while (<= c #x200F)
611 (set-case-syntax c "." tbl) 614 (set-case-syntax c "." tbl)
612 (setq c (1+ c))) 615 (setq c (1+ c)))
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 4d80e17e3db..14e7b89dd1f 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -1,4 +1,4 @@
1;;; fontset.el --- commands for handling fontset 1;;; fontset.el --- commands for handling fontset -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index 8b5814e577c..2c7da2b7cdf 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -1,4 +1,4 @@
1;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8 -*- 1;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation, 3;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation,
4;; Inc. 4;; Inc.
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 662f211bd28..64aac46fcee 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1,4 +1,4 @@
1;;; mule-conf.el --- configure multilingual environment 1;;; mule-conf.el --- configure multilingual environment -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index d3a1005dae5..6a32cffe9a6 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1,4 +1,4 @@
1;;; mule.el --- basic commands for multilingual environment 1;;; mule.el --- basic commands for multilingual environment -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index d1b5c077813..0f8dedfc09b 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -1,4 +1,4 @@
1;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC 1;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2009-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
4 4
@@ -185,7 +185,7 @@
185 ;; always returns nil, something the code here doesn't like. 185 ;; always returns nil, something the code here doesn't like.
186 (define-char-code-property 'decomposition "uni-decomposition.el") 186 (define-char-code-property 'decomposition "uni-decomposition.el")
187 (define-char-code-property 'canonical-combining-class "uni-combining.el") 187 (define-char-code-property 'canonical-combining-class "uni-combining.el")
188 (let ((char 0) ccc decomposition) 188 (let (ccc decomposition)
189 (mapc 189 (mapc
190 (lambda (start-end) 190 (lambda (start-end)
191 (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) 191 (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index fefdd16d25b..67cc7bed15b 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -669,6 +669,10 @@ This is like `describe-bindings', but displays only Isearch keys."
669 (if isearch-success 'isearch-abort binding)))) 669 (if isearch-success 'isearch-abort binding))))
670 map)) 670 map))
671 671
672;; Note: Before adding more key bindings to this map, please keep in
673;; mind that any unbound key exits Isearch and runs the command bound
674;; to it in the local or global map. So in effect every key unbound
675;; in this map is implicitly bound.
672(defvar isearch-mode-map 676(defvar isearch-mode-map
673 (let ((i 0) 677 (let ((i 0)
674 (map (make-keymap))) 678 (map (make-keymap)))
@@ -834,6 +838,10 @@ This is like `describe-bindings', but displays only Isearch keys."
834 :image '(isearch-tool-bar-image "left-arrow"))) 838 :image '(isearch-tool-bar-image "left-arrow")))
835 map)) 839 map))
836 840
841;; Note: Before adding more key bindings to this map, please keep in
842;; mind that any unbound key exits Isearch and runs the command bound
843;; to it in the local or global map. So in effect every key unbound
844;; in this map is implicitly bound.
837(defvar minibuffer-local-isearch-map 845(defvar minibuffer-local-isearch-map
838 (let ((map (make-sparse-keymap))) 846 (let ((map (make-sparse-keymap)))
839 (set-keymap-parent map minibuffer-local-map) 847 (set-keymap-parent map minibuffer-local-map)
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 3c7d2a057d5..11d93a6df9a 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -1,4 +1,4 @@
1;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el 1;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software 3;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -93,6 +93,7 @@ Otherwise, it is nil.")
93 "\\)" file-name-version-regexp "?\\'")))) 93 "\\)" file-name-version-regexp "?\\'"))))
94 94
95;; Functions for accessing the return value of jka-compr-get-compression-info 95;; Functions for accessing the return value of jka-compr-get-compression-info
96;; FIXME: Use cl-defstruct!
96(defun jka-compr-info-regexp (info) (aref info 0)) 97(defun jka-compr-info-regexp (info) (aref info 0))
97(defun jka-compr-info-compress-message (info) (aref info 1)) 98(defun jka-compr-info-compress-message (info) (aref info 1))
98(defun jka-compr-info-compress-program (info) (aref info 2)) 99(defun jka-compr-info-compress-program (info) (aref info 2))
diff --git a/lisp/json.el b/lisp/json.el
index f5659d81efa..1f1f608eaba 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -55,7 +55,6 @@
55;;; Code: 55;;; Code:
56 56
57(require 'map) 57(require 'map)
58(require 'seq)
59(require 'subr-x) 58(require 'subr-x)
60 59
61;; Parameters 60;; Parameters
@@ -655,7 +654,9 @@ become JSON objects."
655(defun json-encode-array (array) 654(defun json-encode-array (array)
656 "Return a JSON representation of ARRAY." 655 "Return a JSON representation of ARRAY."
657 (if (and json-encoding-pretty-print 656 (if (and json-encoding-pretty-print
658 (not (seq-empty-p array))) 657 (if (listp array)
658 array
659 (> (length array) 0)))
659 (concat 660 (concat
660 "[" 661 "["
661 (json--with-indentation 662 (json--with-indentation
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index 6b434feb137..5cb8344c094 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -1,4 +1,4 @@
1;;; chinese.el --- support for Chinese -*- coding: utf-8; -*- 1;;; chinese.el --- support for Chinese -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index c491644d57c..c12096f95eb 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -1,4 +1,4 @@
1;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; -*- 1;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/english.el b/lisp/language/english.el
index dfbec85792f..41d56be7d46 100644
--- a/lisp/language/english.el
+++ b/lisp/language/english.el
@@ -1,4 +1,4 @@
1;;; english.el --- support for English 1;;; english.el --- support for English -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 1e409e3dcf8..8573f6177df 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -1,4 +1,4 @@
1;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*- 1;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/european.el b/lisp/language/european.el
index 1f27ff0c73b..bcd62a14c4c 100644
--- a/lisp/language/european.el
+++ b/lisp/language/european.el
@@ -1,4 +1,4 @@
1;;; european.el --- support for European languages -*- coding: utf-8; -*- 1;;; european.el --- support for European languages -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 9f9a14a0dc0..389565669a9 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -1,4 +1,4 @@
1;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*- 1;;; hebrew.el --- support for Hebrew -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index b92fda53648..5ff57966c12 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -1,4 +1,4 @@
1;;; indian.el --- Indian languages support -*- coding: utf-8; -*- 1;;; indian.el --- Indian languages support -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 4;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index 8c724ee9667..bd8ef6ec857 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -1,4 +1,4 @@
1;;; japanese.el --- support for Japanese 1;;; japanese.el --- support for Japanese -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 997b8ae1319..22b33a440ef 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -1,4 +1,4 @@
1;;; korean.el --- support for Korean -*- coding: utf-8 -*- 1;;; korean.el --- support for Korean -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 44fe8d230db..5252f1e60ea 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -1,4 +1,4 @@
1;;; lao.el --- support for Lao -*- coding: utf-8 -*- 1;;; lao.el --- support for Lao -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 089b79c5208..0a274f144c2 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -1,4 +1,4 @@
1;;; misc-lang.el --- support for miscellaneous languages (characters) 1;;; misc-lang.el --- support for miscellaneous languages (characters) -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 4;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 44a9a319330..be15db49db9 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -1,4 +1,4 @@
1;;; thai.el --- support for Thai -*- coding: utf-8 -*- 1;;; thai.el --- support for Thai -*- coding: utf-8; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index 5b8e29c2c7a..edd9d765b1e 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -1,4 +1,4 @@
1;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*- 1;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index f4de299f537..2e583a470d6 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -1,4 +1,4 @@
1;;; reporter.el --- customizable bug reporting of lisp programs 1;;; reporter.el --- customizable bug reporting of lisp programs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -158,7 +158,7 @@ composed.")
158 t) 158 t)
159 (error indent-enclosing-p)))) 159 (error indent-enclosing-p))))
160 160
161(defun reporter-lisp-indent (indent-point state) 161(defun reporter-lisp-indent (_indent-point state)
162 "A better lisp indentation style for bug reporting." 162 "A better lisp indentation style for bug reporting."
163 (save-excursion 163 (save-excursion
164 (goto-char (1+ (nth 1 state))) 164 (goto-char (1+ (nth 1 state)))
@@ -193,7 +193,7 @@ MAILBUF is the mail buffer being composed."
193 (<= maxwidth (current-column))) 193 (<= maxwidth (current-column)))
194 (save-excursion 194 (save-excursion
195 (let ((compact-p (not (memq varsym reporter-dont-compact-list))) 195 (let ((compact-p (not (memq varsym reporter-dont-compact-list)))
196 (lisp-indent-function 'reporter-lisp-indent)) 196 (lisp-indent-function #'reporter-lisp-indent))
197 (goto-char here) 197 (goto-char here)
198 (reporter-beautify-list maxwidth compact-p)))) 198 (reporter-beautify-list maxwidth compact-p))))
199 (insert "\n")) 199 (insert "\n"))
@@ -206,6 +206,11 @@ MAILBUF is the mail buffer being composed."
206 (error 206 (error
207 (error "")))) 207 (error ""))))
208 208
209(defun reporter--run-functions (funs)
210 (if (functionp funs)
211 (funcall funs)
212 (mapc #'funcall funs)))
213
209(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks) 214(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
210 "Dump the state of the mode specific variables. 215 "Dump the state of the mode specific variables.
211PKGNAME contains the name of the mode as it will appear in the bug 216PKGNAME contains the name of the mode as it will appear in the bug
@@ -230,42 +235,39 @@ properly.
230PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but 235PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but
231before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is 236before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is
232dumped." 237dumped."
233 (let ((buffer (current-buffer))) 238 (insert "Emacs : " (emacs-version) "\n")
234 (set-buffer buffer) 239 (and pkgname
235 (insert "Emacs : " (emacs-version) "\n") 240 (insert "Package: " pkgname "\n"))
236 (and pkgname 241 (reporter--run-functions pre-hooks)
237 (insert "Package: " pkgname "\n")) 242 (if (not varlist)
238 (run-hooks 'pre-hooks) 243 nil
239 (if (not varlist) 244 (insert "\ncurrent state:\n==============\n")
240 nil 245 ;; create an emacs-lisp-mode buffer to contain the output, which
241 (insert "\ncurrent state:\n==============\n") 246 ;; we'll later insert into the mail buffer
242 ;; create an emacs-lisp-mode buffer to contain the output, which 247 (condition-case fault
243 ;; we'll later insert into the mail buffer 248 (let ((mailbuf (current-buffer))
244 (condition-case fault 249 (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
245 (let ((mailbuf (current-buffer)) 250 (with-current-buffer elbuf
246 (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) 251 (emacs-lisp-mode)
247 (with-current-buffer elbuf 252 (erase-buffer)
248 (emacs-lisp-mode) 253 (insert "(setq\n")
249 (erase-buffer) 254 (lisp-indent-line)
250 (insert "(setq\n") 255 (mapc
251 (lisp-indent-line) 256 (lambda (varsym-or-cons-cell)
252 (mapc 257 (let ((varsym (or (car-safe varsym-or-cons-cell)
253 (lambda (varsym-or-cons-cell) 258 varsym-or-cons-cell))
254 (let ((varsym (or (car-safe varsym-or-cons-cell) 259 (printer (or (cdr-safe varsym-or-cons-cell)
255 varsym-or-cons-cell)) 260 'reporter-dump-variable)))
256 (printer (or (cdr-safe varsym-or-cons-cell) 261 (funcall printer varsym mailbuf)))
257 'reporter-dump-variable))) 262 varlist)
258 (funcall printer varsym mailbuf))) 263 (lisp-indent-line)
259 varlist) 264 (insert ")\n"))
260 (lisp-indent-line) 265 (insert-buffer-substring elbuf))
261 (insert ")\n")) 266 (error
262 (insert-buffer-substring elbuf)) 267 (insert "State could not be dumped due to the following error:\n\n"
263 (error 268 (format "%s" fault)
264 (insert "State could not be dumped due to the following error:\n\n" 269 "\n\nYou should still send this bug report."))))
265 (format "%s" fault) 270 (reporter--run-functions post-hooks))
266 "\n\nYou should still send this bug report."))))
267 (run-hooks 'post-hooks)
268 ))
269 271
270 272
271(defun reporter-compose-outgoing () 273(defun reporter-compose-outgoing ()
@@ -365,7 +367,7 @@ mail-sending package is used for editing and sending the message."
365 (skip-chars-backward " \t\n") 367 (skip-chars-backward " \t\n")
366 (setq reporter-initial-text (buffer-substring after-sep-pos (point)))) 368 (setq reporter-initial-text (buffer-substring after-sep-pos (point))))
367 (if (setq hookvar (get agent 'hookvar)) 369 (if (setq hookvar (get agent 'hookvar))
368 (add-hook hookvar 'reporter-bug-hook nil t)) 370 (add-hook hookvar #'reporter-bug-hook nil t))
369 371
370 ;; compose the minibuf message and display this. 372 ;; compose the minibuf message and display this.
371 (let* ((sendkey-whereis (where-is-internal 373 (let* ((sendkey-whereis (where-is-internal
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 69797837cd2..29460cc20f5 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -161,13 +161,6 @@ its character representation and its display representation.")
161 :version "21.1") 161 :version "21.1")
162 162
163;;;###autoload 163;;;###autoload
164(put 'rmail-spool-directory 'standard-value
165 '((cond ((file-exists-p "/var/mail") "/var/mail/")
166 ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
167 ((memq system-type '(hpux usg-unix-v)) "/usr/mail/")
168 (t "/usr/spool/mail/"))))
169
170;;;###autoload
171(defcustom rmail-spool-directory 164(defcustom rmail-spool-directory
172 (purecopy 165 (purecopy
173 (cond ((file-exists-p "/var/mail") 166 (cond ((file-exists-p "/var/mail")
@@ -181,12 +174,10 @@ its character representation and its display representation.")
181 (t "/usr/spool/mail/"))) 174 (t "/usr/spool/mail/")))
182 "Name of directory used by system mailer for delivering new mail. 175 "Name of directory used by system mailer for delivering new mail.
183Its name should end with a slash." 176Its name should end with a slash."
184 :initialize 'custom-initialize-delay 177 :initialize #'custom-initialize-delay
185 :type 'directory 178 :type 'directory
186 :group 'rmail) 179 :group 'rmail)
187 180
188;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
189
190(defcustom rmail-movemail-program nil 181(defcustom rmail-movemail-program nil
191 "If non-nil, the file name of the `movemail' program." 182 "If non-nil, the file name of the `movemail' program."
192 :group 'rmail-retrieve 183 :group 'rmail-retrieve
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index 06da0739d6b..f9a24e34bf2 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -35,6 +35,11 @@
35It is called with one argument, the minibuffer depth, 35It is called with one argument, the minibuffer depth,
36and must return a string.") 36and must return a string.")
37 37
38(defface minibuffer-depth-indicator '((t :inherit highlight))
39 "Face to use for minibuffer depth indicator."
40 :group 'minibuffer
41 :version "28.1")
42
38;; An overlay covering the prompt. This is a buffer-local variable in 43;; An overlay covering the prompt. This is a buffer-local variable in
39;; each affected minibuffer. 44;; each affected minibuffer.
40;; 45;;
@@ -52,7 +57,10 @@ The prompt should already have been inserted."
52 (overlay-put minibuffer-depth-overlay 'before-string 57 (overlay-put minibuffer-depth-overlay 'before-string
53 (if minibuffer-depth-indicator-function 58 (if minibuffer-depth-indicator-function
54 (funcall minibuffer-depth-indicator-function depth) 59 (funcall minibuffer-depth-indicator-function depth)
55 (propertize (format "[%d]" depth) 'face 'highlight))) 60 (concat (propertize (format "[%d]" depth)
61 'face
62 'minibuffer-depth-indicator)
63 " ")))
56 (overlay-put minibuffer-depth-overlay 'evaporate t)))) 64 (overlay-put minibuffer-depth-overlay 'evaporate t))))
57 65
58;;;###autoload 66;;;###autoload
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 65fdccd70b2..20dbb5eaa60 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1,4 +1,4 @@
1;;; menu-bar.el --- define a default menu bar 1;;; menu-bar.el --- define a default menu bar -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
4 4
@@ -229,7 +229,8 @@
229 (filename (car (find-file-read-args "Find file: " mustmatch)))) 229 (filename (car (find-file-read-args "Find file: " mustmatch))))
230 (if mustmatch 230 (if mustmatch
231 (find-file-existing filename) 231 (find-file-existing filename)
232 (find-file filename)))) 232 (with-suppressed-warnings ((interactive-only find-file))
233 (find-file filename)))))
233 234
234;; The "Edit->Search" submenu 235;; The "Edit->Search" submenu
235(defvar menu-bar-last-search-type nil 236(defvar menu-bar-last-search-type nil
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index aa34fe7f1a3..dcac36f2a4a 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -463,7 +463,7 @@ Return non-nil if it is necessary to update the local UIDL file."
463 (when (cdr elt) 463 (when (cdr elt)
464 (insert "(\"" (pop elt) "\"\n ") 464 (insert "(\"" (pop elt) "\"\n ")
465 (while elt 465 (while elt
466 (insert (format "\"%s\" %s\n " (pop elt) (pop elt)))) 466 (insert (format "%S %s\n " (pop elt) (pop elt))))
467 (delete-char -4) 467 (delete-char -4)
468 (insert ")\n "))) 468 (insert ")\n ")))
469 (delete-char -3) 469 (delete-char -3)
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 0d48fd7e05a..96fafc826b8 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -385,6 +385,7 @@
385 ) 385 )
386 ) 386 )
387 (process-put proc 'socks-state socks-state-authenticated) 387 (process-put proc 'socks-state socks-state-authenticated)
388 (process-put proc 'socks-scratch "")
388 (set-process-filter proc #'socks-filter))) 389 (set-process-filter proc #'socks-filter)))
389 proc))) 390 proc)))
390 391
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 865ea4e92a4..b43b4485fec 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2672,7 +2672,8 @@ The method used must be an out-of-band method."
2672 (tramp-get-remote-null-device v)))) 2672 (tramp-get-remote-null-device v))))
2673 2673
2674 (save-restriction 2674 (save-restriction
2675 (let ((beg (point))) 2675 (let ((beg (point))
2676 (emc enable-multibyte-characters))
2676 (narrow-to-region (point) (point)) 2677 (narrow-to-region (point) (point))
2677 ;; We cannot use `insert-buffer-substring' because the Tramp 2678 ;; We cannot use `insert-buffer-substring' because the Tramp
2678 ;; buffer changes its contents before insertion due to calling 2679 ;; buffer changes its contents before insertion due to calling
@@ -2681,7 +2682,9 @@ The method used must be an out-of-band method."
2681 (with-current-buffer (tramp-get-buffer v) 2682 (with-current-buffer (tramp-get-buffer v)
2682 (buffer-string))) 2683 (buffer-string)))
2683 2684
2684 ;; Check for "--dired" output. 2685 ;; Check for "--dired" output. We must enable unibyte
2686 ;; strings, because the "--dired" output counts in bytes.
2687 (set-buffer-multibyte nil)
2685 (forward-line -2) 2688 (forward-line -2)
2686 (when (looking-at-p "//SUBDIRED//") 2689 (when (looking-at-p "//SUBDIRED//")
2687 (forward-line -1)) 2690 (forward-line -1))
@@ -2701,6 +2704,8 @@ The method used must be an out-of-band method."
2701 (while (looking-at "//") 2704 (while (looking-at "//")
2702 (forward-line 1) 2705 (forward-line 1)
2703 (delete-region (match-beginning 0) (point))) 2706 (delete-region (match-beginning 0) (point)))
2707 ;; Reset multibyte if needed.
2708 (set-buffer-multibyte emc)
2704 2709
2705 ;; Some busyboxes are reluctant to discard colors. 2710 ;; Some busyboxes are reluctant to discard colors.
2706 (unless 2711 (unless
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index e328b6eab52..3916e35f769 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -25,7 +25,8 @@
25;;; Commentary: 25;;; Commentary:
26 26
27;; This game can be run in batch mode. To do this, use: 27;; This game can be run in batch mode. To do this, use:
28;; emacs -batch -l dunnet 28;;
29;; emacs --batch -f dunnet
29 30
30;;; Code: 31;;; Code:
31 32
@@ -1170,11 +1171,13 @@ treasures for points?" "4" "four")
1170(defun dunnet () 1171(defun dunnet ()
1171 "Switch to *dungeon* buffer and start game." 1172 "Switch to *dungeon* buffer and start game."
1172 (interactive) 1173 (interactive)
1173 (pop-to-buffer-same-window "*dungeon*") 1174 (if noninteractive
1174 (dun-mode) 1175 (dun--batch)
1175 (setq dun-dead nil) 1176 (pop-to-buffer-same-window "*dungeon*")
1176 (setq dun-room 0) 1177 (dun-mode)
1177 (dun-messages)) 1178 (setq dun-dead nil)
1179 (setq dun-room 0)
1180 (dun-messages)))
1178 1181
1179;;;; 1182;;;;
1180;;;; This section contains all of the verbs and commands. 1183;;;; This section contains all of the verbs and commands.
@@ -3126,8 +3129,7 @@ File not found")))
3126 (dun-mprinc "\n") 3129 (dun-mprinc "\n")
3127 (dun-batch-loop)) 3130 (dun-batch-loop))
3128 3131
3129;;;###autoload 3132(defun dun--batch ()
3130(defun dun-batch ()
3131 "Start `dunnet' in batch mode." 3133 "Start `dunnet' in batch mode."
3132 (fset 'dun-mprinc #'dun-batch-mprinc) 3134 (fset 'dun-mprinc #'dun-batch-mprinc)
3133 (fset 'dun-mprincl #'dun-batch-mprincl) 3135 (fset 'dun-mprincl #'dun-batch-mprincl)
@@ -3140,6 +3142,17 @@ File not found")))
3140 (setq dun-batch-mode t) 3142 (setq dun-batch-mode t)
3141 (dun-batch-loop)) 3143 (dun-batch-loop))
3142 3144
3145;; Apparently, there are many references out there to running us via
3146;;
3147;; emacs --batch -l dunnet
3148;;
3149;; So try and accommodate those without interfering with other cases
3150;; where `dunnet.el' might be loaded in batch mode with no intention
3151;; to run the game.
3152(when (and noninteractive
3153 (equal '("-l" "dunnet") (member "-l" command-line-args)))
3154 (dun--batch))
3155
3143(provide 'dunnet) 3156(provide 'dunnet)
3144 3157
3145;; Local Variables: 3158;; Local Variables:
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index fddc13f56b1..460af718aad 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> 5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Version: 1.1.0 7;; Version: 1.1.1
8;; Keywords: c languages tools 8;; Keywords: c languages tools
9;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) 9;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
10 10
@@ -1283,6 +1283,8 @@ correctly.")
1283 (when (flymake-running-backends) flymake-mode-line-counter-format)) 1283 (when (flymake-running-backends) flymake-mode-line-counter-format))
1284 1284
1285(defun flymake--mode-line-counter (type &optional no-space) 1285(defun flymake--mode-line-counter (type &optional no-space)
1286 "Compute number of diagnostics in buffer with TYPE's severity.
1287TYPE is usually keyword `:error', `:warning' or `:note'."
1286 (let ((count 0) 1288 (let ((count 0)
1287 (face (flymake--lookup-type-property type 1289 (face (flymake--lookup-type-property type
1288 'mode-line-face 1290 'mode-line-face
@@ -1290,7 +1292,8 @@ correctly.")
1290 (maphash (lambda 1292 (maphash (lambda
1291 (_b state) 1293 (_b state)
1292 (dolist (d (flymake--backend-state-diags state)) 1294 (dolist (d (flymake--backend-state-diags state))
1293 (when (eq type (flymake--diag-type d)) 1295 (when (= (flymake--severity type)
1296 (flymake--severity (flymake--diag-type d)))
1294 (cl-incf count)))) 1297 (cl-incf count))))
1295 flymake--backend-state) 1298 flymake--backend-state)
1296 (when (or (cl-plusp count) 1299 (when (or (cl-plusp count)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index ec20b01a0f0..2a2a4978c62 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -324,13 +324,33 @@
324 ;; disambiguate with the left-bitshift operator. 324 ;; disambiguate with the left-bitshift operator.
325 "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" 325 "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
326 ".*\\(\n\\)") 326 ".*\\(\n\\)")
327 (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table)) 327 (4 (let* ((eol (match-beginning 4))
328 (st (get-text-property eol 'syntax-table))
328 (name (match-string 2)) 329 (name (match-string 2))
329 (indented (match-beginning 1))) 330 (indented (match-beginning 1)))
330 (goto-char (match-end 2)) 331 (goto-char (match-end 2))
331 (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) 332 (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
333 ;; '<<' occurred in a string, or in a comment.
332 ;; Leave the property of the newline unchanged. 334 ;; Leave the property of the newline unchanged.
333 st 335 st
336 ;; Beware of `foo <<'BAR' #baz` because
337 ;; the newline needs to start the here-doc
338 ;; and can't be used to close the comment.
339 (let ((eol-state (save-excursion (syntax-ppss eol))))
340 (when (nth 4 eol-state)
341 (if (/= (1- eol) (nth 8 eol-state))
342 ;; make the last char of the comment closing it
343 (put-text-property (1- eol) eol
344 'syntax-table (string-to-syntax ">"))
345 ;; In `foo <<'BAR' #` the # is the last character
346 ;; before eol and can't both open and close the
347 ;; comment. Workaround: disguise the "#" as
348 ;; whitespace and fontify it as a comment.
349 (put-text-property (1- eol) eol
350 'syntax-table (string-to-syntax "-"))
351 (put-text-property (1- eol) eol
352 'font-lock-face
353 'font-lock-comment-face))))
334 (cons (car (string-to-syntax "< c")) 354 (cons (car (string-to-syntax "< c"))
335 ;; Remember the names of heredocs found on this line. 355 ;; Remember the names of heredocs found on this line.
336 (cons (cons (pcase (aref name 0) 356 (cons (cons (pcase (aref name 0)
@@ -483,8 +503,15 @@
483 ;; as twoarg). 503 ;; as twoarg).
484 (perl-syntax-propertize-special-constructs limit))))))))) 504 (perl-syntax-propertize-special-constructs limit)))))))))
485 505
506(defface perl-heredoc
507 '((t (:inherit font-lock-string-face)))
508 "The face for here-documents. Inherits from font-lock-string-face.")
509
486(defun perl-font-lock-syntactic-face-function (state) 510(defun perl-font-lock-syntactic-face-function (state)
487 (cond 511 (cond
512 ((and (eq 2 (nth 7 state)) ; c-style comment
513 (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc
514 'perl-heredoc)
488 ((and (nth 3 state) 515 ((and (nth 3 state)
489 (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) 516 (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
490 ;; This is a second-arg of s{..}{...} form; let's check if this second 517 ;; This is a second-arg of s{..}{...} form; let's check if this second
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index d417382c0df..62c3cf44cb6 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -291,7 +291,8 @@ to find the list of ignores for each directory."
291 (localdir (file-local-name (expand-file-name dir))) 291 (localdir (file-local-name (expand-file-name dir)))
292 (command (format "%s %s %s -type f %s -print0" 292 (command (format "%s %s %s -type f %s -print0"
293 find-program 293 find-program
294 localdir 294 ;; In case DIR is a symlink.
295 (file-name-as-directory localdir)
295 (xref--find-ignores-arguments ignores localdir) 296 (xref--find-ignores-arguments ignores localdir)
296 (if files 297 (if files
297 (concat (shell-quote-argument "(") 298 (concat (shell-quote-argument "(")
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 3effb6ed662..a8667acb9d5 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1598,13 +1598,16 @@ See `add-log-current-defun-function'."
1598 (let* ((indent 0) mname mlist 1598 (let* ((indent 0) mname mlist
1599 (start (point)) 1599 (start (point))
1600 (make-definition-re 1600 (make-definition-re
1601 (lambda (re) 1601 (lambda (re &optional method-name?)
1602 (concat "^[ \t]*" re "[ \t]+" 1602 (concat "^[ \t]*" re "[ \t]+"
1603 "\\(" 1603 "\\("
1604 ;; \\. and :: for class methods 1604 ;; \\. and :: for class methods
1605 "\\([A-Za-z_]" ruby-symbol-re "*[?!]?\\|\\.\\|::" "\\)" 1605 "\\([A-Za-z_]" ruby-symbol-re "*[?!]?"
1606 "\\|"
1607 (if method-name? ruby-operator-re "\\.")
1608 "\\|::" "\\)"
1606 "+\\)"))) 1609 "+\\)")))
1607 (definition-re (funcall make-definition-re ruby-defun-beg-re)) 1610 (definition-re (funcall make-definition-re ruby-defun-beg-re t))
1608 (module-re (funcall make-definition-re "\\(class\\|module\\)"))) 1611 (module-re (funcall make-definition-re "\\(class\\|module\\)")))
1609 ;; Get the current method definition (or class/module). 1612 ;; Get the current method definition (or class/module).
1610 (when (re-search-backward definition-re nil t) 1613 (when (re-search-backward definition-re nil t)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 2fefc23e199..d3b6ae71a0a 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -928,8 +928,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
928 (or 928 (or
929 (assoc-default 'fetched-xrefs alist) 929 (assoc-default 'fetched-xrefs alist)
930 (funcall fetcher))) 930 (funcall fetcher)))
931 (xref-alist (xref--analyze xrefs))) 931 (xref-alist (xref--analyze xrefs))
932 (dd default-directory))
932 (with-current-buffer (get-buffer-create xref-buffer-name) 933 (with-current-buffer (get-buffer-create xref-buffer-name)
934 (setq default-directory dd)
933 (xref--xref-buffer-mode) 935 (xref--xref-buffer-mode)
934 (xref--show-common-initialize xref-alist fetcher alist) 936 (xref--show-common-initialize xref-alist fetcher alist)
935 (pop-to-buffer (current-buffer)) 937 (pop-to-buffer (current-buffer))
@@ -992,13 +994,15 @@ When only one definition found, jump to it right away instead."
992When there is more than one definition, split the selected window 994When there is more than one definition, split the selected window
993and show the list in a small window at the bottom. And use a 995and show the list in a small window at the bottom. And use a
994local keymap that binds `RET' to `xref-quit-and-goto-xref'." 996local keymap that binds `RET' to `xref-quit-and-goto-xref'."
995 (let ((xrefs (funcall fetcher))) 997 (let ((xrefs (funcall fetcher))
998 (dd default-directory))
996 (cond 999 (cond
997 ((not (cdr xrefs)) 1000 ((not (cdr xrefs))
998 (xref-pop-to-location (car xrefs) 1001 (xref-pop-to-location (car xrefs)
999 (assoc-default 'display-action alist))) 1002 (assoc-default 'display-action alist)))
1000 (t 1003 (t
1001 (with-current-buffer (get-buffer-create xref-buffer-name) 1004 (with-current-buffer (get-buffer-create xref-buffer-name)
1005 (setq default-directory dd)
1002 (xref--transient-buffer-mode) 1006 (xref--transient-buffer-mode)
1003 (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) 1007 (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
1004 (pop-to-buffer (current-buffer) 1008 (pop-to-buffer (current-buffer)
@@ -1374,7 +1378,8 @@ IGNORES is a list of glob patterns for files to ignore."
1374 ;; do that reliably enough, without creating false negatives? 1378 ;; do that reliably enough, without creating false negatives?
1375 (command (xref--rgrep-command (xref--regexp-to-extended regexp) 1379 (command (xref--rgrep-command (xref--regexp-to-extended regexp)
1376 files 1380 files
1377 (file-local-name (expand-file-name dir)) 1381 (file-name-as-directory
1382 (file-local-name (expand-file-name dir)))
1378 ignores)) 1383 ignores))
1379 (def default-directory) 1384 (def default-directory)
1380 (buf (get-buffer-create " *xref-grep*")) 1385 (buf (get-buffer-create " *xref-grep*"))
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index f9842b52b13..378358feac2 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -1,4 +1,4 @@
1;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text 1;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text -*- lexical-binding: t; -*-
2;; 2;;
3;; Copyright (C) 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
4;; 4;;
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 802cb3072fa..eecdb60f3a4 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -1,4 +1,4 @@
1;;; scroll-bar.el --- window system-independent scroll bar support 1;;; scroll-bar.el --- window system-independent scroll bar support -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/startup.el b/lisp/startup.el
index 30ce379a289..4b82f73da76 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1230,17 +1230,7 @@ please check its value")
1230 package-enable-at-startup 1230 package-enable-at-startup
1231 (not (bound-and-true-p package--activated)) 1231 (not (bound-and-true-p package--activated))
1232 (catch 'package-dir-found 1232 (catch 'package-dir-found
1233 (let (dirs) 1233 (let ((dirs (cons package-user-dir package-directory-list)))
1234 (if (boundp 'package-directory-list)
1235 (setq dirs package-directory-list)
1236 (dolist (f load-path)
1237 (and (stringp f)
1238 (equal (file-name-nondirectory f) "site-lisp")
1239 (push (expand-file-name "elpa" f) dirs))))
1240 (push (if (boundp 'package-user-dir)
1241 package-user-dir
1242 (locate-user-emacs-file "elpa"))
1243 dirs)
1244 (dolist (dir dirs) 1234 (dolist (dir dirs)
1245 (when (file-directory-p dir) 1235 (when (file-directory-p dir)
1246 (dolist (subdir (directory-files dir)) 1236 (dolist (subdir (directory-files dir))
diff --git a/lisp/subr.el b/lisp/subr.el
index 1acc3c3250b..260202945b1 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -995,6 +995,22 @@ a menu, so this function is not useful for non-menu keymaps."
995 (setq inserted t))) 995 (setq inserted t)))
996 (setq tail (cdr tail))))) 996 (setq tail (cdr tail)))))
997 997
998(defun define-prefix-command (command &optional mapvar name)
999 "Define COMMAND as a prefix command. COMMAND should be a symbol.
1000A new sparse keymap is stored as COMMAND's function definition and its
1001value.
1002This prepares COMMAND for use as a prefix key's binding.
1003If a second optional argument MAPVAR is given, it should be a symbol.
1004The map is then stored as MAPVAR's value instead of as COMMAND's
1005value; but COMMAND is still defined as a function.
1006The third optional argument NAME, if given, supplies a menu name
1007string for the map. This is required to use the keymap as a menu.
1008This function returns COMMAND."
1009 (let ((map (make-sparse-keymap name)))
1010 (fset command map)
1011 (set (or mapvar command) map)
1012 command))
1013
998(defun map-keymap-sorted (function keymap) 1014(defun map-keymap-sorted (function keymap)
999 "Implement `map-keymap' with sorting. 1015 "Implement `map-keymap' with sorting.
1000Don't call this function; it is for internal use only." 1016Don't call this function; it is for internal use only."
@@ -1239,35 +1255,83 @@ in a cleaner way with command remapping, like this:
1239 1255
1240;;;; The global keymap tree. 1256;;;; The global keymap tree.
1241 1257
1242;; global-map, esc-map, and ctl-x-map have their values set up in 1258(defvar esc-map
1243;; keymap.c; we just give them docstrings here. 1259 (let ((map (make-keymap)))
1244 1260 (define-key map "u" #'upcase-word)
1245(defvar global-map nil 1261 (define-key map "l" #'downcase-word)
1246 "Default global keymap mapping Emacs keyboard input into commands. 1262 (define-key map "c" #'capitalize-word)
1247The value is a keymap that is usually (but not necessarily) Emacs's 1263 (define-key map "x" #'execute-extended-command)
1248global map.") 1264 map)
1249
1250(defvar esc-map nil
1251 "Default keymap for ESC (meta) commands. 1265 "Default keymap for ESC (meta) commands.
1252The normal global definition of the character ESC indirects to this keymap.") 1266The normal global definition of the character ESC indirects to this keymap.")
1253 1267(fset 'ESC-prefix esc-map)
1254(defvar ctl-x-map nil 1268(make-obsolete 'ESC-prefix 'esc-map "28.1")
1255 "Default keymap for C-x commands.
1256The normal global definition of the character C-x indirects to this keymap.")
1257 1269
1258(defvar ctl-x-4-map (make-sparse-keymap) 1270(defvar ctl-x-4-map (make-sparse-keymap)
1259 "Keymap for subcommands of C-x 4.") 1271 "Keymap for subcommands of C-x 4.")
1260(defalias 'ctl-x-4-prefix ctl-x-4-map) 1272(defalias 'ctl-x-4-prefix ctl-x-4-map)
1261(define-key ctl-x-map "4" 'ctl-x-4-prefix)
1262 1273
1263(defvar ctl-x-5-map (make-sparse-keymap) 1274(defvar ctl-x-5-map (make-sparse-keymap)
1264 "Keymap for frame commands.") 1275 "Keymap for frame commands.")
1265(defalias 'ctl-x-5-prefix ctl-x-5-map) 1276(defalias 'ctl-x-5-prefix ctl-x-5-map)
1266(define-key ctl-x-map "5" 'ctl-x-5-prefix)
1267 1277
1268(defvar tab-prefix-map (make-sparse-keymap) 1278(defvar tab-prefix-map (make-sparse-keymap)
1269 "Keymap for tab-bar related commands.") 1279 "Keymap for tab-bar related commands.")
1270(define-key ctl-x-map "t" tab-prefix-map) 1280
1281(defvar ctl-x-map
1282 (let ((map (make-keymap)))
1283 (define-key map "4" 'ctl-x-4-prefix)
1284 (define-key map "5" 'ctl-x-5-prefix)
1285 (define-key map "t" tab-prefix-map)
1286
1287 (define-key map "b" #'switch-to-buffer)
1288 (define-key map "k" #'kill-buffer)
1289 (define-key map "\C-u" #'upcase-region) (put 'upcase-region 'disabled t)
1290 (define-key map "\C-l" #'downcase-region) (put 'downcase-region 'disabled t)
1291 (define-key map "<" #'scroll-left)
1292 (define-key map ">" #'scroll-right)
1293 map)
1294 "Default keymap for C-x commands.
1295The normal global definition of the character C-x indirects to this keymap.")
1296(fset 'Control-X-prefix ctl-x-map)
1297(make-obsolete 'Control-X-prefix 'ctl-x-map "28.1")
1298
1299(defvar global-map
1300 (let ((map (make-keymap)))
1301 (define-key map "\C-[" 'ESC-prefix)
1302 (define-key map "\C-x" 'Control-X-prefix)
1303
1304 (define-key map "\C-i" #'self-insert-command)
1305 (let* ((vec1 (make-vector 1 nil))
1306 (f (lambda (from to)
1307 (while (< from to)
1308 (aset vec1 0 from)
1309 (define-key map vec1 #'self-insert-command)
1310 (setq from (1+ from))))))
1311 (funcall f #o040 #o0177)
1312 (when (eq system-type 'ms-dos) ;FIXME: Why?
1313 (funcall f #o0200 #o0240))
1314 (funcall f #o0240 #o0400))
1315
1316 (define-key map "\C-a" #'beginning-of-line)
1317 (define-key map "\C-b" #'backward-char)
1318 (define-key map "\C-e" #'end-of-line)
1319 (define-key map "\C-f" #'forward-char)
1320
1321 (define-key map "\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
1322 (define-key map "\C-x\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
1323
1324 (define-key map "\C-v" #'scroll-up-command)
1325 (define-key map "\M-v" #'scroll-down-command)
1326 (define-key map "\M-\C-v" #'scroll-other-window)
1327
1328 (define-key map "\M-\C-c" #'exit-recursive-edit)
1329 (define-key map "\C-]" #'abort-recursive-edit)
1330 map)
1331 "Default global keymap mapping Emacs keyboard input into commands.
1332The value is a keymap that is usually (but not necessarily) Emacs's
1333global map.")
1334(use-global-map global-map)
1271 1335
1272 1336
1273;;;; Event manipulation functions. 1337;;;; Event manipulation functions.
@@ -1749,7 +1813,11 @@ unless HOOK has both local and global functions). If multiple
1749functions have the same representation under `princ', the first 1813functions have the same representation under `princ', the first
1750one will be removed." 1814one will be removed."
1751 (interactive 1815 (interactive
1752 (let* ((hook (intern (completing-read "Hook variable: " obarray #'boundp t))) 1816 (let* ((default (and (symbolp (variable-at-point))
1817 (symbol-name (variable-at-point))))
1818 (hook (intern (completing-read
1819 (format-prompt "Hook variable" default)
1820 obarray #'boundp t nil nil default)))
1753 (local 1821 (local
1754 (and 1822 (and
1755 (local-variable-p hook) 1823 (local-variable-p hook)
@@ -1806,9 +1874,33 @@ all symbols are bound before any of the VALUEFORMs are evalled."
1806 ;; As a special-form, we could implement it more efficiently (and cleanly, 1874 ;; As a special-form, we could implement it more efficiently (and cleanly,
1807 ;; making the vars actually unbound during evaluation of the binders). 1875 ;; making the vars actually unbound during evaluation of the binders).
1808 (declare (debug let) (indent 1)) 1876 (declare (debug let) (indent 1))
1809 `(let ,(mapcar #'car binders) 1877 ;; Use plain `let*' for the non-recursive definitions.
1810 ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) 1878 ;; This only handles the case where the first few definitions are not
1811 ,@body)) 1879 ;; recursive. Nothing as fancy as an SCC analysis.
1880 (let ((seqbinds nil))
1881 ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
1882 ;; may fail to see references that will be introduced later by
1883 ;; macroexpansion. We could call `macroexpand-all' to avoid that,
1884 ;; but in order to avoid that, we instead check to see if the binders
1885 ;; appear in the macroexp environment, since that's how references can be
1886 ;; introduced later on.
1887 (unless (macroexp--fgrep binders macroexpand-all-environment)
1888 (while (and binders
1889 (null (macroexp--fgrep binders (nth 1 (car binders)))))
1890 (push (pop binders) seqbinds)))
1891 (let ((nbody (if (null binders)
1892 (macroexp-progn body)
1893 `(let ,(mapcar #'car binders)
1894 ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
1895 ,@body))))
1896 (cond
1897 ;; All bindings are recursive.
1898 ((null seqbinds) nbody)
1899 ;; Special case for trivial uses.
1900 ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
1901 (nth 1 (car seqbinds)))
1902 ;; General case.
1903 (t `(let* ,(nreverse seqbinds) ,nbody))))))
1812 1904
1813(defmacro dlet (binders &rest body) 1905(defmacro dlet (binders &rest body)
1814 "Like `let*' but using dynamic scoping." 1906 "Like `let*' but using dynamic scoping."
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 935c97e2a41..7e556550daa 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -95,23 +95,26 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
95 :version "27.1") 95 :version "27.1")
96 96
97 97
98(define-minor-mode tab-bar-mode 98(defun tab-bar--define-keys ()
99 "Toggle the tab bar in all graphical frames (Tab Bar mode)." 99 "Install key bindings for switching between tabs if the user has configured them."
100 :global t 100 (when tab-bar-select-tab-modifiers
101 ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. 101 (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
102 :variable tab-bar-mode 102 'tab-bar-switch-to-recent-tab)
103 (let ((val (if tab-bar-mode 1 0))) 103 (dotimes (i 9)
104 (dolist (frame (frame-list)) 104 (global-set-key (vector (append tab-bar-select-tab-modifiers
105 (set-frame-parameter frame 'tab-bar-lines val)) 105 (list (+ i 1 ?0))))
106 ;; If the user has given `default-frame-alist' a `tab-bar-lines' 106 'tab-bar-select-tab)))
107 ;; parameter, replace it. 107 ;; Don't override user customized key bindings
108 (if (assq 'tab-bar-lines default-frame-alist) 108 (unless (global-key-binding [(control tab)])
109 (setq default-frame-alist 109 (global-set-key [(control tab)] 'tab-next))
110 (cons (cons 'tab-bar-lines val) 110 (unless (global-key-binding [(control shift tab)])
111 (assq-delete-all 'tab-bar-lines 111 (global-set-key [(control shift tab)] 'tab-previous))
112 default-frame-alist))))) 112 (unless (global-key-binding [(control shift iso-lefttab)])
113 113 (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
114 (when (and tab-bar-mode tab-bar-new-button 114
115(defun tab-bar--load-buttons ()
116 "Load the icons for the tab buttons."
117 (when (and tab-bar-new-button
115 (not (get-text-property 0 'display tab-bar-new-button))) 118 (not (get-text-property 0 'display tab-bar-new-button)))
116 ;; This file is pre-loaded so only here we can use the right data-directory: 119 ;; This file is pre-loaded so only here we can use the right data-directory:
117 (add-text-properties 0 (length tab-bar-new-button) 120 (add-text-properties 0 (length tab-bar-new-button)
@@ -121,7 +124,7 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
121 :ascent center)) 124 :ascent center))
122 tab-bar-new-button)) 125 tab-bar-new-button))
123 126
124 (when (and tab-bar-mode tab-bar-close-button 127 (when (and tab-bar-close-button
125 (not (get-text-property 0 'display tab-bar-close-button))) 128 (not (get-text-property 0 'display tab-bar-close-button)))
126 ;; This file is pre-loaded so only here we can use the right data-directory: 129 ;; This file is pre-loaded so only here we can use the right data-directory:
127 (add-text-properties 0 (length tab-bar-close-button) 130 (add-text-properties 0 (length tab-bar-close-button)
@@ -129,24 +132,27 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
129 :file "tabs/close.xpm" 132 :file "tabs/close.xpm"
130 :margin (2 . 0) 133 :margin (2 . 0)
131 :ascent center)) 134 :ascent center))
132 tab-bar-close-button)) 135 tab-bar-close-button)))
133 136
137(define-minor-mode tab-bar-mode
138 "Toggle the tab bar in all graphical frames (Tab Bar mode)."
139 :global t
140 ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
141 :variable tab-bar-mode
142 (let ((val (if tab-bar-mode 1 0)))
143 (dolist (frame (frame-list))
144 (set-frame-parameter frame 'tab-bar-lines val))
145 ;; If the user has given `default-frame-alist' a `tab-bar-lines'
146 ;; parameter, replace it.
147 (if (assq 'tab-bar-lines default-frame-alist)
148 (setq default-frame-alist
149 (cons (cons 'tab-bar-lines val)
150 (assq-delete-all 'tab-bar-lines
151 default-frame-alist)))))
152 (when tab-bar-mode
153 (tab-bar--load-buttons))
134 (if tab-bar-mode 154 (if tab-bar-mode
135 (progn 155 (tab-bar--define-keys)
136 (when tab-bar-select-tab-modifiers
137 (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
138 'tab-bar-switch-to-recent-tab)
139 (dotimes (i 9)
140 (global-set-key (vector (append tab-bar-select-tab-modifiers
141 (list (+ i 1 ?0))))
142 'tab-bar-select-tab)))
143 ;; Don't override user customized key bindings
144 (unless (global-key-binding [(control tab)])
145 (global-set-key [(control tab)] 'tab-next))
146 (unless (global-key-binding [(control shift tab)])
147 (global-set-key [(control shift tab)] 'tab-previous))
148 (unless (global-key-binding [(control shift iso-lefttab)])
149 (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
150 ;; Unset only keys bound by tab-bar 156 ;; Unset only keys bound by tab-bar
151 (when (eq (global-key-binding [(control tab)]) 'tab-next) 157 (when (eq (global-key-binding [(control tab)]) 'tab-next)
152 (global-unset-key [(control tab)])) 158 (global-unset-key [(control tab)]))
@@ -181,15 +187,27 @@ on a console which has no window system but does have a mouse."
181 ;; Clicking anywhere outside existing tabs will add a new tab 187 ;; Clicking anywhere outside existing tabs will add a new tab
182 (tab-bar-new-tab))))) 188 (tab-bar-new-tab)))))
183 189
184;; Used in the Show/Hide menu, to have the toggle reflect the current frame.
185(defun toggle-tab-bar-mode-from-frame (&optional arg) 190(defun toggle-tab-bar-mode-from-frame (&optional arg)
186 "Toggle tab bar on or off, based on the status of the current frame. 191 "Toggle tab bar on or off, based on the status of the current frame.
192Used in the Show/Hide menu, to have the toggle reflect the current frame.
187See `tab-bar-mode' for more information." 193See `tab-bar-mode' for more information."
188 (interactive (list (or current-prefix-arg 'toggle))) 194 (interactive (list (or current-prefix-arg 'toggle)))
189 (if (eq arg 'toggle) 195 (if (eq arg 'toggle)
190 (tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1)) 196 (tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1))
191 (tab-bar-mode arg))) 197 (tab-bar-mode arg)))
192 198
199(defun toggle-frame-tab-bar (&optional frame)
200 "Toggle tab bar of FRAME.
201This is useful when you want to enable the tab bar individually
202on each new frame when the global `tab-bar-mode' is disabled,
203or when you want to disable the tab bar individually on each
204new frame when the global `tab-bar-mode' is enabled, by using
205
206 (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
207 (interactive)
208 (set-frame-parameter frame 'tab-bar-lines
209 (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)))
210
193(defvar tab-bar-map (make-sparse-keymap) 211(defvar tab-bar-map (make-sparse-keymap)
194 "Keymap for the tab bar. 212 "Keymap for the tab bar.
195Define this locally to override the global tab bar.") 213Define this locally to override the global tab bar.")
@@ -218,18 +236,31 @@ If the value is `1', then hide the tab bar when it has only one tab,
218and show it again once more tabs are created. 236and show it again once more tabs are created.
219If nil, always keep the tab bar hidden. In this case it's still 237If nil, always keep the tab bar hidden. In this case it's still
220possible to use persistent named window configurations by relying on 238possible to use persistent named window configurations by relying on
221keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc." 239keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc.
240
241Setting this variable directly does not take effect; please customize
242it (see the info node `Easy Customization'), then it will automatically
243update the tab bar on all frames according to the new value.
244
245To enable or disable the tab bar individually on each frame,
246you can use the command `toggle-frame-tab-bar'."
222 :type '(choice (const :tag "Always" t) 247 :type '(choice (const :tag "Always" t)
223 (const :tag "When more than one tab" 1) 248 (const :tag "When more than one tab" 1)
224 (const :tag "Never" nil)) 249 (const :tag "Never" nil))
225 :initialize 'custom-initialize-default 250 :initialize 'custom-initialize-default
226 :set (lambda (sym val) 251 :set (lambda (sym val)
227 (set-default sym val) 252 (set-default sym val)
228 (tab-bar-mode 253 ;; Preload button images
229 (if (or (eq val t) 254 (tab-bar-mode 1)
230 (and (natnump val) 255 ;; Then handle each frame individually
231 (> (length (funcall tab-bar-tabs-function)) val))) 256 (dolist (frame (frame-list))
232 1 -1))) 257 (set-frame-parameter
258 frame 'tab-bar-lines
259 (if (or (eq val t)
260 (and (natnump val)
261 (> (length (funcall tab-bar-tabs-function frame))
262 val)))
263 1 0))))
233 :group 'tab-bar 264 :group 'tab-bar
234 :version "27.1") 265 :version "27.1")
235 266
@@ -418,6 +449,30 @@ Return its existing value or a new value."
418 tabs)) 449 tabs))
419 450
420 451
452(defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default
453 "Function to format a tab name.
454Function gets two arguments, the tab and its number, and should return
455the formatted tab name to display in the tab bar."
456 :type 'function
457 :initialize 'custom-initialize-default
458 :set (lambda (sym val)
459 (set-default sym val)
460 (force-mode-line-update))
461 :group 'tab-bar
462 :version "28.1")
463
464(defun tab-bar-tab-name-format-default (tab i)
465 (let ((current-p (eq (car tab) 'current-tab)))
466 (propertize
467 (concat (if tab-bar-tab-hints (format "%d " i) "")
468 (alist-get 'name tab)
469 (or (and tab-bar-close-button-show
470 (not (eq tab-bar-close-button-show
471 (if current-p 'non-selected 'selected)))
472 tab-bar-close-button)
473 ""))
474 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive))))
475
421(defun tab-bar-make-keymap-1 () 476(defun tab-bar-make-keymap-1 ()
422 "Generate an actual keymap from `tab-bar-map', without caching." 477 "Generate an actual keymap from `tab-bar-map', without caching."
423 (let* ((separator (or tab-bar-separator (if window-system " " "|"))) 478 (let* ((separator (or tab-bar-separator (if window-system " " "|")))
@@ -443,25 +498,13 @@ Return its existing value or a new value."
443 ((eq (car tab) 'current-tab) 498 ((eq (car tab) 'current-tab)
444 `((current-tab 499 `((current-tab
445 menu-item 500 menu-item
446 ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "") 501 ,(funcall tab-bar-tab-name-format-function tab i)
447 (alist-get 'name tab)
448 (or (and tab-bar-close-button-show
449 (not (eq tab-bar-close-button-show
450 'non-selected))
451 tab-bar-close-button) ""))
452 'face 'tab-bar-tab)
453 ignore 502 ignore
454 :help "Current tab"))) 503 :help "Current tab")))
455 (t 504 (t
456 `((,(intern (format "tab-%i" i)) 505 `((,(intern (format "tab-%i" i))
457 menu-item 506 menu-item
458 ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "") 507 ,(funcall tab-bar-tab-name-format-function tab i)
459 (alist-get 'name tab)
460 (or (and tab-bar-close-button-show
461 (not (eq tab-bar-close-button-show
462 'selected))
463 tab-bar-close-button) ""))
464 'face 'tab-bar-tab-inactive)
465 ,(or 508 ,(or
466 (alist-get 'binding tab) 509 (alist-get 'binding tab)
467 `(lambda () 510 `(lambda ()
@@ -815,7 +858,10 @@ After the tab is created, the hooks in
815 ((and (natnump tab-bar-show) 858 ((and (natnump tab-bar-show)
816 (> (length (funcall tab-bar-tabs-function)) tab-bar-show) 859 (> (length (funcall tab-bar-tabs-function)) tab-bar-show)
817 (zerop (frame-parameter nil 'tab-bar-lines))) 860 (zerop (frame-parameter nil 'tab-bar-lines)))
818 (set-frame-parameter nil 'tab-bar-lines 1))) 861 (progn
862 (tab-bar--load-buttons)
863 (tab-bar--define-keys)
864 (set-frame-parameter nil 'tab-bar-lines 1))))
819 865
820 (force-mode-line-update) 866 (force-mode-line-update)
821 (unless tab-bar-mode 867 (unless tab-bar-mode
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 8d5cb191dd8..8ae58718e3f 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -1,4 +1,4 @@
1;;; common-win.el --- common part of handling window systems 1;;; common-win.el --- common part of handling window systems -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 1aeaffbbc01..740d0654a17 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -1,4 +1,4 @@
1;;; tty-colors.el --- color support for character terminals 1;;; tty-colors.el --- color support for character terminals -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1999-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index e9bef6ec801..3346c551d93 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,4 +1,4 @@
1;;; fill.el --- fill commands for Emacs 1;;; fill.el --- fill commands for Emacs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free 3;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free
4;; Software Foundation, Inc. 4;; Software Foundation, Inc.
@@ -40,13 +40,11 @@ Non-nil means changing indent doesn't end a paragraph.
40That mode can handle paragraphs with extra indentation on the first line, 40That mode can handle paragraphs with extra indentation on the first line,
41but it requires separator lines between paragraphs. 41but it requires separator lines between paragraphs.
42A value of nil means that any change in indentation starts a new paragraph." 42A value of nil means that any change in indentation starts a new paragraph."
43 :type 'boolean 43 :type 'boolean)
44 :group 'fill)
45 44
46(defcustom colon-double-space nil 45(defcustom colon-double-space nil
47 "Non-nil means put two spaces after a colon when filling." 46 "Non-nil means put two spaces after a colon when filling."
48 :type 'boolean 47 :type 'boolean)
49 :group 'fill)
50(put 'colon-double-space 'safe-local-variable 'booleanp) 48(put 'colon-double-space 'safe-local-variable 'booleanp)
51 49
52(defcustom fill-separate-heterogeneous-words-with-space nil 50(defcustom fill-separate-heterogeneous-words-with-space nil
@@ -56,7 +54,6 @@ the beginning of the next line when concatenating them for
56filling those lines. Whether to use a space depends on how the 54filling those lines. Whether to use a space depends on how the
57words are categorized." 55words are categorized."
58 :type 'boolean 56 :type 'boolean
59 :group 'fill
60 :version "26.1") 57 :version "26.1")
61 58
62(defvar fill-paragraph-function nil 59(defvar fill-paragraph-function nil
@@ -75,8 +72,7 @@ such as `fill-forward-paragraph-function'.")
75Kinsoku processing is designed to prevent certain characters from being 72Kinsoku processing is designed to prevent certain characters from being
76placed at the beginning or end of a line by filling. 73placed at the beginning or end of a line by filling.
77See the documentation of `kinsoku' for more information." 74See the documentation of `kinsoku' for more information."
78 :type 'boolean 75 :type 'boolean)
79 :group 'fill)
80 76
81(defun set-fill-prefix () 77(defun set-fill-prefix ()
82 "Set the fill prefix to the current line up to point. 78 "Set the fill prefix to the current line up to point.
@@ -96,8 +92,7 @@ reinserts the fill prefix in each resulting line."
96 92
97(defcustom adaptive-fill-mode t 93(defcustom adaptive-fill-mode t
98 "Non-nil means determine a paragraph's fill prefix from its text." 94 "Non-nil means determine a paragraph's fill prefix from its text."
99 :type 'boolean 95 :type 'boolean)
100 :group 'fill)
101 96
102(defcustom adaptive-fill-regexp 97(defcustom adaptive-fill-regexp
103 ;; Added `!' for doxygen comments starting with `//!' or `/*!'. 98 ;; Added `!' for doxygen comments starting with `//!' or `/*!'.
@@ -113,8 +108,7 @@ standard indentation for the whole paragraph.
113If the paragraph has just one line, the indentation is taken from that 108If the paragraph has just one line, the indentation is taken from that
114line, but in that case `adaptive-fill-first-line-regexp' also plays 109line, but in that case `adaptive-fill-first-line-regexp' also plays
115a role." 110a role."
116 :type 'regexp 111 :type 'regexp)
117 :group 'fill)
118 112
119(defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'") 113(defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'")
120 "Regexp specifying whether to set fill prefix from a one-line paragraph. 114 "Regexp specifying whether to set fill prefix from a one-line paragraph.
@@ -126,15 +120,13 @@ By default, this regexp matches sequences of just spaces and tabs.
126 120
127However, we never use a prefix from a one-line paragraph 121However, we never use a prefix from a one-line paragraph
128if it would act as a paragraph-starter on the second line." 122if it would act as a paragraph-starter on the second line."
129 :type 'regexp 123 :type 'regexp)
130 :group 'fill)
131 124
132(defcustom adaptive-fill-function #'ignore 125(defcustom adaptive-fill-function #'ignore
133 "Function to call to choose a fill prefix for a paragraph. 126 "Function to call to choose a fill prefix for a paragraph.
134A nil return value means the function has not determined the fill prefix." 127A nil return value means the function has not determined the fill prefix."
135 :version "27.1" 128 :version "27.1"
136 :type 'function 129 :type 'function)
137 :group 'fill)
138 130
139(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. 131(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
140 "Whether or not filling should try to use the major mode's indentation.") 132 "Whether or not filling should try to use the major mode's indentation.")
@@ -367,15 +359,13 @@ which is an error according to some typographical conventions."
367The predicates are called with no arguments, with point at the place to 359The predicates are called with no arguments, with point at the place to
368be tested. If it returns a non-nil value, fill commands do not break 360be tested. If it returns a non-nil value, fill commands do not break
369the line there." 361the line there."
370 :group 'fill
371 :type 'hook 362 :type 'hook
372 :options '(fill-french-nobreak-p fill-single-word-nobreak-p 363 :options '(fill-french-nobreak-p fill-single-word-nobreak-p
373 fill-single-char-nobreak-p)) 364 fill-single-char-nobreak-p))
374 365
375(defcustom fill-nobreak-invisible nil 366(defcustom fill-nobreak-invisible nil
376 "Non-nil means that fill commands do not break lines in invisible text." 367 "Non-nil means that fill commands do not break lines in invisible text."
377 :type 'boolean 368 :type 'boolean)
378 :group 'fill)
379 369
380(defun fill-nobreak-p () 370(defun fill-nobreak-p ()
381 "Return nil if breaking the line at point is allowed. 371 "Return nil if breaking the line at point is allowed.
@@ -1110,8 +1100,7 @@ The `justification' text-property can locally override this variable."
1110 (const full) 1100 (const full)
1111 (const center) 1101 (const center)
1112 (const none)) 1102 (const none))
1113 :safe 'symbolp 1103 :safe 'symbolp)
1114 :group 'fill)
1115(make-variable-buffer-local 'default-justification) 1104(make-variable-buffer-local 'default-justification)
1116 1105
1117(defun current-justification () 1106(defun current-justification ()
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 217ae10fe4d..96edfd6de36 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -371,50 +371,33 @@ See `forward-paragraph' for more information."
371 371
372(defun mark-paragraph (&optional arg allow-extend) 372(defun mark-paragraph (&optional arg allow-extend)
373 "Put point at beginning of this paragraph, mark at end. 373 "Put point at beginning of this paragraph, mark at end.
374The paragraph marked is the one that contains point or follows 374The paragraph marked is the one that contains point or follows point.
375point.
376 375
377With argument ARG, puts mark at the end of this or a following 376With argument ARG, puts mark at end of a following paragraph, so that
378paragraph, so that the number of paragraphs marked equals ARG. 377the number of paragraphs marked equals ARG.
379 378
380If ARG is negative, point is put at the end of this paragraph, 379If ARG is negative, point is put at end of this paragraph, mark is put
381mark is put at the beginning of this or a previous paragraph. 380at beginning of this or a previous paragraph.
382 381
383Interactively (or if ALLOW-EXTEND is non-nil), if this command is 382Interactively (or if ALLOW-EXTEND is non-nil), if this command is
384repeated or (in Transient Mark mode) if the mark is active, it 383repeated or (in Transient Mark mode) if the mark is active,
385marks the next ARG paragraphs after the region already marked. 384it marks the next ARG paragraphs after the ones already marked."
386This also means when activating the mark immediately before using 385 (interactive "p\np")
387this command, the current paragraph is only marked from point." 386 (unless arg (setq arg 1))
388 (interactive "P\np") 387 (when (zerop arg)
389 (let ((numeric-arg (prefix-numeric-value arg))) 388 (error "Cannot mark zero paragraphs"))
390 (cond ((zerop numeric-arg)) 389 (cond ((and allow-extend
391 ((and allow-extend 390 (or (and (eq last-command this-command) (mark t))
392 (or (and (eq last-command this-command) mark-active) 391 (and transient-mark-mode mark-active)))
393 (region-active-p))) 392 (set-mark
394 (if arg 393 (save-excursion
395 (setq arg numeric-arg) 394 (goto-char (mark))
396 (if (< (mark) (point)) 395 (forward-paragraph arg)
397 (setq arg -1) 396 (point))))
398 (setq arg 1))) 397 (t
399 (set-mark 398 (forward-paragraph arg)
400 (save-excursion 399 (push-mark nil t t)
401 (goto-char (mark)) 400 (backward-paragraph arg))))
402 (forward-paragraph arg)
403 (point))))
404 ;; don't activate the mark when at eob
405 ((and (eobp) (> numeric-arg 0)))
406 (t
407 (unless (save-excursion
408 (forward-line 0)
409 (looking-at paragraph-start))
410 (backward-paragraph (cond ((> numeric-arg 0) 1)
411 ((< numeric-arg 0) -1)
412 (t 0))))
413 (push-mark
414 (save-excursion
415 (forward-paragraph numeric-arg)
416 (point))
417 t t)))))
418 401
419(defun kill-paragraph (arg) 402(defun kill-paragraph (arg)
420 "Kill forward to end of paragraph. 403 "Kill forward to end of paragraph.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 073059d52e8..d4c1b87262e 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -906,7 +906,8 @@ DOWNCASE t: Downcase words before using them."
906 ;; begin, optional spaces and opening brace 906 ;; begin, optional spaces and opening brace
907 "begin[[:space:]]*{" 907 "begin[[:space:]]*{"
908 ;; Build a regexp for env names 908 ;; Build a regexp for env names
909 (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray")) 909 (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
910 "darray" "frame"))
910 ;; closing brace, optional spaces 911 ;; closing brace, optional spaces
911 "}[[:space:]]*" 912 "}[[:space:]]*"
912 ;; Now for macros 913 ;; Now for macros
@@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them."
919 "\\[[^][]*" 920 "\\[[^][]*"
920 ;; Allow nested levels of chars enclosed in braces 921 ;; Allow nested levels of chars enclosed in braces
921 "\\(?:{[^}{]*" 922 "\\(?:{[^}{]*"
922 "\\(?:{[^}{]*" 923 "\\(?:{[^}{]*"
923 "\\(?:{[^}{]*}[^}{]*\\)*" 924 "\\(?:{[^}{]*}[^}{]*\\)*"
924 "}[^}{]*\\)*" 925 "}[^}{]*\\)*"
925 "}[^][]*\\)*" 926 "}[^][]*\\)*"
926 ;; Match the label key 927 ;; Match the label key
927 "\\<label[[:space:]]*=[[:space:]]*" 928 "\\<label[[:space:]]*=[[:space:]]*"
@@ -944,7 +945,7 @@ you have to define it using \\(?1:...\\) when adding new regexps.
944When changed from Lisp, make sure to call 945When changed from Lisp, make sure to call
945`reftex-compile-variables' afterwards to make the change 946`reftex-compile-variables' afterwards to make the change
946effective." 947effective."
947 :version "27.1" 948 :version "28.1"
948 :set (lambda (symbol value) 949 :set (lambda (symbol value)
949 (set symbol value) 950 (set symbol value)
950 (when (fboundp 'reftex-compile-variables) 951 (when (fboundp 'reftex-compile-variables)
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 3da24c85c85..9ef2da737a4 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -1,4 +1,4 @@
1;;; w32-fns.el --- Lisp routines for 32-bit Windows 1;;; w32-fns.el --- Lisp routines for 32-bit Windows -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -383,10 +383,10 @@ for any permissions.
383 383
384This is required because the Windows build environment is not required 384This is required because the Windows build environment is not required
385to include Sed, which is used by leim/Makefile.in to do the job." 385to include Sed, which is used by leim/Makefile.in to do the job."
386 (find-file orig) 386 (with-current-buffer (find-file-noselect orig)
387 (goto-char (point-max)) 387 (goto-char (point-max))
388 (insert-file-contents extra) 388 (insert-file-contents extra)
389 (delete-matching-lines "^$\\|^;") 389 (delete-matching-lines "^$\\|^;")
390 (save-buffers-kill-emacs t)) 390 (save-buffers-kill-emacs t)))
391 391
392;;; w32-fns.el ends here 392;;; w32-fns.el ends here
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index f920130226e..8b10d71dcb3 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1204,7 +1204,6 @@ This is much faster.")
1204ARG may be negative to move backward. 1204ARG may be negative to move backward.
1205When the second optional argument is non-nil, 1205When the second optional argument is non-nil,
1206nothing is shown in the echo area." 1206nothing is shown in the echo area."
1207 (or (bobp) (> arg 0) (backward-char))
1208 (let ((wrapped 0) 1207 (let ((wrapped 0)
1209 (number arg) 1208 (number arg)
1210 (old (widget-tabable-at))) 1209 (old (widget-tabable-at)))
diff --git a/lisp/widget.el b/lisp/widget.el
index de690ad225d..401b4cf298f 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -1,4 +1,4 @@
1;;; widget.el --- a library of user interface components 1;;; widget.el --- a library of user interface components -*- lexical-binding: t; -*-
2;; 2;;
3;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
4;; 4;;
diff --git a/lisp/window.el b/lisp/window.el
index cd13e6603a5..38be7789062 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -7243,6 +7243,7 @@ The actual non-nil value of this variable will be copied to the
7243 (const display-buffer-below-selected) 7243 (const display-buffer-below-selected)
7244 (const display-buffer-at-bottom) 7244 (const display-buffer-at-bottom)
7245 (const display-buffer-in-previous-window) 7245 (const display-buffer-in-previous-window)
7246 (const display-buffer-use-least-recent-window)
7246 (const display-buffer-use-some-window) 7247 (const display-buffer-use-some-window)
7247 (const display-buffer-use-some-frame) 7248 (const display-buffer-use-some-frame)
7248 (function :tag "Other function")) 7249 (function :tag "Other function"))
@@ -7378,6 +7379,37 @@ fails, call `display-buffer-pop-up-frame'.")
7378 7379
7379(defun display-buffer (buffer-or-name &optional action frame) 7380(defun display-buffer (buffer-or-name &optional action frame)
7380 "Display BUFFER-OR-NAME in some window, without selecting it. 7381 "Display BUFFER-OR-NAME in some window, without selecting it.
7382To change which window is used, set `display-buffer-alist'
7383to an expression containing one of these \"action\" functions:
7384
7385 `display-buffer-same-window' -- Use the selected window.
7386 `display-buffer-reuse-window' -- Use a window already showing
7387 the buffer.
7388 `display-buffer-in-previous-window' -- Use a window that did
7389 show the buffer before.
7390 `display-buffer-use-some-window' -- Use some existing window.
7391 `display-buffer-use-least-recent-window' -- Try to avoid re-using
7392 windows that have recently been switched to.
7393 `display-buffer-pop-up-window' -- Pop up a new window.
7394 `display-buffer-below-selected' -- Use or pop up a window below
7395 the selected one.
7396 `display-buffer-at-bottom' -- Use or pop up a window at the
7397 bottom of the selected frame.
7398 `display-buffer-pop-up-frame' -- Show the buffer on a new frame.
7399 `display-buffer-in-child-frame' -- Show the buffer in a
7400 child frame.
7401 `display-buffer-no-window' -- Do not display the buffer and
7402 have `display-buffer' return nil immediately.
7403
7404For instance:
7405
7406 (setq display-buffer-alist '((\".*\" display-buffer-at-bottom)))
7407
7408Buffer display can be further customized to a very high degree;
7409the rest of this docstring explains some of the many
7410possibilities, and also see `(emacs)Window Choice' for more
7411information.
7412
7381BUFFER-OR-NAME must be a buffer or a string naming a live buffer. 7413BUFFER-OR-NAME must be a buffer or a string naming a live buffer.
7382Return the window chosen for displaying that buffer, or nil if no 7414Return the window chosen for displaying that buffer, or nil if no
7383such window is found. 7415such window is found.
@@ -7403,23 +7435,8 @@ function in the combined function list in turn, passing the
7403buffer as the first argument and the combined action alist as the 7435buffer as the first argument and the combined action alist as the
7404second argument, until one of the functions returns non-nil. 7436second argument, until one of the functions returns non-nil.
7405 7437
7406Action functions and the action they try to perform are: 7438See above for the action functions and the action they try to
7407 `display-buffer-same-window' -- Use the selected window. 7439perform.
7408 `display-buffer-reuse-window' -- Use a window already showing
7409 the buffer.
7410 `display-buffer-in-previous-window' -- Use a window that did
7411 show the buffer before.
7412 `display-buffer-use-some-window' -- Use some existing window.
7413 `display-buffer-pop-up-window' -- Pop up a new window.
7414 `display-buffer-below-selected' -- Use or pop up a window below
7415 the selected one.
7416 `display-buffer-at-bottom' -- Use or pop up a window at the
7417 bottom of the selected frame.
7418 `display-buffer-pop-up-frame' -- Show the buffer on a new frame.
7419 `display-buffer-in-child-frame' -- Show the buffer in a
7420 child frame.
7421 `display-buffer-no-window' -- Do not display the buffer and
7422 have `display-buffer' return nil immediately.
7423 7440
7424Action alist entries are: 7441Action alist entries are:
7425 `inhibit-same-window' -- A non-nil value prevents the same 7442 `inhibit-same-window' -- A non-nil value prevents the same
@@ -8242,6 +8259,16 @@ indirectly called by the latter."
8242 (when (setq window (or best-window second-best-window)) 8259 (when (setq window (or best-window second-best-window))
8243 (window--display-buffer buffer window 'reuse alist)))) 8260 (window--display-buffer buffer window 'reuse alist))))
8244 8261
8262(defun display-buffer-use-least-recent-window (buffer alist)
8263 "Display BUFFER in an existing window, but that hasn't been used lately.
8264This `display-buffer' action function is like
8265`display-buffer-use-some-window', but will cycle through windows
8266when displaying buffers repeatedly, and if there's only a single
8267window, it will split the window."
8268 (when-let ((window (display-buffer-use-some-window
8269 buffer (cons (cons 'inhibit-same-window t) alist))))
8270 (window-bump-use-time window)))
8271
8245(defun display-buffer-use-some-window (buffer alist) 8272(defun display-buffer-use-some-window (buffer alist)
8246 "Display BUFFER in an existing window. 8273 "Display BUFFER in an existing window.
8247Search for a usable window, set that window to the buffer, and 8274Search for a usable window, set that window to the buffer, and
diff --git a/src/buffer.c b/src/buffer.c
index 81f7d922fdb..71ad5edd527 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2602,8 +2602,6 @@ current buffer is cleared. */)
2602 p += bytes, pos += bytes; 2602 p += bytes, pos += bytes;
2603 } 2603 }
2604 } 2604 }
2605 if (narrowed)
2606 Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
2607 } 2605 }
2608 else 2606 else
2609 { 2607 {
@@ -2682,9 +2680,6 @@ current buffer is cleared. */)
2682 if (pt != PT) 2680 if (pt != PT)
2683 TEMP_SET_PT (pt); 2681 TEMP_SET_PT (pt);
2684 2682
2685 if (narrowed)
2686 Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
2687
2688 /* Do this first, so that chars_in_text asks the right question. 2683 /* Do this first, so that chars_in_text asks the right question.
2689 set_intervals_multibyte needs it too. */ 2684 set_intervals_multibyte needs it too. */
2690 bset_enable_multibyte_characters (current_buffer, Qt); 2685 bset_enable_multibyte_characters (current_buffer, Qt);
@@ -6385,10 +6380,3 @@ nil NORECORD argument since it may lead to infinite recursion. */);
6385 6380
6386 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); 6381 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6387} 6382}
6388
6389void
6390keys_of_buffer (void)
6391{
6392 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6393 initial_define_key (control_x_map, 'k', "kill-buffer");
6394}
diff --git a/src/callproc.c b/src/callproc.c
index 8d2a5619eb8..1da315bef18 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -314,6 +314,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
314#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ 314#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
315 char *tempfile = NULL; 315 char *tempfile = NULL;
316#else 316#else
317 sigset_t oldset;
317 pid_t pid = -1; 318 pid_t pid = -1;
318#endif 319#endif
319 int child_errno; 320 int child_errno;
@@ -601,9 +602,12 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
601 602
602#ifndef MSDOS 603#ifndef MSDOS
603 604
605 block_input ();
606 block_child_signal (&oldset);
607
604 child_errno 608 child_errno
605 = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env, 609 = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
606 SSDATA (current_dir), NULL); 610 SSDATA (current_dir), NULL, &oldset);
607 eassert ((child_errno == 0) == (0 < pid)); 611 eassert ((child_errno == 0) == (0 < pid));
608 612
609 if (pid > 0) 613 if (pid > 0)
@@ -624,6 +628,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
624 } 628 }
625 } 629 }
626 630
631 unblock_child_signal (&oldset);
632 unblock_input ();
633
627 if (pid < 0) 634 if (pid < 0)
628 report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno); 635 report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
629 636
@@ -1227,17 +1234,21 @@ child_setup (int in, int out, int err, char **new_argv, char **env,
1227 process image file ARGV[0]. Use ENVP for the environment block for 1234 process image file ARGV[0]. Use ENVP for the environment block for
1228 the new process. Use CWD as working directory for the new process. 1235 the new process. Use CWD as working directory for the new process.
1229 If PTY is not NULL, it must be a pseudoterminal device. If PTY is 1236 If PTY is not NULL, it must be a pseudoterminal device. If PTY is
1230 NULL, don't perform any terminal setup. */ 1237 NULL, don't perform any terminal setup. OLDSET must be a pointer
1238 to a signal set initialized by `block_child_signal'. Before
1239 calling this function, call `block_input' and `block_child_signal';
1240 afterwards, call `unblock_input' and `unblock_child_signal'. Be
1241 sure to call `unblock_child_signal' only after registering NEWPID
1242 in a list where `handle_child_signal' can find it! */
1231 1243
1232int 1244int
1233emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, 1245emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1234 char **argv, char **envp, const char *cwd, const char *pty) 1246 char **argv, char **envp, const char *cwd,
1247 const char *pty, const sigset_t *oldset)
1235{ 1248{
1236 sigset_t oldset;
1237 int pid; 1249 int pid;
1238 1250
1239 block_input (); 1251 eassert (input_blocked_p ());
1240 block_child_signal (&oldset);
1241 1252
1242#ifndef WINDOWSNT 1253#ifndef WINDOWSNT
1243 /* vfork, and prevent local vars from being clobbered by the vfork. */ 1254 /* vfork, and prevent local vars from being clobbered by the vfork. */
@@ -1249,6 +1260,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1249 int volatile stdout_volatile = std_out; 1260 int volatile stdout_volatile = std_out;
1250 int volatile stderr_volatile = std_err; 1261 int volatile stderr_volatile = std_err;
1251 char **volatile envp_volatile = envp; 1262 char **volatile envp_volatile = envp;
1263 const sigset_t *volatile oldset_volatile = oldset;
1252 1264
1253#ifdef DARWIN_OS 1265#ifdef DARWIN_OS
1254 /* Darwin doesn't let us run setsid after a vfork, so use fork when 1266 /* Darwin doesn't let us run setsid after a vfork, so use fork when
@@ -1270,6 +1282,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1270 std_out = stdout_volatile; 1282 std_out = stdout_volatile;
1271 std_err = stderr_volatile; 1283 std_err = stderr_volatile;
1272 envp = envp_volatile; 1284 envp = envp_volatile;
1285 oldset = oldset_volatile;
1273 1286
1274 if (pid == 0) 1287 if (pid == 0)
1275#endif /* not WINDOWSNT */ 1288#endif /* not WINDOWSNT */
@@ -1364,7 +1377,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1364#endif 1377#endif
1365 1378
1366 /* Stop blocking SIGCHLD in the child. */ 1379 /* Stop blocking SIGCHLD in the child. */
1367 unblock_child_signal (&oldset); 1380 unblock_child_signal (oldset);
1368 1381
1369 if (pty_flag) 1382 if (pty_flag)
1370 child_setup_tty (std_out); 1383 child_setup_tty (std_out);
@@ -1382,10 +1395,6 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1382 1395
1383 int vfork_error = pid < 0 ? errno : 0; 1396 int vfork_error = pid < 0 ? errno : 0;
1384 1397
1385 /* Stop blocking in the parent. */
1386 unblock_child_signal (&oldset);
1387 unblock_input ();
1388
1389 if (pid < 0) 1398 if (pid < 0)
1390 { 1399 {
1391 eassert (0 < vfork_error); 1400 eassert (0 < vfork_error);
diff --git a/src/casefiddle.c b/src/casefiddle.c
index a948bb3bc88..a7a25414909 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -682,16 +682,3 @@ Called with one argument METHOD which can be:
682 defsubr (&Sdowncase_word); 682 defsubr (&Sdowncase_word);
683 defsubr (&Scapitalize_word); 683 defsubr (&Scapitalize_word);
684} 684}
685
686void
687keys_of_casefiddle (void)
688{
689 initial_define_key (control_x_map, Ctl ('U'), "upcase-region");
690 Fput (intern ("upcase-region"), Qdisabled, Qt);
691 initial_define_key (control_x_map, Ctl ('L'), "downcase-region");
692 Fput (intern ("downcase-region"), Qdisabled, Qt);
693
694 initial_define_key (meta_map, 'u', "upcase-word");
695 initial_define_key (meta_map, 'l', "downcase-word");
696 initial_define_key (meta_map, 'c', "capitalize-word");
697}
diff --git a/src/cmds.c b/src/cmds.c
index 798fd68a920..1547db80e88 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -529,24 +529,3 @@ This is run after inserting the character. */);
529 defsubr (&Sdelete_char); 529 defsubr (&Sdelete_char);
530 defsubr (&Sself_insert_command); 530 defsubr (&Sself_insert_command);
531} 531}
532
533void
534keys_of_cmds (void)
535{
536 int n;
537
538 initial_define_key (global_map, Ctl ('I'), "self-insert-command");
539 for (n = 040; n < 0177; n++)
540 initial_define_key (global_map, n, "self-insert-command");
541#ifdef MSDOS
542 for (n = 0200; n < 0240; n++)
543 initial_define_key (global_map, n, "self-insert-command");
544#endif
545 for (n = 0240; n < 0400; n++)
546 initial_define_key (global_map, n, "self-insert-command");
547
548 initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
549 initial_define_key (global_map, Ctl ('B'), "backward-char");
550 initial_define_key (global_map, Ctl ('E'), "end-of-line");
551 initial_define_key (global_map, Ctl ('F'), "forward-char");
552}
diff --git a/src/commands.h b/src/commands.h
index a09858d050d..2205ebf7d39 100644
--- a/src/commands.h
+++ b/src/commands.h
@@ -23,14 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
23 23
24#define Ctl(c) ((c)&037) 24#define Ctl(c) ((c)&037)
25 25
26/* Define the names of keymaps, just so people can refer to them in
27 calls to initial_define_key. These should *not* be used after
28 initialization; use-global-map doesn't affect these; it sets
29 current_global_map instead. */
30extern Lisp_Object global_map;
31extern Lisp_Object meta_map;
32extern Lisp_Object control_x_map;
33
34/* If not Qnil, this is a switch-frame event which we decided to put 26/* If not Qnil, this is a switch-frame event which we decided to put
35 off until the end of a key sequence. This should be read as the 27 off until the end of a key sequence. This should be read as the
36 next command input, after any Vunread_command_events. 28 next command input, after any Vunread_command_events.
diff --git a/src/emacs.c b/src/emacs.c
index 61d2023b4da..461d1b72e4c 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1969,12 +1969,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1969 syms_of_json (); 1969 syms_of_json ();
1970#endif 1970#endif
1971 1971
1972 keys_of_casefiddle ();
1973 keys_of_cmds ();
1974 keys_of_buffer ();
1975 keys_of_keyboard (); 1972 keys_of_keyboard ();
1976 keys_of_keymap ();
1977 keys_of_window ();
1978 } 1973 }
1979 else 1974 else
1980 { 1975 {
diff --git a/src/keyboard.c b/src/keyboard.c
index 2446f078fde..4540b3179b5 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -285,7 +285,7 @@ bool input_pending;
285 with the input rate, but if it can keep up just enough that there's no 285 with the input rate, but if it can keep up just enough that there's no
286 input_pending when we begin the command, then redisplay is not skipped 286 input_pending when we begin the command, then redisplay is not skipped
287 which results in better feedback to the user. */ 287 which results in better feedback to the user. */
288static bool input_was_pending; 288bool input_was_pending;
289 289
290/* Circular buffer for pre-read keyboard input. */ 290/* Circular buffer for pre-read keyboard input. */
291 291
@@ -12396,12 +12396,6 @@ syms_of_keyboard_for_pdumper (void)
12396void 12396void
12397keys_of_keyboard (void) 12397keys_of_keyboard (void)
12398{ 12398{
12399 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
12400 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
12401 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
12402 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
12403 initial_define_key (meta_map, 'x', "execute-extended-command");
12404
12405 initial_define_lispy_key (Vspecial_event_map, "delete-frame", 12399 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
12406 "handle-delete-frame"); 12400 "handle-delete-frame");
12407#ifdef HAVE_NTGUI 12401#ifdef HAVE_NTGUI
diff --git a/src/keyboard.h b/src/keyboard.h
index 91c6f4604f9..8bdffaa2bff 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -432,7 +432,7 @@ extern int parse_solitary_modifier (Lisp_Object symbol);
432extern Lisp_Object real_this_command; 432extern Lisp_Object real_this_command;
433 433
434extern int quit_char; 434extern int quit_char;
435 435extern bool input_was_pending;
436extern unsigned int timers_run; 436extern unsigned int timers_run;
437 437
438extern bool menu_separator_name_p (const char *); 438extern bool menu_separator_name_p (const char *);
diff --git a/src/keymap.c b/src/keymap.c
index 1eeea81f627..1197f6fd4a5 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -59,22 +59,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
59 59
60Lisp_Object current_global_map; /* Current global keymap. */ 60Lisp_Object current_global_map; /* Current global keymap. */
61 61
62Lisp_Object global_map; /* Default global key bindings. */
63
64Lisp_Object meta_map; /* The keymap used for globally bound
65 ESC-prefixed default commands. */
66
67Lisp_Object control_x_map; /* The keymap used for globally bound
68 C-x-prefixed default commands. */
69
70 /* The keymap used by the minibuf for local
71 bindings when spaces are allowed in the
72 minibuf. */
73
74 /* The keymap used by the minibuf for local
75 bindings when spaces are not encouraged
76 in the minibuf. */
77
78/* Alist of elements like (DEL . "\d"). */ 62/* Alist of elements like (DEL . "\d"). */
79static Lisp_Object exclude_keys; 63static Lisp_Object exclude_keys;
80 64
@@ -140,19 +124,6 @@ in case you use it as a menu with `x-popup-menu'. */)
140 return list1 (Qkeymap); 124 return list1 (Qkeymap);
141} 125}
142 126
143/* This function is used for installing the standard key bindings
144 at initialization time.
145
146 For example:
147
148 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
149
150void
151initial_define_key (Lisp_Object keymap, int key, const char *defname)
152{
153 store_in_keymap (keymap, make_fixnum (key), intern_c_string (defname));
154}
155
156void 127void
157initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname) 128initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
158{ 129{
@@ -1741,28 +1712,6 @@ bindings; see the description of `lookup-key' for more details about this. */)
1741 return Flist (j, maps); 1712 return Flist (j, maps);
1742} 1713}
1743 1714
1744DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1745 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1746A new sparse keymap is stored as COMMAND's function definition and its
1747value.
1748This prepares COMMAND for use as a prefix key's binding.
1749If a second optional argument MAPVAR is given, it should be a symbol.
1750The map is then stored as MAPVAR's value instead of as COMMAND's
1751value; but COMMAND is still defined as a function.
1752The third optional argument NAME, if given, supplies a menu name
1753string for the map. This is required to use the keymap as a menu.
1754This function returns COMMAND. */)
1755 (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
1756{
1757 Lisp_Object map = Fmake_sparse_keymap (name);
1758 Ffset (command, map);
1759 if (!NILP (mapvar))
1760 Fset (mapvar, map);
1761 else
1762 Fset (command, map);
1763 return command;
1764}
1765
1766DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, 1715DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1767 doc: /* Select KEYMAP as the global keymap. */) 1716 doc: /* Select KEYMAP as the global keymap. */)
1768 (Lisp_Object keymap) 1717 (Lisp_Object keymap)
@@ -2217,11 +2166,21 @@ See `text-char-description' for describing character codes. */)
2217 { 2166 {
2218 if (NILP (no_angles)) 2167 if (NILP (no_angles))
2219 { 2168 {
2220 Lisp_Object result; 2169 Lisp_Object namestr = SYMBOL_NAME (key);
2221 char *buffer = SAFE_ALLOCA (sizeof "<>" 2170 const char *sym = SSDATA (namestr);
2222 + SBYTES (SYMBOL_NAME (key))); 2171 ptrdiff_t len = SBYTES (namestr);
2223 esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key))); 2172 /* Find the extent of the modifier prefix, like "C-M-". */
2224 result = build_string (buffer); 2173 int i = 0;
2174 while (i < len - 3 && sym[i + 1] == '-' && strchr ("CMSsHA", sym[i]))
2175 i += 2;
2176 /* First I bytes of SYM are modifiers; put <> around the rest. */
2177 char *buffer = SAFE_ALLOCA (len + 3);
2178 memcpy (buffer, sym, i);
2179 buffer[i] = '<';
2180 memcpy (buffer + i + 1, sym + i, len - i);
2181 buffer [len + 1] = '>';
2182 buffer [len + 2] = '\0';
2183 Lisp_Object result = build_string (buffer);
2225 SAFE_FREE (); 2184 SAFE_FREE ();
2226 return result; 2185 return result;
2227 } 2186 }
@@ -3195,21 +3154,9 @@ syms_of_keymap (void)
3195 Each one is the value of a Lisp variable, and is also 3154 Each one is the value of a Lisp variable, and is also
3196 pointed to by a C variable */ 3155 pointed to by a C variable */
3197 3156
3198 global_map = Fmake_keymap (Qnil); 3157 current_global_map = Qnil;
3199 Fset (intern_c_string ("global-map"), global_map);
3200
3201 current_global_map = global_map;
3202 staticpro (&global_map);
3203 staticpro (&current_global_map); 3158 staticpro (&current_global_map);
3204 3159
3205 meta_map = Fmake_keymap (Qnil);
3206 Fset (intern_c_string ("esc-map"), meta_map);
3207 Ffset (intern_c_string ("ESC-prefix"), meta_map);
3208
3209 control_x_map = Fmake_keymap (Qnil);
3210 Fset (intern_c_string ("ctl-x-map"), control_x_map);
3211 Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3212
3213 exclude_keys = pure_list 3160 exclude_keys = pure_list
3214 (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), 3161 (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
3215 pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), 3162 pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
@@ -3311,7 +3258,6 @@ be preferred. */);
3311 defsubr (&Sminor_mode_key_binding); 3258 defsubr (&Sminor_mode_key_binding);
3312 defsubr (&Sdefine_key); 3259 defsubr (&Sdefine_key);
3313 defsubr (&Slookup_key); 3260 defsubr (&Slookup_key);
3314 defsubr (&Sdefine_prefix_command);
3315 defsubr (&Suse_global_map); 3261 defsubr (&Suse_global_map);
3316 defsubr (&Suse_local_map); 3262 defsubr (&Suse_local_map);
3317 defsubr (&Scurrent_local_map); 3263 defsubr (&Scurrent_local_map);
@@ -3328,10 +3274,3 @@ be preferred. */);
3328 defsubr (&Swhere_is_internal); 3274 defsubr (&Swhere_is_internal);
3329 defsubr (&Sdescribe_buffer_bindings); 3275 defsubr (&Sdescribe_buffer_bindings);
3330} 3276}
3331
3332void
3333keys_of_keymap (void)
3334{
3335 initial_define_key (global_map, 033, "ESC-prefix");
3336 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
3337}
diff --git a/src/keymap.h b/src/keymap.h
index 072c09348e2..f417301c8f2 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -37,10 +37,8 @@ extern char *push_key_description (EMACS_INT, char *);
37extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); 37extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
38extern Lisp_Object get_keymap (Lisp_Object, bool, bool); 38extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
39extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **); 39extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
40extern void initial_define_key (Lisp_Object, int, const char *);
41extern void initial_define_lispy_key (Lisp_Object, const char *, const char *); 40extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);
42extern void syms_of_keymap (void); 41extern void syms_of_keymap (void);
43extern void keys_of_keymap (void);
44 42
45typedef void (*map_keymap_function_t) 43typedef void (*map_keymap_function_t)
46 (Lisp_Object key, Lisp_Object val, Lisp_Object args, void *data); 44 (Lisp_Object key, Lisp_Object val, Lisp_Object args, void *data);
diff --git a/src/lisp.h b/src/lisp.h
index 0ad788cff84..d139df93424 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1478,8 +1478,8 @@ struct Lisp_String
1478 { 1478 {
1479 struct 1479 struct
1480 { 1480 {
1481 ptrdiff_t size; 1481 ptrdiff_t size; /* MSB is used as the markbit. */
1482 ptrdiff_t size_byte; 1482 ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */
1483 INTERVAL intervals; /* Text properties in this string. */ 1483 INTERVAL intervals; /* Text properties in this string. */
1484 unsigned char *data; 1484 unsigned char *data;
1485 } s; 1485 } s;
@@ -3561,7 +3561,6 @@ extern void swap_in_global_binding (struct Lisp_Symbol *);
3561 3561
3562/* Defined in cmds.c */ 3562/* Defined in cmds.c */
3563extern void syms_of_cmds (void); 3563extern void syms_of_cmds (void);
3564extern void keys_of_cmds (void);
3565 3564
3566/* Defined in coding.c. */ 3565/* Defined in coding.c. */
3567extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, 3566extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
@@ -4262,7 +4261,6 @@ extern Lisp_Object get_truename_buffer (Lisp_Object);
4262extern void init_buffer_once (void); 4261extern void init_buffer_once (void);
4263extern void init_buffer (void); 4262extern void init_buffer (void);
4264extern void syms_of_buffer (void); 4263extern void syms_of_buffer (void);
4265extern void keys_of_buffer (void);
4266 4264
4267/* Defined in marker.c. */ 4265/* Defined in marker.c. */
4268 4266
@@ -4359,7 +4357,6 @@ extern void syms_of_callint (void);
4359/* Defined in casefiddle.c. */ 4357/* Defined in casefiddle.c. */
4360 4358
4361extern void syms_of_casefiddle (void); 4359extern void syms_of_casefiddle (void);
4362extern void keys_of_casefiddle (void);
4363 4360
4364/* Defined in casetab.c. */ 4361/* Defined in casetab.c. */
4365 4362
@@ -4498,8 +4495,8 @@ extern void setup_process_coding_systems (Lisp_Object);
4498# define CHILD_SETUP_ERROR_DESC "Doing vfork" 4495# define CHILD_SETUP_ERROR_DESC "Doing vfork"
4499#endif 4496#endif
4500 4497
4501extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, 4498extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
4502 const char *); 4499 const char *, const char *, const sigset_t *);
4503extern char **make_environment_block (Lisp_Object); 4500extern char **make_environment_block (Lisp_Object);
4504extern void init_callproc_1 (void); 4501extern void init_callproc_1 (void);
4505extern void init_callproc (void); 4502extern void init_callproc (void);
diff --git a/src/minibuf.c b/src/minibuf.c
index 8b235690199..5ee440f6622 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -2013,9 +2013,6 @@ syms_of_minibuf (void)
2013 DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); 2013 DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
2014 DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); 2014 DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
2015 2015
2016 /* The maximum length of a minibuffer history. */
2017 DEFSYM (Qhistory_length, "history-length");
2018
2019 DEFSYM (Qcurrent_input_method, "current-input-method"); 2016 DEFSYM (Qcurrent_input_method, "current-input-method");
2020 DEFSYM (Qactivate_input_method, "activate-input-method"); 2017 DEFSYM (Qactivate_input_method, "activate-input-method");
2021 DEFSYM (Qcase_fold_search, "case-fold-search"); 2018 DEFSYM (Qcase_fold_search, "case-fold-search");
diff --git a/src/nsfns.m b/src/nsfns.m
index ee2daea0723..ae114f83e4d 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1485,14 +1485,14 @@ Some window managers may refuse to restack windows. */)
1485 1485
1486 if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2)) 1486 if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2))
1487 { 1487 {
1488 NSWindow *window = [FRAME_NS_VIEW (f1) window]; 1488 EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f1) window];
1489 NSInteger window2 = [[FRAME_NS_VIEW (f2) window] windowNumber]; 1489 NSWindow *window2 = [FRAME_NS_VIEW (f2) window];
1490 NSWindowOrderingMode flag = NILP (above) ? NSWindowBelow : NSWindowAbove; 1490 BOOL flag = !NILP (above);
1491 1491
1492 [window orderWindow: flag 1492 if ([window restackWindow:window2 above:!NILP (above)])
1493 relativeTo: window2]; 1493 return Qt;
1494 1494 else
1495 return Qt; 1495 return Qnil;
1496 } 1496 }
1497 else 1497 else
1498 { 1498 {
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 9b56958100a..8086f56854e 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -145,6 +145,10 @@ ns_update_menubar (struct frame *f, bool deep_p)
145 t = -(1000*tb.time+tb.millitm); 145 t = -(1000*tb.time+tb.millitm);
146#endif 146#endif
147 147
148#ifdef NS_IMPL_GNUSTEP
149 deep_p = 1; /* See comment in menuNeedsUpdate. */
150#endif
151
148 if (deep_p) 152 if (deep_p)
149 { 153 {
150 /* Make a widget-value tree representing the entire menu trees. */ 154 /* Make a widget-value tree representing the entire menu trees. */
@@ -433,21 +437,22 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
433} 437}
434 438
435 439
436/* Delegate method called when a submenu is being opened: run a 'deep' call 440/* Delegate method called when a submenu is being opened: run a 'deep'
437 to set_frame_menubar. */ 441 call to ns_update_menubar. */
438
439/* TODO: GNUstep calls this method when the menu is still being built
440 which throws it into an infinite loop. One possible solution is to
441 use menuWillOpen instead, but the Apple docs explicitly warn
442 against changing the contents of the menu in it. I don't know what
443 the right thing to do for GNUstep is. */
444- (void)menuNeedsUpdate: (NSMenu *)menu 442- (void)menuNeedsUpdate: (NSMenu *)menu
445{ 443{
446 if (!FRAME_LIVE_P (SELECTED_FRAME ())) 444 if (!FRAME_LIVE_P (SELECTED_FRAME ()))
447 return; 445 return;
448 446
447#ifdef NS_IMPL_COCOA
448/* TODO: GNUstep calls this method when the menu is still being built
449 which results in a recursive stack overflow. One possible solution
450 is to use menuWillOpen instead, but the Apple docs explicitly warn
451 against changing the contents of the menu in it. I don't know what
452 the right thing to do for GNUstep is. */
449 if (needsUpdate) 453 if (needsUpdate)
450 ns_update_menubar (SELECTED_FRAME (), true); 454 ns_update_menubar (SELECTED_FRAME (), true);
455#endif
451} 456}
452 457
453 458
diff --git a/src/nsterm.h b/src/nsterm.h
index 3fb64494f76..2c9d8e85ba9 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -498,6 +498,7 @@ typedef id instancetype;
498 NSPoint grabOffset; 498 NSPoint grabOffset;
499} 499}
500 500
501- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
501- (void)setAppearance; 502- (void)setAppearance;
502@end 503@end
503 504
diff --git a/src/nsterm.m b/src/nsterm.m
index 27310639508..2defb9e2eec 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -8693,6 +8693,112 @@ not_in_argv (NSString *arg)
8693 8693
8694@implementation EmacsWindow 8694@implementation EmacsWindow
8695 8695
8696/* It seems the only way to reorder child frames is by removing them
8697 from the parent and then reattaching them in the correct order. */
8698
8699- (void)orderFront:(id)sender
8700{
8701 NSTRACE ("[EmacsWindow orderFront:]");
8702
8703 NSWindow *parent = [self parentWindow];
8704 if (parent)
8705 {
8706 [parent removeChildWindow:self];
8707 [parent addChildWindow:self ordered:NSWindowAbove];
8708 }
8709 else
8710 [super orderFront:sender];
8711}
8712
8713- (void)makeKeyAndOrderFront:(id)sender
8714{
8715 NSTRACE ("[EmacsWindow makeKeyAndOrderFront:]");
8716
8717 if ([self parentWindow])
8718 {
8719 [self orderFront:sender];
8720 [self makeKeyWindow];
8721 }
8722 else
8723 [super makeKeyAndOrderFront:sender];
8724}
8725
8726
8727/* The array returned by [NSWindow parentWindow] may already be
8728 sorted, but the documentation doesn't tell us whether or not it is,
8729 so to be safe we'll sort it. */
8730NSInteger nswindow_orderedIndex_sort (id w1, id w2, void *c)
8731{
8732 NSInteger i1 = [w1 orderedIndex];
8733 NSInteger i2 = [w2 orderedIndex];
8734
8735 if (i1 > i2)
8736 return NSOrderedAscending;
8737 if (i1 < i2)
8738 return NSOrderedDescending;
8739
8740 return NSOrderedSame;
8741}
8742
8743- (void)orderBack:(id)sender
8744{
8745 NSTRACE ("[EmacsWindow orderBack:]");
8746
8747 NSWindow *parent = [self parentWindow];
8748 if (parent)
8749 {
8750 NSArray *children = [[parent childWindows]
8751 sortedArrayUsingFunction:nswindow_orderedIndex_sort
8752 context:nil];
8753 [parent removeChildWindow:self];
8754 [parent addChildWindow:self ordered:NSWindowAbove];
8755
8756 for (NSWindow *win in children)
8757 {
8758 if (win != self)
8759 {
8760 [parent removeChildWindow:win];
8761 [parent addChildWindow:win ordered:NSWindowAbove];
8762 }
8763 }
8764 }
8765 else
8766 [super orderBack:sender];
8767}
8768
8769- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above
8770{
8771 NSTRACE ("[EmacsWindow restackWindow:above:]");
8772
8773 /* If parent windows don't match we can't restack these frames
8774 without changing the parents. */
8775 if ([self parentWindow] != [win parentWindow])
8776 return NO;
8777 else if (![self parentWindow])
8778 [self orderWindow:(above ? NSWindowAbove : NSWindowBelow)
8779 relativeTo:[win windowNumber]];
8780 else
8781 {
8782 NSInteger index;
8783 NSWindow *parent = [self parentWindow];
8784 NSMutableArray *children = [[[parent childWindows]
8785 sortedArrayUsingFunction:nswindow_orderedIndex_sort
8786 context:nil]
8787 mutableCopy];
8788 [children removeObject:self];
8789 index = [children indexOfObject:win];
8790 [children insertObject:self atIndex:(above ? index+1 : index)];
8791
8792 for (NSWindow *w in children)
8793 {
8794 [parent removeChildWindow:w];
8795 [parent addChildWindow:w ordered:NSWindowAbove];
8796 }
8797 }
8798
8799 return YES;
8800}
8801
8696#ifdef NS_IMPL_COCOA 8802#ifdef NS_IMPL_COCOA
8697- (id)accessibilityAttributeValue:(NSString *)attribute 8803- (id)accessibilityAttributeValue:(NSString *)attribute
8698{ 8804{
diff --git a/src/pdumper.c b/src/pdumper.c
index 6956ee36829..116cc28dbba 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2058,7 +2058,7 @@ dump_interval_tree (struct dump_context *ctx,
2058static dump_off 2058static dump_off
2059dump_string (struct dump_context *ctx, const struct Lisp_String *string) 2059dump_string (struct dump_context *ctx, const struct Lisp_String *string)
2060{ 2060{
2061#if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C) 2061#if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB)
2062# error "Lisp_String changed. See CHECK_STRUCTS comment in config.h." 2062# error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
2063#endif 2063#endif
2064 /* If we have text properties, write them _after_ the string so that 2064 /* If we have text properties, write them _after_ the string so that
diff --git a/src/print.c b/src/print.c
index 94a8bcbf882..14af9195475 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1557,7 +1557,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
1557 /* Implement a readable output, e.g.: 1557 /* Implement a readable output, e.g.:
1558 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ 1558 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
1559 /* Always print the size. */ 1559 /* Always print the size. */
1560 int len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next)); 1560 int len = sprintf (buf, "#s(hash-table size %"pD"d",
1561 HASH_TABLE_SIZE (h));
1561 strout (buf, len, len, printcharfun); 1562 strout (buf, len, len, printcharfun);
1562 1563
1563 if (!NILP (h->test.name)) 1564 if (!NILP (h->test.name))
diff --git a/src/process.c b/src/process.c
index 3550f623c6a..25883f911f1 100644
--- a/src/process.c
+++ b/src/process.c
@@ -692,8 +692,7 @@ status_convert (int w)
692 if (WIFSTOPPED (w)) 692 if (WIFSTOPPED (w))
693 return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil)); 693 return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil));
694 else if (WIFEXITED (w)) 694 else if (WIFEXITED (w))
695 return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), 695 return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil));
696 WCOREDUMP (w) ? Qt : Qnil));
697 else if (WIFSIGNALED (w)) 696 else if (WIFSIGNALED (w))
698 return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)), 697 return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)),
699 WCOREDUMP (w) ? Qt : Qnil)); 698 WCOREDUMP (w) ? Qt : Qnil));
@@ -2059,6 +2058,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2059 bool pty_flag = 0; 2058 bool pty_flag = 0;
2060 char pty_name[PTY_NAME_SIZE]; 2059 char pty_name[PTY_NAME_SIZE];
2061 Lisp_Object lisp_pty_name = Qnil; 2060 Lisp_Object lisp_pty_name = Qnil;
2061 sigset_t oldset;
2062 2062
2063 inchannel = outchannel = -1; 2063 inchannel = outchannel = -1;
2064 2064
@@ -2139,13 +2139,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2139 setup_process_coding_systems (process); 2139 setup_process_coding_systems (process);
2140 char **env = make_environment_block (current_dir); 2140 char **env = make_environment_block (current_dir);
2141 2141
2142 block_input ();
2143 block_child_signal (&oldset);
2144
2142 pty_flag = p->pty_flag; 2145 pty_flag = p->pty_flag;
2143 eassert (pty_flag == ! NILP (lisp_pty_name)); 2146 eassert (pty_flag == ! NILP (lisp_pty_name));
2144 2147
2145 vfork_errno 2148 vfork_errno
2146 = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env, 2149 = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
2147 SSDATA (current_dir), 2150 SSDATA (current_dir),
2148 pty_flag ? SSDATA (lisp_pty_name) : NULL); 2151 pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
2149 2152
2150 eassert ((vfork_errno == 0) == (0 < pid)); 2153 eassert ((vfork_errno == 0) == (0 < pid));
2151 2154
@@ -2153,6 +2156,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2153 if (pid >= 0) 2156 if (pid >= 0)
2154 p->alive = 1; 2157 p->alive = 1;
2155 2158
2159 /* Stop blocking in the parent. */
2160 unblock_child_signal (&oldset);
2161 unblock_input ();
2162
2156 /* Environment block no longer needed. */ 2163 /* Environment block no longer needed. */
2157 unbind_to (count, Qnil); 2164 unbind_to (count, Qnil);
2158 2165
diff --git a/src/terminfo.c b/src/terminfo.c
index 15aff317f15..a9c9572bbb2 100644
--- a/src/terminfo.c
+++ b/src/terminfo.c
@@ -23,10 +23,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
23 23
24/* Define these variables that serve as global parameters to termcap, 24/* Define these variables that serve as global parameters to termcap,
25 so that we do not need to conditionalize the places in Emacs 25 so that we do not need to conditionalize the places in Emacs
26 that set them. But don't do that for terminfo, as that could 26 that set them. But don't do that if terminfo defines them, as that
27 cause link errors when using -fno-common. */ 27 could cause link errors when using -fno-common. */
28 28
29#if !TERMINFO 29#ifndef TERMINFO_DEFINES_BC
30char *UP, *BC, PC; 30char *UP, *BC, PC;
31#endif 31#endif
32 32
diff --git a/src/window.c b/src/window.c
index ba8682eed7c..5e78aa400b5 100644
--- a/src/window.c
+++ b/src/window.c
@@ -8100,6 +8100,18 @@ and scrolling positions. */)
8100 return Qt; 8100 return Qt;
8101 return Qnil; 8101 return Qnil;
8102} 8102}
8103
8104DEFUN ("window-bump-use-time", Fwindow_bump_use_time,
8105 Swindow_bump_use_time, 1, 1, 0,
8106 doc: /* Mark WINDOW as having been recently used. */)
8107 (Lisp_Object window)
8108{
8109 struct window *w = decode_valid_window (window);
8110
8111 w->use_time = ++window_select_count;
8112 return Qnil;
8113}
8114
8103 8115
8104 8116
8105static void init_window_once_for_pdumper (void); 8117static void init_window_once_for_pdumper (void);
@@ -8573,6 +8585,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
8573 defsubr (&Swindow_vscroll); 8585 defsubr (&Swindow_vscroll);
8574 defsubr (&Sset_window_vscroll); 8586 defsubr (&Sset_window_vscroll);
8575 defsubr (&Scompare_window_configurations); 8587 defsubr (&Scompare_window_configurations);
8588 defsubr (&Swindow_bump_use_time);
8576 defsubr (&Swindow_list); 8589 defsubr (&Swindow_list);
8577 defsubr (&Swindow_list_1); 8590 defsubr (&Swindow_list_1);
8578 defsubr (&Swindow_prev_buffers); 8591 defsubr (&Swindow_prev_buffers);
@@ -8583,14 +8596,3 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
8583 defsubr (&Swindow_parameter); 8596 defsubr (&Swindow_parameter);
8584 defsubr (&Sset_window_parameter); 8597 defsubr (&Sset_window_parameter);
8585} 8598}
8586
8587void
8588keys_of_window (void)
8589{
8590 initial_define_key (control_x_map, '<', "scroll-left");
8591 initial_define_key (control_x_map, '>', "scroll-right");
8592
8593 initial_define_key (global_map, Ctl ('V'), "scroll-up-command");
8594 initial_define_key (meta_map, Ctl ('V'), "scroll-other-window");
8595 initial_define_key (meta_map, 'v', "scroll-down-command");
8596}
diff --git a/src/window.h b/src/window.h
index fba98f438c4..fbdec0df997 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1202,7 +1202,6 @@ extern bool window_outdated (struct window *);
1202extern void init_window_once (void); 1202extern void init_window_once (void);
1203extern void init_window (void); 1203extern void init_window (void);
1204extern void syms_of_window (void); 1204extern void syms_of_window (void);
1205extern void keys_of_window (void);
1206/* Move cursor to row/column position VPOS/HPOS, pixel coordinates 1205/* Move cursor to row/column position VPOS/HPOS, pixel coordinates
1207 Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y 1206 Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y
1208 are window-relative pixel positions. This is always done during 1207 are window-relative pixel positions. This is always done during
diff --git a/src/xdisp.c b/src/xdisp.c
index b0f218dcb35..d070c5ae5cd 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4262,6 +4262,7 @@ handle_fontified_prop (struct it *it)
4262 if (!STRINGP (it->string) 4262 if (!STRINGP (it->string)
4263 && it->s == NULL 4263 && it->s == NULL
4264 && !NILP (Vfontification_functions) 4264 && !NILP (Vfontification_functions)
4265 && !(input_was_pending && redisplay_skip_fontification_on_input)
4265 && !NILP (Vrun_hooks) 4266 && !NILP (Vrun_hooks)
4266 && (pos = make_fixnum (IT_CHARPOS (*it)), 4267 && (pos = make_fixnum (IT_CHARPOS (*it)),
4267 prop = Fget_char_property (pos, Qfontified, Qnil), 4268 prop = Fget_char_property (pos, Qfontified, Qnil),
@@ -25508,7 +25509,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format)
25508 if (start < i) 25509 if (start < i)
25509 display_string (NULL, 25510 display_string (NULL,
25510 Fsubstring (mode_string, make_fixnum (start), 25511 Fsubstring (mode_string, make_fixnum (start),
25511 make_fixnum (i - 1)), 25512 make_fixnum (i)),
25512 Qnil, 0, 0, &it, 0, 0, 0, 25513 Qnil, 0, 0, &it, 0, 0, 0,
25513 STRING_MULTIBYTE (mode_string)); 25514 STRING_MULTIBYTE (mode_string));
25514 } 25515 }
@@ -35613,6 +35614,19 @@ best except in special circumstances such as running redisplay tests
35613in batch mode. */); 35614in batch mode. */);
35614 redisplay_skip_initial_frame = true; 35615 redisplay_skip_initial_frame = true;
35615 35616
35617 DEFVAR_BOOL ("redisplay-skip-fontification-on-input",
35618 redisplay_skip_fontification_on_input,
35619 doc: /* Skip `fontification_functions` when there is input pending.
35620If non-nil and there was input pending at the beginning of the command,
35621the `fontification_functions` hook is not run. This usually does not
35622affect the display because redisplay is completely skipped anyway if input
35623was pending, but it can make scrolling smoother by avoiding
35624unnecessary fontification.
35625It is similar to `fast-but-imprecise-scrolling' with similar tradeoffs,
35626but with the advantage that it should only affect the behavior when Emacs
35627has trouble keeping up with the incoming input rate. */);
35628 redisplay_skip_fontification_on_input = false;
35629
35616 DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows", 35630 DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows",
35617 redisplay_adhoc_scroll_in_resize_mini_windows, 35631 redisplay_adhoc_scroll_in_resize_mini_windows,
35618 doc: /* If nil always use normal scrolling in minibuffer windows. 35632 doc: /* If nil always use normal scrolling in minibuffer windows.
diff --git a/src/xterm.c b/src/xterm.c
index 0a86738cc20..b8374fed8b1 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -13035,13 +13035,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
13035 or larger than other for other applications, even if it is the same 13035 or larger than other for other applications, even if it is the same
13036 font name (monospace-10 for example). */ 13036 font name (monospace-10 for example). */
13037 13037
13038# ifdef HAVE_XRENDER
13038 int event_base, error_base; 13039 int event_base, error_base;
13039 char *v;
13040 double d;
13041
13042 XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); 13040 XRenderQueryExtension (dpyinfo->display, &event_base, &error_base);
13041# endif
13043 13042
13044 v = XGetDefault (dpyinfo->display, "Xft", "dpi"); 13043 char *v = XGetDefault (dpyinfo->display, "Xft", "dpi");
13044 double d;
13045 if (v != NULL && sscanf (v, "%lf", &d) == 1) 13045 if (v != NULL && sscanf (v, "%lf", &d) == 1)
13046 dpyinfo->resy = dpyinfo->resx = d; 13046 dpyinfo->resy = dpyinfo->resx = d;
13047 } 13047 }
diff --git a/test/Makefile.in b/test/Makefile.in
index 8aa37ca7854..fc40dad5e2e 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -161,11 +161,15 @@ endif
161 161
162## Save logs, and show logs for failed tests. 162## Save logs, and show logs for failed tests.
163WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } 163WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
164## On Hydra or Emba, always show logs for certain problematic tests.
164ifdef EMACS_HYDRA_CI 165ifdef EMACS_HYDRA_CI
165## On Hydra, always show logs for certain problematic tests.
166lisp/net/tramp-tests.log \ 166lisp/net/tramp-tests.log \
167: WRITE_LOG = 2>&1 | tee $@ 167: WRITE_LOG = 2>&1 | tee $@
168endif 168endif
169ifdef EMACS_EMBA_CI
170lisp/filenotify-tests.log lisp/net/tramp-tests.log \
171: WRITE_LOG = 2>&1 | tee $@
172endif
169 173
170ifeq ($(TEST_LOAD_EL), yes) 174ifeq ($(TEST_LOAD_EL), yes)
171testloadfile = $*.el 175testloadfile = $*.el
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
new file mode 100644
index 00000000000..e65a541e6e3
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
@@ -0,0 +1,7 @@
1;;; -*- lexical-binding: t -*-
2
3(make-obsolete-variable 'bytecomp--tests-obsolete-var-2 nil "99.99")
4
5(defun foo ()
6 (let ((bytecomp--tests-obsolete-var-2 2))
7 bytecomp--tests-obsolete-var-2))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5e5f99dbdab..a07af188fac 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -625,6 +625,9 @@ Subtests signal errors if something goes wrong."
625(bytecomp--define-warning-file-test "warn-obsolete-variable.el" 625(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
626 "bytecomp--tests-obs.*obsolete.*99.99") 626 "bytecomp--tests-obs.*obsolete.*99.99")
627 627
628(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
629 "bytecomp--tests-obs.*obsolete.*99.99" t)
630
628(bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el" 631(bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el"
629 "as both function and macro") 632 "as both function and macro")
630 633
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 446983c2e3e..bcd63f73a3c 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -610,4 +610,27 @@ collection clause."
610 ;; Just make sure the function can be instrumented. 610 ;; Just make sure the function can be instrumented.
611 (edebug-defun))) 611 (edebug-defun)))
612 612
613;;; cl-labels
614
615(ert-deftest cl-macs--labels ()
616 ;; Simple recursive function.
617 (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
618 (should (equal (len (make-list 42 t)) 42)))
619
620 ;; Simple tail-recursive function.
621 (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
622 (should (equal (len (make-list 42 t) 0) 42))
623 ;; Should not bump into stack depth limits.
624 (should (equal (len (make-list 42000 t) 0) 42000)))
625
626 ;; Check that non-recursive functions are handled more efficiently.
627 (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
628 (`(let* ,_ (funcall ,_ 5)) t)))
629
630 ;; Case of "tail-recursive lambdas".
631 (should (pcase (macroexpand
632 '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
633 #'len))
634 (`(function (lambda (,_ ,_) . ,_)) t))))
635
613;;; cl-macs-tests.el ends here 636;;; cl-macs-tests.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 047109a96a2..d73b072661a 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -1265,7 +1265,7 @@ delivered."
1265;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286 1265;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286
1266(file-notify--deftest-remote file-notify-test07-many-events 1266(file-notify--deftest-remote file-notify-test07-many-events
1267 "Check that events are not dropped for remote directories." 1267 "Check that events are not dropped for remote directories."
1268 (getenv "EMACS_HYDRA_CI")) 1268 (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")))
1269 1269
1270(ert-deftest file-notify-test08-backup () 1270(ert-deftest file-notify-test08-backup ()
1271 "Check that backup keeps file notification." 1271 "Check that backup keeps file notification."
diff --git a/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
new file mode 100644
index 00000000000..0b193a27234
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
@@ -0,0 +1,20 @@
1From: example <example@example.org>
2To: example <example@example.org>
3Content-Type: multipart/alternative; boundary="===============2877195075946974246=="
4Date: Thu, 29 Oct 2020 14:47:55 +0100
5MIME-Version: 1.0
6Subject: test
7
8--===============2877195075946974246==
9Content-Type: text/plain; charset="utf-8"
10Content-Transfer-Encoding: 8bit
11
12ääää
13
14--===============2877195075946974246==
15Content-Type: text/html; charset="utf-8"
16Content-Transfer-Encoding: 8bit
17
18<!doctype html><html><head><meta http-equiv="content-type" content="text/html; charset=UTF-8"></head><body>ääää</body></html>
19
20--===============2877195075946974246==--
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el
new file mode 100644
index 00000000000..74591f919da
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -0,0 +1,89 @@
1;;; mm-decode-tests.el --- -*- lexical-binding:t -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 3, or (at your option)
10;; 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(require 'mm-decode)
27
28(ert-deftest test-mm-dissect-buffer ()
29 (with-temp-buffer
30 (set-buffer-multibyte nil)
31 (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
32 (while (search-forward "\r\n" nil t)
33 (replace-match "\n"))
34 (let ((handle (mm-dissect-buffer)))
35 (should (equal (mm-handle-media-type handle) "multipart/alternative"))
36 ;; Skip multipart type.
37 (pop handle)
38 (let ((part (pop handle)))
39 (should (equal (mm-handle-media-type part) "text/plain"))
40 (should (eq (mm-handle-encoding part) '8bit))
41 (with-current-buffer (mm-handle-buffer part)
42 (should (equal (decode-coding-string
43 (buffer-string)
44 (intern (mail-content-type-get (mm-handle-type part)
45 'charset)))
46 "ääää\n"))))
47 (let ((part (pop handle)))
48 (should (equal (mm-handle-media-type part) "text/html"))
49 (should (eq (mm-handle-encoding part) '8bit))
50 (with-current-buffer (mm-handle-buffer part)
51 (should (equal (decode-coding-string
52 (buffer-string)
53 (intern (mail-content-type-get (mm-handle-type part)
54 'charset)))
55 "<!doctype html><html><head><meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\"></head><body>ääää</body></html>\n")))))))
56
57(ert-deftest test-mm-with-part-unibyte ()
58 (with-temp-buffer
59 (set-buffer-multibyte nil)
60 (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
61 (while (search-forward "\r\n" nil t)
62 (replace-match "\n"))
63 (let ((handle (mm-dissect-buffer)))
64 (pop handle)
65 (let ((part (pop handle)))
66 (should (equal (decode-coding-string
67 (mm-with-part part
68 (buffer-string))
69 (intern (mail-content-type-get (mm-handle-type part)
70 'charset)))
71 "ääää\n"))))))
72
73(ert-deftest test-mm-with-part-multibyte ()
74 (with-temp-buffer
75 (set-buffer-multibyte t)
76 (nnheader-insert-file-contents (ert-resource-file "8bit-multipart.bin"))
77 (while (search-forward "\r\n" nil t)
78 (replace-match "\n"))
79 (let ((handle (mm-dissect-buffer)))
80 (pop handle)
81 (let ((part (pop handle)))
82 (should (equal (decode-coding-string
83 (mm-with-part part
84 (buffer-string))
85 (intern (mail-content-type-get (mm-handle-type part)
86 'charset)))
87 "ääää\n"))))))
88
89;;; mm-decode-tests.el ends here
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 95557c95eb7..835d9fe7949 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -102,7 +102,7 @@ RET minibuffer-complete-and-exit
102ESC Prefix Command 102ESC Prefix Command
103SPC minibuffer-complete-word 103SPC minibuffer-complete-word
104? minibuffer-completion-help 104? minibuffer-completion-help
105<C-tab> file-cache-minibuffer-complete 105C-<tab> file-cache-minibuffer-complete
106<XF86Back> previous-history-element 106<XF86Back> previous-history-element
107<XF86Forward> next-history-element 107<XF86Forward> next-history-element
108<down> next-line-or-history-element 108<down> next-line-or-history-element
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 896b9978e7c..e1cb9939f29 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4670,7 +4670,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4670 4670
4671(ert-deftest tramp-test31-interrupt-process () 4671(ert-deftest tramp-test31-interrupt-process ()
4672 "Check `interrupt-process'." 4672 "Check `interrupt-process'."
4673 :tags (if (getenv "EMACS_EMBA_CI") 4673 :tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
4674 '(:expensive-test :unstable) '(:expensive-test)) 4674 '(:expensive-test :unstable) '(:expensive-test))
4675 (skip-unless (tramp--test-enabled)) 4675 (skip-unless (tramp--test-enabled))
4676 (skip-unless (tramp--test-sh-p)) 4676 (skip-unless (tramp--test-sh-p))
@@ -5787,7 +5787,8 @@ This requires restrictions of file name syntax."
5787 (tmp-name2 (tramp--test-make-temp-name 'local quoted)) 5787 (tmp-name2 (tramp--test-make-temp-name 'local quoted))
5788 (files (delq nil files)) 5788 (files (delq nil files))
5789 (process-environment process-environment) 5789 (process-environment process-environment)
5790 (sorted-files (sort (copy-sequence files) #'string-lessp))) 5790 (sorted-files (sort (copy-sequence files) #'string-lessp))
5791 buffer)
5791 (unwind-protect 5792 (unwind-protect
5792 (progn 5793 (progn
5793 (make-directory tmp-name1) 5794 (make-directory tmp-name1)
@@ -5849,6 +5850,18 @@ This requires restrictions of file name syntax."
5849 tmp-name2 nil directory-files-no-dot-files-regexp)) 5850 tmp-name2 nil directory-files-no-dot-files-regexp))
5850 sorted-files)) 5851 sorted-files))
5851 5852
5853 ;; Check, that `insert-directory' works properly.
5854 (with-current-buffer
5855 (setq buffer (dired-noselect tmp-name1 "--dired -al"))
5856 (goto-char (point-min))
5857 (while (not (eobp))
5858 (when-let ((name (dired-get-filename 'localp 'no-error)))
5859 (unless
5860 (string-match-p name directory-files-no-dot-files-regexp)
5861 (should (member name files))))
5862 (forward-line 1)))
5863 (kill-buffer buffer)
5864
5852 ;; `substitute-in-file-name' could return different 5865 ;; `substitute-in-file-name' could return different
5853 ;; values. For `adb', there could be strange file 5866 ;; values. For `adb', there could be strange file
5854 ;; permissions preventing overwriting a file. We don't 5867 ;; permissions preventing overwriting a file. We don't
@@ -5944,6 +5957,7 @@ This requires restrictions of file name syntax."
5944 (regexp-quote (getenv envvar)))))))))) 5957 (regexp-quote (getenv envvar))))))))))
5945 5958
5946 ;; Cleanup. 5959 ;; Cleanup.
5960 (ignore-errors (kill-buffer buffer))
5947 (ignore-errors (delete-directory tmp-name1 'recursive)) 5961 (ignore-errors (delete-directory tmp-name1 'recursive))
5948 (ignore-errors (delete-directory tmp-name2 'recursive)))))) 5962 (ignore-errors (delete-directory tmp-name2 'recursive))))))
5949 5963
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
new file mode 100644
index 00000000000..8af4625fff3
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
@@ -0,0 +1,143 @@
1use 5.020;
2
3=head1 NAME
4
5here-docs.pl - resource file for cperl-test-here-docs
6
7=head1 DESCRIPTION
8
9This file holds a couple of HERE documents, with a variety of normal
10and edge cases. For a formatted view of this description, run:
11
12 (cperl-perldoc "here-docs.pl")
13
14For each of the HERE documents, the following checks will done:
15
16=over 4
17
18=item *
19
20All occurrences of the string "look-here" are fontified correcty.
21Note that we deliberately test the face, not the syntax property:
22Users won't care for the syntax property, but they see the face.
23Different implementations with different syntax properties have been
24seen in the past.
25
26=item *
27
28Indentation of the line(s) containing "look-here" is 0, i.e. there are no
29leading spaces.
30
31=item *
32
33Indentation of the following perl statement containing "indent" should
34be 0 if the statement contains "noindent", and according to the mode's
35continued-statement-offset otherwise.
36
37=back
38
39=cut
40
41# Prologue to make the test file valid without warnings
42
43my $text;
44my $any;
45my $indentation;
46my $anywhere = 'back again';
47my $noindent;
48
49=head1 The Tests
50
51=head2 Test Case 1
52
53We have two HERE documents in one line with different quoting styles.
54
55=cut
56
57## test case
58
59$text = <<"HERE" . <<'THERE' . $any;
60#look-here and
61HERE
62$tlook-here and
63THERE
64
65$noindent = "This should be left-justified";
66
67=head2 Test case 2
68
69A HERE document followed by a continuation line
70
71=cut
72
73## test case
74
75$text = <<HERE
76look-here
77HERE
78
79. 'indent-level'; # Continuation, should be indented
80
81=head2 Test case 3
82
83A here document with a line-end comment in the starter line,
84after a complete statement
85
86=cut
87
88## test case
89
90$text = <<HERE; # start here
91look-here
92HERE
93
94$noindent = "New statement in this line";
95
96=head2 Test case 4
97
98A HERE document with a to-be-continued statement and a comment in the
99starter line.
100
101=cut
102
103## test case
104
105$text = <<HERE # start here
106look-here
107HERE
108
109. 'indent-level'; # Continuation, should be indented
110
111=head2 Test case 5
112
113A HERE document with a comment sign, but no comment to follow.
114
115
116=cut
117
118## test case
119
120$text = <<HERE; #
121look-here
122HERE
123
124$noindent = "New statement in this line";
125
126=head2 Test case 6
127
128A HERE document with a comment sign, but no comment to follow, with a
129statement to be continued. Also, the character before the comment
130sign has a relevant syntax property (end of string in our case) which
131must be preserved.
132
133=cut
134
135## test case
136
137$text = <<"HERE"#
138look-here
139HERE
140
141. 'indent-level'; # Continuation, should be indented
142
143__END__
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 46e687f14d0..943c454445c 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -135,6 +135,37 @@ point in the distant past, and is still broken in perl-mode. "
135 (should (equal (nth 3 (syntax-ppss)) nil)) 135 (should (equal (nth 3 (syntax-ppss)) nil))
136 (should (equal (nth 4 (syntax-ppss)) t)))))) 136 (should (equal (nth 4 (syntax-ppss)) t))))))
137 137
138(ert-deftest cperl-test-heredocs ()
139 "Test that HERE-docs are fontified with the appropriate face."
140 (require 'perl-mode)
141 (let ((file (ert-resource-file "here-docs.pl"))
142 (cperl-continued-statement-offset perl-continued-statement-offset)
143 (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
144 'font-lock-string-face))
145 (case-fold-search nil))
146 (with-temp-buffer
147 (insert-file-contents file)
148 (goto-char (point-min))
149 (funcall cperl-test-mode)
150 (indent-region (point-min) (point-max))
151 (font-lock-ensure (point-min) (point-max))
152 (while (search-forward "## test case" nil t)
153 (save-excursion
154 (while (search-forward "look-here" nil t)
155 (should (equal
156 (get-text-property (match-beginning 0) 'face)
157 target-font))
158 (beginning-of-line)
159 (should (null (looking-at "[ \t]")))
160 (forward-line 1)))
161 (should (re-search-forward
162 (concat "^\\([ \t]*\\)" ; the actual indentation amount
163 "\\([^ \t\n].*?\\)\\(no\\)?indent")
164 nil t))
165 (should (equal (- (match-end 1) (match-beginning 1))
166 (if (match-beginning 3) 0
167 perl-indent-level)))))))
168
138;;; Tests for issues reported in the Bug Tracker 169;;; Tests for issues reported in the Bug Tracker
139 170
140(defun cperl-test--run-bug-10483 () 171(defun cperl-test--run-bug-10483 ()
@@ -164,6 +195,7 @@ under timeout control."
164 (interactive) 195 (interactive)
165 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out 196 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
166 (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen 197 (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
198 (skip-unless (eq cperl-test-mode #'cperl-mode))
167 (let* ((emacs (concat invocation-directory invocation-name)) 199 (let* ((emacs (concat invocation-directory invocation-name))
168 (test-function 'cperl-test--run-bug-10483) 200 (test-function 'cperl-test--run-bug-10483)
169 (test-function-name (symbol-name test-function)) 201 (test-function-name (symbol-name test-function))
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el
index 67b592e9070..42a011c8bcd 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -497,7 +497,8 @@ VALUES-PLIST is a list with alternating index and value elements."
497(ert-deftest ruby-add-log-current-method-examples () 497(ert-deftest ruby-add-log-current-method-examples ()
498 (let ((pairs '(("foo" . "#foo") 498 (let ((pairs '(("foo" . "#foo")
499 ("C.foo" . ".foo") 499 ("C.foo" . ".foo")
500 ("self.foo" . ".foo")))) 500 ("self.foo" . ".foo")
501 ("<<" . "#<<"))))
501 (dolist (pair pairs) 502 (dolist (pair pairs)
502 (let ((name (car pair)) 503 (let ((name (car pair))
503 (value (cdr pair))) 504 (value (cdr pair)))
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el
index eaafc5888c7..b4b5e4db5d6 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -99,13 +99,18 @@
99 (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) 99 (should (null (marker-position (cdr (nth 0 (cdr cons2))))))))
100 100
101(ert-deftest xref--xref-file-name-display-is-abs () 101(ert-deftest xref--xref-file-name-display-is-abs ()
102 (let ((xref-file-name-display 'abs)) 102 (let ((xref-file-name-display 'abs)
103 (should (equal (delete-dups 103 ;; Some older BSD find versions can produce '//' in the output.
104 (mapcar 'xref-location-group 104 (expected (list
105 (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) 105 (concat xref-tests--data-dir "/?file1.txt")
106 (list 106 (concat xref-tests--data-dir "/?file2.txt")))
107 (concat xref-tests--data-dir "file1.txt") 107 (actual (delete-dups
108 (concat xref-tests--data-dir "file2.txt")))))) 108 (mapcar 'xref-location-group
109 (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))))
110 (should (and (= (length expected) (length actual))
111 (cl-every (lambda (e1 e2)
112 (string-match-p e1 e2))
113 expected actual)))))
109 114
110(ert-deftest xref--xref-file-name-display-is-nondirectory () 115(ert-deftest xref--xref-file-name-display-is-nondirectory ()
111 (let ((xref-file-name-display 'nondirectory)) 116 (let ((xref-file-name-display 'nondirectory))
@@ -121,10 +126,15 @@
121 (file-name-directory (directory-file-name xref-tests--data-dir))) 126 (file-name-directory (directory-file-name xref-tests--data-dir)))
122 (project-find-functions 127 (project-find-functions
123 #'(lambda (_) (cons 'transient data-parent-dir))) 128 #'(lambda (_) (cons 'transient data-parent-dir)))
124 (xref-file-name-display 'project-relative)) 129 (xref-file-name-display 'project-relative)
125 (should (equal (delete-dups 130 ;; Some older BSD find versions can produce '//' in the output.
126 (mapcar 'xref-location-group 131 (expected (list
127 (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) 132 "xref-resources//?file1.txt"
128 (list 133 "xref-resources//?file2.txt"))
129 "xref-resources/file1.txt" 134 (actual (delete-dups
130 "xref-resources/file2.txt"))))) 135 (mapcar 'xref-location-group
136 (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))))
137 (should (and (= (length expected) (length actual))
138 (cl-every (lambda (e1 e2)
139 (string-match-p e1 e2))
140 expected actual)))))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 2f5b38d05d9..e0826208b60 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -61,6 +61,35 @@
61 (quote 61 (quote
62 (0 font-lock-keyword-face)))))))) 62 (0 font-lock-keyword-face))))))))
63 63
64
65;;;; Keymap support.
66
67(ert-deftest subr-test-kbd ()
68 (should (equal (kbd "f") "f"))
69 (should (equal (kbd "<f1>") [f1]))
70 (should (equal (kbd "RET") "\C-m"))
71 (should (equal (kbd "C-x a") "\C-xa"))
72 ;; Check that kbd handles both new and old style key descriptions
73 ;; (bug#45536).
74 (should (equal (kbd "s-<return>") [s-return]))
75 (should (equal (kbd "<s-return>") [s-return]))
76 (should (equal (kbd "C-M-<return>") [C-M-return]))
77 (should (equal (kbd "<C-M-return>") [C-M-return])))
78
79(ert-deftest subr-test-define-prefix-command ()
80 (define-prefix-command 'foo-prefix-map)
81 (should (keymapp foo-prefix-map))
82 (should (fboundp #'foo-prefix-map))
83 ;; With optional argument.
84 (define-prefix-command 'bar-prefix 'bar-prefix-map)
85 (should (keymapp bar-prefix-map))
86 (should (fboundp #'bar-prefix))
87 ;; Returns the symbol.
88 (should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
89
90
91;;;; Mode hooks.
92
64(defalias 'subr-tests--parent-mode 93(defalias 'subr-tests--parent-mode
65 (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) 94 (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
66 95
@@ -404,6 +433,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
404 (should (equal (flatten-tree '(1 ("foo" "bar") 2)) 433 (should (equal (flatten-tree '(1 ("foo" "bar") 2))
405 '(1 "foo" "bar" 2)))) 434 '(1 "foo" "bar" 2))))
406 435
436(ert-deftest subr--tests-letrec ()
437 ;; Test that simple cases of `letrec' get optimized back to `let*'.
438 (should (equal (macroexpand '(letrec ((subr-tests-var1 1)
439 (subr-tests-var2 subr-tests-var1))
440 (+ subr-tests-var1 subr-tests-var2)))
441 '(let* ((subr-tests-var1 1)
442 (subr-tests-var2 subr-tests-var1))
443 (+ subr-tests-var1 subr-tests-var2)))))
444
407(defvar subr-tests--hook nil) 445(defvar subr-tests--hook nil)
408 446
409(ert-deftest subr-tests-add-hook-depth () 447(ert-deftest subr-tests-add-hook-depth ()
diff --git a/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
new file mode 100644
index 00000000000..1905477af8c
--- /dev/null
+++ b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
@@ -0,0 +1,9 @@
1First
2paragraph
3
4Second
5
6Third
7paragraph
8
9No line end \ No newline at end of file
diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el
index bf7f37090f5..712169029de 100644
--- a/test/lisp/textmodes/paragraphs-tests.el
+++ b/test/lisp/textmodes/paragraphs-tests.el
@@ -24,6 +24,7 @@
24;;; Code: 24;;; Code:
25 25
26(require 'ert) 26(require 'ert)
27(require 'ert-x)
27;; (require 'paragraphs) ; loaded by default 28;; (require 'paragraphs) ; loaded by default
28 29
29(ert-deftest paragraphs-tests-sentence-end () 30(ert-deftest paragraphs-tests-sentence-end ()
@@ -161,5 +162,27 @@
161 (should (equal (buffer-string) 162 (should (equal (buffer-string)
162 "First sentence. Third sentence. Second sentence.")))) 163 "First sentence. Third sentence. Second sentence."))))
163 164
165(ert-deftest test-mark-paragraphs ()
166 (with-current-buffer
167 (find-file-noselect (ert-resource-file "mark-paragraph.bin"))
168 (goto-char (point-max))
169 ;; Just a sanity check that the file hasn't changed.
170 (should (= (point) 54))
171 (mark-paragraph)
172 (should (= (point) 42))
173 (should (= (mark) 54))
174 ;; Doesn't move.
175 (mark-paragraph)
176 (should (= (point) 42))
177 (should (= (mark) 54))
178 (forward-line -1)
179 (mark-paragraph)
180 (should (= (point) 25))
181 (should (= (mark) 42))
182 (goto-char (point-min))
183 (mark-paragraph)
184 (should (= (point) 1))
185 (should (= (mark) 17))))
186
164(provide 'paragraphs-tests) 187(provide 'paragraphs-tests)
165;;; paragraphs-tests.el ends here 188;;; paragraphs-tests.el ends here
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 35235c65665..17fdfefce84 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -301,4 +301,25 @@ return nil, even with a non-nil bubblep argument."
301 (should child) 301 (should child)
302 (should (equal (widget-value widget) '((1 "One"))))))) 302 (should (equal (widget-value widget) '((1 "One")))))))
303 303
304(ert-deftest widget-test-widget-move ()
305 "Test moving with `widget-forward' and `widget-backward'."
306 (with-temp-buffer
307 (dolist (el '("First" "Second" "Third"))
308 (widget-create 'push-button el))
309 (widget-insert "\n")
310 (use-local-map widget-keymap)
311 (widget-setup)
312 (goto-char (point-min))
313 ;; Check that moving from the widget's start works.
314 (widget-forward 2)
315 (should (string= "Third" (widget-value (widget-at))))
316 (widget-backward 1)
317 (should (string= "Second" (widget-value (widget-at))))
318 ;; Check that moving from inside the widget works.
319 (goto-char (point-min))
320 (widget-forward 2)
321 (forward-char)
322 (widget-backward 1)
323 (should (string= "Second" (widget-value (widget-at))))))
324
304;;; wid-edit-tests.el ends here 325;;; wid-edit-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 74fb3c892db..d4f5fc3f190 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -248,6 +248,18 @@ g .. h foo
2480 .. 3 foo 2480 .. 3 foo
249"))))) 249")))))
250 250
251(ert-deftest keymap--key-description ()
252 (should (equal (key-description [right] [?\C-x])
253 "C-x <right>"))
254 (should (equal (key-description [M-H-right] [?\C-x])
255 "C-x M-H-<right>"))
256 (should (equal (single-key-description 'home)
257 "<home>"))
258 (should (equal (single-key-description 'home t)
259 "home"))
260 (should (equal (single-key-description 'C-s-home)
261 "C-s-<home>")))
262
251(provide 'keymap-tests) 263(provide 'keymap-tests)
252 264
253;;; keymap-tests.el ends here 265;;; keymap-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 5294bc07ce5..921bcd5f85b 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -560,8 +560,16 @@ FD_SETSIZE file descriptors (Bug#24325)."
560 ;; We should have managed to start at least one process. 560 ;; We should have managed to start at least one process.
561 (should processes) 561 (should processes)
562 (dolist (process processes) 562 (dolist (process processes)
563 (should (process-live-p process)) 563 ;; The process now should either be running, or have
564 (process-send-eof process) 564 ;; already failed before `exec'.
565 (should (memq (process-status process) '(run exit)))
566 (when (process-live-p process)
567 (process-send-eof process))
568 ;; FIXME: This `sleep-for' shouldn't be needed. It
569 ;; indicates a bug in Emacs; perhaps SIGCHLD is
570 ;; received in parallel with `accept-process-output',
571 ;; causing the latter to hang.
572 (sleep-for 0.1)
565 (while (accept-process-output process)) 573 (while (accept-process-output process))
566 (should (eq (process-status process) 'exit)) 574 (should (eq (process-status process) 'exit))
567 ;; If there's an error between fork and exec, Emacs 575 ;; If there's an error between fork and exec, Emacs
@@ -643,6 +651,8 @@ FD_SETSIZE file descriptors (Bug#24325)."
643(ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () 651(ert-deftest process-tests/fd-setsize-no-crash/make-serial-process ()
644 "Check that Emacs doesn't crash when trying to use more than 652 "Check that Emacs doesn't crash when trying to use more than
645FD_SETSIZE file descriptors (Bug#24325)." 653FD_SETSIZE file descriptors (Bug#24325)."
654 ;; This test cannot be run if PTYs aren't supported.
655 (skip-unless (not (eq system-type 'windows-nt)))
646 (with-timeout (60 (ert-fail "Test timed out")) 656 (with-timeout (60 (ert-fail "Test timed out"))
647 (process-tests--with-processes processes 657 (process-tests--with-processes processes
648 ;; In order to use `make-serial-process', we need to create some 658 ;; In order to use `make-serial-process', we need to create some
@@ -664,6 +674,15 @@ FD_SETSIZE file descriptors (Bug#24325)."
664 (tty-name (process-tty-name host))) 674 (tty-name (process-tty-name host)))
665 (should (processp host)) 675 (should (processp host))
666 (push host processes) 676 (push host processes)
677 ;; FIXME: The assumption below that using :connection 'pty
678 ;; in make-process necessarily produces a process with PTY
679 ;; connection is unreliable and non-portable.
680 ;; make-process can legitimately and silently fall back on
681 ;; pipes if allocating a PTY fails (and on MS-Windows it
682 ;; always fails). The following code also assumes that
683 ;; process-tty-name produces a file name that can be
684 ;; passed to 'stat' and to make-serial-process, which is
685 ;; also non-portable.
667 (should tty-name) 686 (should tty-name)
668 (should (file-exists-p tty-name)) 687 (should (file-exists-p tty-name))
669 (should-not (member tty-name tty-names)) 688 (should-not (member tty-name tty-names))