aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2021-04-13 12:06:23 +0200
committerAndrea Corallo2021-04-13 12:06:23 +0200
commitb064ddd3f600ed28e62b09d556ecced5f80d9883 (patch)
tree2ddf4889f385beb34cd064f245a7e59265377c37
parent2d23f19e7d5ff8a1ec1a188dcd530c185029d1f8 (diff)
parent6de79542e43ece9a12ebc032c275a6c3fee0b73b (diff)
downloademacs-b064ddd3f600ed28e62b09d556ecced5f80d9883.tar.gz
emacs-b064ddd3f600ed28e62b09d556ecced5f80d9883.zip
Merge remote-tracking branch 'savannah/master' into native-comp
-rw-r--r--.gitignore8
-rw-r--r--admin/grammars/Makefile.in13
-rwxr-xr-xadmin/update_autogen12
-rw-r--r--configure.ac31
-rw-r--r--doc/emacs/buffers.texi9
-rw-r--r--doc/emacs/search.texi8
-rw-r--r--doc/lispref/edebug.texi10
-rw-r--r--doc/lispref/elisp.texi1
-rw-r--r--doc/lispref/frames.texi5
-rw-r--r--doc/lispref/modes.texi64
-rw-r--r--doc/misc/eww.texi19
-rw-r--r--doc/misc/tramp.texi27
-rw-r--r--etc/NEWS55
-rw-r--r--lib-src/Makefile.in39
-rw-r--r--lib-src/seccomp-filter.c363
-rw-r--r--lisp/array.el54
-rw-r--r--lisp/autoarg.el4
-rw-r--r--lisp/autorevert.el4
-rw-r--r--lisp/calculator.el9
-rw-r--r--lisp/calendar/icalendar.el26
-rw-r--r--lisp/calendar/parse-time.el62
-rw-r--r--lisp/cedet/semantic/decorate/mode.el2
-rw-r--r--lisp/cedet/semantic/grammar.el7
-rw-r--r--lisp/cedet/semantic/grm-wy-boot.el (renamed from lisp/cedet/semantic/grammar-wy.el)0
-rw-r--r--lisp/cedet/semantic/idle.el3
-rw-r--r--lisp/cmuscheme.el103
-rw-r--r--lisp/comint.el25
-rw-r--r--lisp/cus-dep.el6
-rw-r--r--lisp/dired-aux.el2
-rw-r--r--lisp/dirtrack.el4
-rw-r--r--lisp/dynamic-setting.el7
-rw-r--r--lisp/edmacro.el36
-rw-r--r--lisp/emacs-lisp/byte-opt.el10
-rw-r--r--lisp/emacs-lisp/cconv.el2
-rw-r--r--lisp/emacs-lisp/checkdoc.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el7
-rw-r--r--lisp/emacs-lisp/easy-mmode.el197
-rw-r--r--lisp/emacs-lisp/easymenu.el8
-rw-r--r--lisp/emacs-lisp/edebug.el22
-rw-r--r--lisp/emacs-lisp/eieio-base.el3
-rw-r--r--lisp/emacs-lisp/float-sup.el1
-rw-r--r--lisp/emacs-lisp/macroexp.el3
-rw-r--r--lisp/emacs-lisp/memory-report.el18
-rw-r--r--lisp/emacs-lisp/smie.el34
-rw-r--r--lisp/emacs-lisp/tabulated-list.el19
-rw-r--r--lisp/epa-file.el4
-rw-r--r--lisp/epa-mail.el2
-rw-r--r--lisp/erc/erc-dcc.el24
-rw-r--r--lisp/erc/erc-fill.el1
-rw-r--r--lisp/erc/erc-track.el9
-rw-r--r--lisp/erc/erc.el27
-rw-r--r--lisp/eshell/esh-proc.el38
-rw-r--r--lisp/eshell/esh-util.el166
-rw-r--r--lisp/facemenu.el1
-rw-r--r--lisp/files-x.el4
-rw-r--r--lisp/files.el28
-rw-r--r--lisp/find-file.el300
-rw-r--r--lisp/foldout.el52
-rw-r--r--lisp/font-core.el1
-rw-r--r--lisp/frame.el125
-rw-r--r--lisp/generic-x.el335
-rw-r--r--lisp/gnus/gnus-cite.el4
-rw-r--r--lisp/gnus/message.el180
-rw-r--r--lisp/gnus/nnagent.el1
-rw-r--r--lisp/hippie-exp.el53
-rw-r--r--lisp/ibuf-ext.el152
-rw-r--r--lisp/ibuf-macs.el32
-rw-r--r--lisp/icomplete.el42
-rw-r--r--lisp/image-mode.el3
-rw-r--r--lisp/informat.el4
-rw-r--r--lisp/international/ja-dic-cnv.el6
-rw-r--r--lisp/isearch.el88
-rw-r--r--lisp/jka-compr.el27
-rw-r--r--lisp/loadhist.el2
-rw-r--r--lisp/loadup.el18
-rw-r--r--lisp/mail/rmailmm.el2
-rw-r--r--lisp/mh-e/mh-search.el40
-rw-r--r--lisp/mh-e/mh-thread.el36
-rw-r--r--lisp/mh-e/mh-utils.el4
-rw-r--r--lisp/minibuffer.el13
-rw-r--r--lisp/misearch.el28
-rw-r--r--lisp/msb.el79
-rw-r--r--lisp/net/eww.el10
-rw-r--r--lisp/net/goto-addr.el8
-rw-r--r--lisp/net/net-utils.el12
-rw-r--r--lisp/net/rcirc.el7
-rw-r--r--lisp/net/shr.el12
-rw-r--r--lisp/net/tramp-sh.el130
-rw-r--r--lisp/net/tramp.el42
-rw-r--r--lisp/obsolete/iswitchb.el2
-rw-r--r--lisp/obsolete/pc-select.el2
-rw-r--r--lisp/org/org-capture.el2
-rw-r--r--lisp/org/org-indent.el2
-rw-r--r--lisp/org/org-list.el2
-rw-r--r--lisp/org/org-src.el2
-rw-r--r--lisp/org/org-table.el6
-rw-r--r--lisp/org/org.el2
-rw-r--r--lisp/org/ox-beamer.el8
-rw-r--r--lisp/outline.el5
-rw-r--r--lisp/progmodes/bug-reference.el6
-rw-r--r--lisp/progmodes/cc-align.el5
-rw-r--r--lisp/progmodes/cc-awk.el2
-rw-r--r--lisp/progmodes/cc-bytecomp.el5
-rw-r--r--lisp/progmodes/cc-cmds.el78
-rw-r--r--lisp/progmodes/cc-defs.el2
-rw-r--r--lisp/progmodes/cc-engine.el17
-rw-r--r--lisp/progmodes/cc-fonts.el8
-rw-r--r--lisp/progmodes/cc-guess.el2
-rw-r--r--lisp/progmodes/cc-langs.el16
-rw-r--r--lisp/progmodes/cc-menus.el2
-rw-r--r--lisp/progmodes/cc-mode.el2
-rw-r--r--lisp/progmodes/cc-styles.el4
-rw-r--r--lisp/progmodes/cc-vars.el5
-rw-r--r--lisp/progmodes/cmacexp.el37
-rw-r--r--lisp/progmodes/elisp-mode.el2
-rw-r--r--lisp/progmodes/flymake.el5
-rw-r--r--lisp/progmodes/project.el42
-rw-r--r--lisp/progmodes/ps-mode.el38
-rw-r--r--lisp/progmodes/python.el3
-rw-r--r--lisp/progmodes/sh-script.el2
-rw-r--r--lisp/progmodes/sql.el4
-rw-r--r--lisp/progmodes/verilog-mode.el40
-rw-r--r--lisp/progmodes/vhdl-mode.el981
-rw-r--r--lisp/ps-bdf.el4
-rw-r--r--lisp/ps-mule.el46
-rw-r--r--lisp/rect.el2
-rw-r--r--lisp/repeat.el84
-rw-r--r--lisp/replace.el34
-rw-r--r--lisp/ruler-mode.el2
-rw-r--r--lisp/scroll-all.el2
-rw-r--r--lisp/shadowfile.el91
-rw-r--r--lisp/shell.el2
-rw-r--r--lisp/simple.el1
-rw-r--r--lisp/so-long.el2
-rw-r--r--lisp/startup.el5
-rw-r--r--lisp/strokes.el2
-rw-r--r--lisp/tab-bar.el22
-rw-r--r--lisp/tar-mode.el40
-rw-r--r--lisp/textmodes/ispell.el2
-rw-r--r--lisp/textmodes/refer.el16
-rw-r--r--lisp/textmodes/remember.el2
-rw-r--r--lisp/textmodes/rst.el12
-rw-r--r--lisp/textmodes/sgml-mode.el2
-rw-r--r--lisp/textmodes/tildify.el2
-rw-r--r--lisp/vc/log-edit.el7
-rw-r--r--lisp/vc/pcvs.el2
-rw-r--r--lisp/vt-control.el16
-rw-r--r--lisp/window.el4
-rw-r--r--lisp/winner.el19
-rw-r--r--src/emacs.c208
-rw-r--r--src/xdisp.c147
-rw-r--r--test/Makefile.in2
-rw-r--r--test/lisp/calculator-tests.el51
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el230
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el14
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el25
-rw-r--r--test/lisp/loadhist-tests.el57
-rw-r--r--test/lisp/shadowfile-tests.el2
-rw-r--r--test/manual/indent/scheme.scm23
l---------test/src/emacs-resources/seccomp-filter-exec.bpf1
l---------test/src/emacs-resources/seccomp-filter.bpf1
-rw-r--r--test/src/emacs-tests.el213
162 files changed, 3645 insertions, 2589 deletions
diff --git a/.gitignore b/.gitignore
index 53611ce9190..fcbc9cd7f46 100644
--- a/.gitignore
+++ b/.gitignore
@@ -88,6 +88,7 @@ lisp/cedet/semantic/wisent/javat-wy.el
88lisp/cedet/semantic/wisent/js-wy.el 88lisp/cedet/semantic/wisent/js-wy.el
89lisp/cedet/semantic/wisent/python-wy.el 89lisp/cedet/semantic/wisent/python-wy.el
90lisp/cedet/srecode/srt-wy.el 90lisp/cedet/srecode/srt-wy.el
91lisp/cedet/semantic/grammar-wy.el
91lisp/eshell/esh-groups.el 92lisp/eshell/esh-groups.el
92lisp/finder-inf.el 93lisp/finder-inf.el
93lisp/leim/ja-dic/ 94lisp/leim/ja-dic/
@@ -189,6 +190,7 @@ lib-src/make-docfile
189lib-src/make-fingerprint 190lib-src/make-fingerprint
190lib-src/movemail 191lib-src/movemail
191lib-src/profile 192lib-src/profile
193lib-src/seccomp-filter
192lib-src/test-distrib 194lib-src/test-distrib
193lib-src/update-game-score 195lib-src/update-game-score
194nextstep/Cocoa/Emacs.base/Contents/Info.plist 196nextstep/Cocoa/Emacs.base/Contents/Info.plist
@@ -302,3 +304,9 @@ nt/emacs.rc
302nt/emacsclient.rc 304nt/emacsclient.rc
303src/gdb.ini 305src/gdb.ini
304/var/ 306/var/
307
308# Seccomp filter files.
309lib-src/seccomp-filter.bpf
310lib-src/seccomp-filter.pfc
311lib-src/seccomp-filter-exec.bpf
312lib-src/seccomp-filter-exec.pfc
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index 35ce55461f3..4172411e034 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -51,14 +51,11 @@ BOVINE = \
51 ${bovinedir}/make-by.el \ 51 ${bovinedir}/make-by.el \
52 ${bovinedir}/scm-by.el 52 ${bovinedir}/scm-by.el
53 53
54## FIXME Should include this one too: 54WISENT = \
55## ${cedetdir}/semantic/grammar-wy.el 55 ${cedetdir}/semantic/grammar-wy.el \
56## but semantic/grammar.el (which is what we use to generate grammar-wy.el) 56 ${wisentdir}/javat-wy.el \
57## requires it! https://debbugs.gnu.org/16008 57 ${wisentdir}/js-wy.el \
58WISENT = \ 58 ${wisentdir}/python-wy.el \
59 ${wisentdir}/javat-wy.el \
60 ${wisentdir}/js-wy.el \
61 ${wisentdir}/python-wy.el \
62 ${cedetdir}/srecode/srt-wy.el 59 ${cedetdir}/srecode/srt-wy.el
63 60
64ALL = ${BOVINE} ${WISENT} 61ALL = ${BOVINE} ${WISENT}
diff --git a/admin/update_autogen b/admin/update_autogen
index 35c391da19e..11c4313ae37 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -317,7 +317,7 @@ EOF
317echo "Finding loaddef targets..." 317echo "Finding loaddef targets..."
318 318
319find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \ 319find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \
320 sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ 320 sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
321 >| $tempfile || die "Error finding targets" 321 >| $tempfile || die "Error finding targets"
322 322
323genfiles= 323genfiles=
@@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error"
363 363
364 364
365## Ignore comment differences. 365## Ignore comment differences.
366[ ! "$lboot_flag" ] || \ 366[ ! "$lboot_flag" ] || \
367 diff -q -I '^;' $ldefs_in $ldefs_out || \ 367 diff -q -I '^;' $ldefs_in $ldefs_out || \
368 cp $ldefs_in $ldefs_out || die "cp ldefs_boot error" 368 cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
369 369
370# Refresh the prebuilt grammar-wy.el
371grammar_in=lisp/cedet/semantic/grammar-wy.el
372grammar_out=lisp/cedet/semantic/grm-wy-boot.el
373make -C admin/grammars/ ../../$grammar_in
374cp $grammar_in $grammar_out || die "cp grm_wy_boot error"
375
370 376
371echo "Checking status of loaddef files..." 377echo "Checking status of loaddef files..."
372 378
373## It probably would be fine to just check+commit lisp/, since 379## It probably would be fine to just check+commit lisp/, since
374## making autoloads should not effect any other files. But better 380## making autoloads should not effect any other files. But better
375## safe than sorry. 381## safe than sorry.
376modified=$(status $genfiles $ldefs_out) || die 382modified=$(status $genfiles $ldefs_out $grammar_out) || die
377 383
378 384
379commit "loaddefs" $modified || die "commit error" 385commit "loaddefs" $modified || die "commit error"
diff --git a/configure.ac b/configure.ac
index 3892eaed64b..a47871fbd89 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4302,6 +4302,22 @@ fi
4302AC_SUBST([BLESSMAIL_TARGET]) 4302AC_SUBST([BLESSMAIL_TARGET])
4303AC_SUBST([LIBS_MAIL]) 4303AC_SUBST([LIBS_MAIL])
4304 4304
4305HAVE_SECCOMP=no
4306AC_CHECK_HEADERS(
4307 [linux/seccomp.h linux/filter.h],
4308 [AC_CHECK_DECLS(
4309 [SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC],
4310 [HAVE_SECCOMP=yes], [],
4311 [[
4312 #include <linux/seccomp.h>
4313 ]])])
4314AC_SUBST([HAVE_SECCOMP])
4315
4316EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0])
4317AC_SUBST([HAVE_LIBSECCOMP])
4318AC_SUBST([LIBSECCOMP_LIBS])
4319AC_SUBST([LIBSECCOMP_CFLAGS])
4320
4305OLD_LIBS=$LIBS 4321OLD_LIBS=$LIBS
4306LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" 4322LIBS="$LIB_PTHREAD $LIB_MATH $LIBS"
4307AC_CHECK_FUNCS(accept4 fchdir gethostname \ 4323AC_CHECK_FUNCS(accept4 fchdir gethostname \
@@ -4309,7 +4325,7 @@ getrusage get_current_dir_name \
4309lrand48 random rint trunc \ 4325lrand48 random rint trunc \
4310select getpagesize setlocale newlocale \ 4326select getpagesize setlocale newlocale \
4311getrlimit setrlimit shutdown \ 4327getrlimit setrlimit shutdown \
4312pthread_sigmask strsignal setitimer timer_getoverrun \ 4328pthread_sigmask strsignal setitimer \
4313sendto recvfrom getsockname getifaddrs freeifaddrs \ 4329sendto recvfrom getsockname getifaddrs freeifaddrs \
4314gai_strerror sync \ 4330gai_strerror sync \
4315getpwent endpwent getgrent endgrent \ 4331getpwent endpwent getgrent endgrent \
@@ -5607,6 +5623,12 @@ gl_INIT
5607CFLAGS=$SAVE_CFLAGS 5623CFLAGS=$SAVE_CFLAGS
5608LIBS=$SAVE_LIBS 5624LIBS=$SAVE_LIBS
5609 5625
5626# timer_getoverrun needs the same libarary as timer_settime
5627OLD_LIBS=$LIBS
5628LIBS="$LIB_TIMER_TIME $LIBS"
5629AC_CHECK_FUNCS(timer_getoverrun)
5630LIBS=$OLD_LIBS
5631
5610if test "${opsys}" = "mingw32"; then 5632if test "${opsys}" = "mingw32"; then
5611 CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc" 5633 CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc"
5612 # Remove unneeded switches from the value of CC that goes to Makefiles 5634 # Remove unneeded switches from the value of CC that goes to Makefiles
@@ -5796,9 +5818,10 @@ optsep=
5796emacs_config_features= 5818emacs_config_features=
5797for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ 5819for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
5798 HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ 5820 HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
5799 M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND \ 5821 M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \
5800 THREADS TIFF TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS \ 5822 SOUND THREADS TIFF \
5801 X_TOOLKIT ZLIB; do 5823 TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
5824 ZLIB; do
5802 5825
5803 case $opt in 5826 case $opt in
5804 PDUMPER) val=${with_pdumper} ;; 5827 PDUMPER) val=${with_pdumper} ;;
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 3a166e404a8..bec7f37547c 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -765,6 +765,15 @@ your initialization file (@pxref{Init File}):
765the variable @code{fido-mode} to @code{t} (@pxref{Easy 765the variable @code{fido-mode} to @code{t} (@pxref{Easy
766Customization}). 766Customization}).
767 767
768@findex icomplete-vertical-mode
769@cindex Icomplete vertical mode
770
771 Icomplete mode and Fido mode display the possible completions on the
772same line as the prompt by default. To display the completion candidates
773vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or
774customize the variable @code{icomplete-vertical-mode} to @code{t}
775(@pxref{Easy Customization}).
776
768@node Buffer Menus 777@node Buffer Menus
769@subsection Customizing Buffer Menus 778@subsection Customizing Buffer Menus
770 779
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index f3c42bcea7f..38430a2ab15 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -201,6 +201,14 @@ something before the starting point, type @kbd{C-r} to switch to a
201backward search, leaving the search string unchanged. Similarly, 201backward search, leaving the search string unchanged. Similarly,
202@kbd{C-s} in a backward search switches to a forward search. 202@kbd{C-s} in a backward search switches to a forward search.
203 203
204@cindex search, changing direction
205@vindex isearch-repeat-on-direction-change
206 When you change the direction of a search, the first command you
207type will, by default, remain on the same match, and the cursor will
208move to the other end of the match. To move to another match
209immediately, customize the variable
210@code{isearch-repeat-on-direction-change} to @code{t}.
211
204@cindex search, wrapping around 212@cindex search, wrapping around
205@cindex search, overwrapped 213@cindex search, overwrapped
206@cindex wrapped search 214@cindex wrapped search
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 8942f55affb..323130f2378 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1510,11 +1510,11 @@ form specifications (that is, @code{form}, @code{body}, @code{def-form}, and
1510must be in the form itself rather than at a higher level. 1510must be in the form itself rather than at a higher level.
1511 1511
1512Backtracking is also disabled after successfully matching a quoted 1512Backtracking is also disabled after successfully matching a quoted
1513symbol or string specification, since this usually indicates a 1513symbol, string specification, or @code{&define} keyword, since this
1514recognized construct. But if you have a set of alternative constructs that 1514usually indicates a recognized construct. But if you have a set of
1515all begin with the same symbol, you can usually work around this 1515alternative constructs that all begin with the same symbol, you can
1516constraint by factoring the symbol out of the alternatives, e.g., 1516usually work around this constraint by factoring the symbol out of the
1517@code{["foo" &or [first case] [second case] ...]}. 1517alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}.
1518 1518
1519Most needs are satisfied by these two ways that backtracking is 1519Most needs are satisfied by these two ways that backtracking is
1520automatically disabled, but occasionally it is useful to explicitly 1520automatically disabled, but occasionally it is useful to explicitly
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index dade8555187..be0c835b035 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -531,6 +531,7 @@ Scoping Rules for Variable Bindings
531* Dynamic Binding Tips:: Avoiding problems with dynamic binding. 531* Dynamic Binding Tips:: Avoiding problems with dynamic binding.
532* Lexical Binding:: A different type of local variable binding. 532* Lexical Binding:: A different type of local variable binding.
533* Using Lexical Binding:: How to enable lexical binding. 533* Using Lexical Binding:: How to enable lexical binding.
534* Converting to Lexical Binding:: Convert existing code to lexical binding.
534 535
535Buffer-Local Variables 536Buffer-Local Variables
536 537
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index cd2ff8f3b31..a9d20c543da 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -2628,7 +2628,7 @@ When Emacs gets one of these commands, it generates a
2628@code{delete-frame} event, whose normal definition is a command that 2628@code{delete-frame} event, whose normal definition is a command that
2629calls the function @code{delete-frame}. @xref{Misc Events}. 2629calls the function @code{delete-frame}. @xref{Misc Events}.
2630 2630
2631@deffn Command delete-other-frames &optional frame 2631@deffn Command delete-other-frames &optional frame iconify
2632This command deletes all frames on @var{frame}'s terminal, except 2632This command deletes all frames on @var{frame}'s terminal, except
2633@var{frame}. If @var{frame} uses another frame's minibuffer, that 2633@var{frame}. If @var{frame} uses another frame's minibuffer, that
2634minibuffer frame is left untouched. The argument @var{frame} must 2634minibuffer frame is left untouched. The argument @var{frame} must
@@ -2639,6 +2639,9 @@ this command works by calling @code{delete-frame} with @var{force}
2639This function does not delete any of @var{frame}'s child frames 2639This function does not delete any of @var{frame}'s child frames
2640(@pxref{Child Frames}). If @var{frame} is a child frame, it deletes 2640(@pxref{Child Frames}). If @var{frame} is a child frame, it deletes
2641@var{frame}'s siblings only. 2641@var{frame}'s siblings only.
2642
2643With the prefix argument @var{iconify}, the frames are iconified rather
2644than deleted.
2642@end deffn 2645@end deffn
2643 2646
2644 2647
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 6cf4dd21c19..88f2f14c092 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1660,7 +1660,7 @@ reserved for users. @xref{Key Binding Conventions}.
1660 The macro @code{define-minor-mode} offers a convenient way of 1660 The macro @code{define-minor-mode} offers a convenient way of
1661implementing a mode in one self-contained definition. 1661implementing a mode in one self-contained definition.
1662 1662
1663@defmac define-minor-mode mode doc [init-value [lighter [keymap]]] keyword-args@dots{} body@dots{} 1663@defmac define-minor-mode mode doc keyword-args@dots{} body@dots{}
1664This macro defines a new minor mode whose name is @var{mode} (a 1664This macro defines a new minor mode whose name is @var{mode} (a
1665symbol). It defines a command named @var{mode} to toggle the minor 1665symbol). It defines a command named @var{mode} to toggle the minor
1666mode, with @var{doc} as its documentation string. 1666mode, with @var{doc} as its documentation string.
@@ -1675,41 +1675,12 @@ If @var{doc} is @code{nil}, the macro supplies a default documentation string
1675explaining the above. 1675explaining the above.
1676 1676
1677By default, it also defines a variable named @var{mode}, which is set to 1677By default, it also defines a variable named @var{mode}, which is set to
1678@code{t} or @code{nil} by enabling or disabling the mode. The variable 1678@code{t} or @code{nil} by enabling or disabling the mode.
1679is initialized to @var{init-value}. Except in unusual circumstances
1680(see below), this value must be @code{nil}.
1681 1679
1682The string @var{lighter} says what to display in the mode line 1680The @var{keyword-args} consist of keywords followed by
1683when the mode is enabled; if it is @code{nil}, the mode is not displayed
1684in the mode line.
1685
1686The optional argument @var{keymap} specifies the keymap for the minor
1687mode. If non-@code{nil}, it should be a variable name (whose value is
1688a keymap), a keymap, or an alist of the form
1689
1690@example
1691(@var{key-sequence} . @var{definition})
1692@end example
1693
1694@noindent
1695where each @var{key-sequence} and @var{definition} are arguments
1696suitable for passing to @code{define-key} (@pxref{Changing Key
1697Bindings}). If @var{keymap} is a keymap or an alist, this also
1698defines the variable @code{@var{mode}-map}.
1699
1700The above three arguments @var{init-value}, @var{lighter}, and
1701@var{keymap} can be (partially) omitted when @var{keyword-args} are
1702used. The @var{keyword-args} consist of keywords followed by
1703corresponding values. A few keywords have special meanings: 1681corresponding values. A few keywords have special meanings:
1704 1682
1705@table @code 1683@table @code
1706@item :group @var{group}
1707Custom group name to use in all generated @code{defcustom} forms.
1708Defaults to @var{mode} without the possible trailing @samp{-mode}.
1709@strong{Warning:} don't use this default group name unless you have
1710written a @code{defgroup} to define that group properly. @xref{Group
1711Definitions}.
1712
1713@item :global @var{global} 1684@item :global @var{global}
1714If non-@code{nil}, this specifies that the minor mode should be global 1685If non-@code{nil}, this specifies that the minor mode should be global
1715rather than buffer-local. It defaults to @code{nil}. 1686rather than buffer-local. It defaults to @code{nil}.
@@ -1719,19 +1690,34 @@ One of the effects of making a minor mode global is that the
1719through the Customize interface turns the mode on and off, and its 1690through the Customize interface turns the mode on and off, and its
1720value can be saved for future Emacs sessions (@pxref{Saving 1691value can be saved for future Emacs sessions (@pxref{Saving
1721Customizations,,, emacs, The GNU Emacs Manual}. For the saved 1692Customizations,,, emacs, The GNU Emacs Manual}. For the saved
1722variable to work, you should ensure that the @code{define-minor-mode} 1693variable to work, you should ensure that the minor mode function
1723form is evaluated each time Emacs starts; for packages that are not 1694is available each time Emacs starts; usually this is done by
1724part of Emacs, the easiest way to do this is to specify a 1695marking the @code{define-minor-mode} form as autoloaded.
1725@code{:require} keyword.
1726 1696
1727@item :init-value @var{init-value} 1697@item :init-value @var{init-value}
1728This is equivalent to specifying @var{init-value} positionally. 1698This is the value to which the @var{mode} variable is initialized.
1699Except in unusual circumstances (see below), this value must be
1700@code{nil}.
1729 1701
1730@item :lighter @var{lighter} 1702@item :lighter @var{lighter}
1731This is equivalent to specifying @var{lighter} positionally. 1703The string @var{lighter} says what to display in the mode line
1704when the mode is enabled; if it is @code{nil}, the mode is not displayed
1705in the mode line.
1732 1706
1733@item :keymap @var{keymap} 1707@item :keymap @var{keymap}
1734This is equivalent to specifying @var{keymap} positionally. 1708The optional argument @var{keymap} specifies the keymap for the minor
1709mode. If non-@code{nil}, it should be a variable name (whose value is
1710a keymap), a keymap, or an alist of the form
1711
1712@example
1713(@var{key-sequence} . @var{definition})
1714@end example
1715
1716@noindent
1717where each @var{key-sequence} and @var{definition} are arguments
1718suitable for passing to @code{define-key} (@pxref{Changing Key
1719Bindings}). If @var{keymap} is a keymap or an alist, this also
1720defines the variable @code{@var{mode}-map}.
1735 1721
1736@item :variable @var{place} 1722@item :variable @var{place}
1737This replaces the default variable @var{mode}, used to store the state 1723This replaces the default variable @var{mode}, used to store the state
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 6e82a97030e..cc546a92d63 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -124,17 +124,25 @@ which part of the document contains the ``readable'' text, and will
124only display this part. This usually gets rid of menus and the like. 124only display this part. This usually gets rid of menus and the like.
125 125
126@findex eww-toggle-fonts 126@findex eww-toggle-fonts
127@findex shr-use-fonts 127@vindex shr-use-fonts
128@kindex F 128@kindex F
129 The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use 129 The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use
130variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable. 130variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable.
131 131
132@findex eww-toggle-colors 132@findex eww-toggle-colors
133@findex shr-use-colors 133@vindex shr-use-colors
134@kindex F 134@kindex M-C
135 The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use 135 The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use
136HTML-specified colors or not. This sets the @code{shr-use-colors} variable. 136HTML-specified colors or not. This sets the @code{shr-use-colors} variable.
137 137
138@findex eww-toggle-images
139@vindex shr-inhibit-images
140@kindex M-I
141@cindex Image Display
142 The @kbd{M-I} command (@code{eww-toggle-images}, capital letter i)
143toggles whether to display images or not. This also sets the
144@code{shr-inhibit-images} variable.
145
138@findex eww-download 146@findex eww-download
139@vindex eww-download-directory 147@vindex eww-download-directory
140@kindex d 148@kindex d
@@ -305,6 +313,11 @@ of the width and height. If Emacs supports image scaling (ImageMagick
305support required) then larger images are scaled down. You can block 313support required) then larger images are scaled down. You can block
306specific images completely by customizing @code{shr-blocked-images}. 314specific images completely by customizing @code{shr-blocked-images}.
307 315
316@vindex shr-inhibit-images
317 You can control image display by customizing
318@code{shr-inhibit-images}. If this variable is @code{nil}, display
319the ``ALT'' text of images instead.
320
308@vindex shr-color-visible-distance-min 321@vindex shr-color-visible-distance-min
309@vindex shr-color-visible-luminance-min 322@vindex shr-color-visible-luminance-min
310@cindex Contrast 323@cindex Contrast
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 5ea0275bafe..40245acb8e5 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5067,6 +5067,33 @@ remote files}.
5067 5067
5068 5068
5069@item 5069@item
5070How to prevent @value{tramp} from clearing the @code{recentf-list}?
5071
5072When @value{tramp} cleans a connection, it removes the respective
5073remote file name(s) from @code{recentf-list}. This is needed, because
5074an unresponsive remote host could trigger @code{recentf} to connect
5075that host again and again.
5076
5077If you find the cleanup disturbing, because the file names in
5078@code{recentf-list} are precious to you, you could add the following
5079two forms in your @file{~/.emacs} after loading the @code{tramp} and
5080@code{recentf} packages:
5081
5082@lisp
5083@group
5084(remove-hook
5085 'tramp-cleanup-connection-hook
5086 #'tramp-recentf-cleanup)
5087@end group
5088@group
5089(remove-hook
5090 'tramp-cleanup-all-connections-hook
5091 #'tramp-recentf-cleanup-all)
5092@end group
5093@end lisp
5094
5095
5096@item
5070I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d} 5097I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d}
5071 5098
5072@value{tramp} comes with compatibility code for different Emacs 5099@value{tramp} comes with compatibility code for different Emacs
diff --git a/etc/NEWS b/etc/NEWS
index 720a14248e4..01f4a448b81 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -95,6 +95,17 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit
95true color by setting 'COLORTERM=truecolor' in the environment. This is 95true color by setting 'COLORTERM=truecolor' in the environment. This is
96useful on systems such as FreeBSD which ships only with "etc/termcap". 96useful on systems such as FreeBSD which ships only with "etc/termcap".
97 97
98** Emacs now supports loading a Secure Computing filter.
99This is supported only on capable GNU/Linux systems. To activate,
100invoke Emacs with the '--seccomp=FILE' command-line option. FILE must
101name a binary file containing an array of 'struct sock_filter'
102structures. Emacs will then install that list of Secure Computing
103filters into its own process early during the startup process. You
104can use this functionality to put an Emacs process in a sandbox to
105avoid security issues when executing untrusted code. See the manual
106page for 'seccomp' system call, for details about Secure Computing
107filters.
108
98 109
99* Changes in Emacs 28.1 110* Changes in Emacs 28.1
100 111
@@ -270,6 +281,9 @@ input using the minibuffer.
270* Editing Changes in Emacs 28.1 281* Editing Changes in Emacs 28.1
271 282
272+++ 283+++
284** A prefix arg now causes 'delete-other-frames' to only iconify frames
285
286+++
273** New command 'execute-extended-command-for-buffer'. 287** New command 'execute-extended-command-for-buffer'.
274This new command, bound to 'M-S-x', works like 288This new command, bound to 'M-S-x', works like
275'execute-extended-command', but limits the set of commands to the 289'execute-extended-command', but limits the set of commands to the
@@ -372,6 +386,12 @@ trying to be non-destructive.
372This command opens a new buffer called "*Memory Report*" and gives a 386This command opens a new buffer called "*Memory Report*" and gives a
373summary of where Emacs is using memory currently. 387summary of where Emacs is using memory currently.
374 388
389+++
390** New user option 'isearch-repeat-on-direction-change'.
391When this option is set, direction changes in Isearch move to another
392search match, if there is one, instead of moving point to the other
393end of the current match.
394
375** Outline 395** Outline
376 396
377+++ 397+++
@@ -482,6 +502,13 @@ documented.
482SMIE is now always enabled and 'ruby-use-smie' only controls whether 502SMIE is now always enabled and 'ruby-use-smie' only controls whether
483indentation is done using SMIE or with the old ad-hoc code. 503indentation is done using SMIE or with the old ad-hoc code.
484 504
505** Icomplete
506
507+++
508*** New minor mode Icomplete-Vertical mode.
509This mode is intended to be used with Icomplete or Fido, to display the
510list of completions candidates vertically instead of horizontally.
511
485--- 512---
486** Specific warnings can now be disabled from the warning buffer. 513** Specific warnings can now be disabled from the warning buffer.
487When a warning is displayed to the user, the resulting buffer now has 514When a warning is displayed to the user, the resulting buffer now has
@@ -934,6 +961,14 @@ take the actual screenshot, and defaults to "ImageMagick import".
934A server entry retrieved by auth-source can request a desired smtp 961A server entry retrieved by auth-source can request a desired smtp
935authentication mechanism by setting a value for the key 'smtp-auth'. 962authentication mechanism by setting a value for the key 'smtp-auth'.
936 963
964** Search and Replace
965
966*** New user option 'isearch-wrap-pause' defines how to wrap the search.
967There are choices to disable wrapping completely and to wrap immediately.
968When wrapping immediately, it consistently handles the numeric arguments
969of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
970continuing with the remaining count after wrapping.
971
937** Grep 972** Grep
938 973
939+++ 974+++
@@ -2264,6 +2299,10 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
2264'M-g n n p p' to navigate next-error matches. Any other key exits 2299'M-g n n p p' to navigate next-error matches. Any other key exits
2265transient mode and then is executed normally. 'repeat-exit-key' 2300transient mode and then is executed normally. 'repeat-exit-key'
2266defines an additional key to exit mode like 'isearch-exit' ('RET'). 2301defines an additional key to exit mode like 'isearch-exit' ('RET').
2302With 'repeat-keep-prefix' you can keep the prefix arg of the previous command.
2303For example, this can help to reverse the window navigation direction
2304with e.g. 'C-x o M-- o o'. Also it can help to set a new step with
2305e.g. 'C-x { C-5 { { {' will set the window resizing step to 5 columns.
2267 2306
2268 2307
2269* New Modes and Packages in Emacs 28.1 2308* New Modes and Packages in Emacs 28.1
@@ -2340,6 +2379,11 @@ This is to keep the same behavior as Eshell.
2340 2379
2341* Incompatible Lisp Changes in Emacs 28.1 2380* Incompatible Lisp Changes in Emacs 28.1
2342 2381
2382+++
2383** The use of positional arguments in 'define-minor-mode' is obsolete.
2384These were actually rendered obsolete in Emacs-21 but were never
2385marked as such.
2386
2343** 'facemenu-color-alist' is now obsolete, and is not used. 2387** 'facemenu-color-alist' is now obsolete, and is not used.
2344 2388
2345** 'facemenu.el' is no longer preloaded. 2389** 'facemenu.el' is no longer preloaded.
@@ -2404,11 +2448,6 @@ parameter.
2404by mistake and were not useful to Lisp code. 2448by mistake and were not useful to Lisp code.
2405 2449
2406--- 2450---
2407** Loading 'generic-x' unconditionally loads all modes.
2408The user option 'generic-extras-enable-list' is now obsolete, and
2409setting it has no effect.
2410
2411---
2412** The 'load-dangerous-libraries' variable is now obsolete. 2451** The 'load-dangerous-libraries' variable is now obsolete.
2413It was used to allow loading Lisp libraries compiled by XEmacs, a 2452It was used to allow loading Lisp libraries compiled by XEmacs, a
2414modified version of Emacs which is no longer actively maintained. 2453modified version of Emacs which is no longer actively maintained.
@@ -2524,6 +2563,12 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete',
2524 2563
2525** The 'values' variable is now obsolete. 2564** The 'values' variable is now obsolete.
2526 2565
2566+++
2567** The '&define' keyword in an Edebug specification now disables backtracking.
2568The implementation was buggy, and multiple &define forms in an &or
2569form should be exceedingly rare. See the Info node 'Backtracking' in
2570the Emacs Lisp reference manual for background.
2571
2527 2572
2528* Lisp Changes in Emacs 28.1 2573* Lisp Changes in Emacs 28.1
2529 2574
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 05eb524d19b..923d0cf5e72 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -189,6 +189,30 @@ LIB_WSOCK32=@LIB_WSOCK32@
189## Extra libraries for etags 189## Extra libraries for etags
190LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) 190LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM)
191 191
192HAVE_SECCOMP=@HAVE_SECCOMP@
193HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@
194LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@
195LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@
196
197# Currently, we can only generate seccomp filter files for x86-64.
198ifeq ($(HAVE_SECCOMP),yes)
199ifeq ($(HAVE_LIBSECCOMP),yes)
200ifeq ($(shell uname -m),x86_64)
201# We require SECCOMP_RET_KILL_PROCESS, which is only available in
202# Linux 4.14 and later.
203ifeq ($(shell { echo 4.14; uname -r | cut -d . -f 1-2; } | \
204 sort -C -t . -n -k 1,1 -k 2,2 && \
205 echo 1),1)
206SECCOMP_FILTER=1
207endif
208endif
209endif
210endif
211
212ifeq ($(SECCOMP_FILTER),1)
213DONT_INSTALL += seccomp-filter$(EXEEXT)
214endif
215
192## Extra libraries to use when linking movemail. 216## Extra libraries to use when linking movemail.
193LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \ 217LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
194 $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS) 218 $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS)
@@ -218,6 +242,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h
218 242
219all: ${EXE_FILES} ${SCRIPTS} 243all: ${EXE_FILES} ${SCRIPTS}
220 244
245ifeq ($(SECCOMP_FILTER),1)
246all: seccomp-filter.bpf seccomp-filter-exec.bpf
247endif
248
221.PHONY: all need-blessmail maybe-blessmail 249.PHONY: all need-blessmail maybe-blessmail
222 250
223LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM) 251LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
@@ -400,4 +428,15 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h)
400emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico 428emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico
401 $(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< 429 $(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $<
402 430
431ifeq ($(SECCOMP_FILTER),1)
432seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h)
433 $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \
434 $(LIBSECCOMP_LIBS) -o $@
435
436seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT)
437 $(AM_V_GEN)./seccomp-filter$(EXEEXT) \
438 seccomp-filter.bpf seccomp-filter.pfc \
439 seccomp-filter-exec.bpf seccomp-filter-exec.pfc
440endif
441
403## Makefile ends here. 442## Makefile ends here.
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
new file mode 100644
index 00000000000..fc3c3a0c074
--- /dev/null
+++ b/lib-src/seccomp-filter.c
@@ -0,0 +1,363 @@
1/* Generate a Secure Computing filter definition file.
2
3Copyright (C) 2020-2021 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify it
8under the terms of the GNU General Public License as published by the
9Free Software Foundation, either version 3 of the License, or (at your
10option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful, but
13WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see
19<https://www.gnu.org/licenses/>. */
20
21/* This program creates a small Secure Computing filter usable for a
22typical minimal Emacs sandbox. See the man page for `seccomp' for
23details about Secure Computing filters. This program requires the
24`libseccomp' library. However, the resulting filter file requires
25only a Linux kernel supporting the Secure Computing extension.
26
27Usage:
28
29 seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc
30
31This writes the raw `struct sock_filter' array to out.bpf and a
32human-readable representation to out.pfc. Additionally, it writes
33variants of those files that can be used to sandbox Emacs before
34'execve' to out-exec.bpf and out-exec.pfc. */
35
36#include "config.h"
37
38#include <errno.h>
39#include <limits.h>
40#include <stdarg.h>
41#include <stdbool.h>
42#include <stdlib.h>
43#include <stdint.h>
44#include <stdio.h>
45#include <time.h>
46
47#include <asm/prctl.h>
48#include <sys/ioctl.h>
49#include <sys/mman.h>
50#include <sys/prctl.h>
51#include <sys/types.h>
52#include <sys/stat.h>
53#include <linux/futex.h>
54#include <linux/filter.h>
55#include <linux/seccomp.h>
56#include <fcntl.h>
57#include <sched.h>
58#include <seccomp.h>
59#include <unistd.h>
60
61#include "verify.h"
62
63static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void
64fail (int error, const char *format, ...)
65{
66 va_list ap;
67 va_start (ap, format);
68 if (error == 0)
69 {
70 vfprintf (stderr, format, ap);
71 fputc ('\n', stderr);
72 }
73 else
74 {
75 char buffer[1000];
76 vsnprintf (buffer, sizeof buffer, format, ap);
77 errno = error;
78 perror (buffer);
79 }
80 va_end (ap);
81 fflush (NULL);
82 exit (EXIT_FAILURE);
83}
84
85/* This binary is trivial, so we use a single global filter context
86 object that we release using `atexit'. */
87
88static scmp_filter_ctx ctx;
89
90static void
91release_context (void)
92{
93 seccomp_release (ctx);
94}
95
96/* Wrapper functions and macros for libseccomp functions. We exit
97 immediately upon any error to avoid error checking noise. */
98
99static void
100set_attribute (enum scmp_filter_attr attr, uint32_t value)
101{
102 int status = seccomp_attr_set (ctx, attr, value);
103 if (status < 0)
104 fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value);
105}
106
107/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you
108 don't have to specify the number of comparator arguments, and any
109 failure will exit the process. */
110
111#define RULE(action, syscall, ...) \
112 do \
113 { \
114 const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \
115 enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \
116 int status = seccomp_rule_add_array (ctx, (action), (syscall), \
117 arg_cnt, arg_array); \
118 if (status < 0) \
119 fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \
120 #action, #syscall, arg_cnt, #__VA_ARGS__); \
121 } \
122 while (false)
123
124static void
125export_filter (const char *file,
126 int (*function) (const scmp_filter_ctx, int),
127 const char *name)
128{
129 int fd = TEMP_FAILURE_RETRY (
130 open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC,
131 0644));
132 if (fd < 0)
133 fail (errno, "open %s", file);
134 int status = function (ctx, fd);
135 if (status < 0)
136 fail (-status, "%s", name);
137 if (close (fd) != 0)
138 fail (errno, "close");
139}
140
141#define EXPORT_FILTER(file, function) \
142 export_filter ((file), (function), #function)
143
144int
145main (int argc, char **argv)
146{
147 if (argc != 5)
148 fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc",
149 argv[0]);
150
151 /* Any unhandled syscall should abort the Emacs process. */
152 ctx = seccomp_init (SCMP_ACT_KILL_PROCESS);
153 if (ctx == NULL)
154 fail (0, "seccomp_init");
155 atexit (release_context);
156
157 /* We want to abort immediately if the architecture is unknown. */
158 set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS);
159 set_attribute (SCMP_FLTATR_CTL_NNP, 1);
160 set_attribute (SCMP_FLTATR_CTL_TSYNC, 1);
161
162 verify (CHAR_BIT == 8);
163 verify (sizeof (int) == 4 && INT_MIN == INT32_MIN
164 && INT_MAX == INT32_MAX);
165 verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN
166 && LONG_MAX == INT64_MAX);
167 verify (sizeof (void *) == 8);
168 verify ((uintptr_t) NULL == 0);
169
170 /* Allow a clean exit. */
171 RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit));
172 RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group));
173
174 /* Allow `mmap' and friends. This is necessary for dynamic loading,
175 reading the portable dump file, and thread creation. We don't
176 allow pages to be both writable and executable. */
177 verify (MAP_PRIVATE != 0);
178 verify (MAP_SHARED != 0);
179 RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
180 SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
181 ~(PROT_NONE | PROT_READ | PROT_WRITE)),
182 /* Only support known flags. MAP_DENYWRITE is ignored, but
183 some versions of the dynamic loader still use it. Also
184 allow allocating thread stacks. */
185 SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
186 ~(MAP_PRIVATE | MAP_FILE | MAP_ANONYMOUS
187 | MAP_FIXED | MAP_DENYWRITE | MAP_STACK
188 | MAP_NORESERVE),
189 0));
190 RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
191 SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
192 ~(PROT_NONE | PROT_READ | PROT_EXEC)),
193 /* Only support known flags. MAP_DENYWRITE is ignored, but
194 some versions of the dynamic loader still use it. */
195 SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
196 ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED
197 | MAP_DENYWRITE),
198 0));
199 RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap));
200 RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect),
201 /* Don't allow making pages executable. */
202 SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
203 ~(PROT_NONE | PROT_READ | PROT_WRITE), 0));
204
205 /* Futexes are used everywhere. */
206 RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex),
207 SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE));
208
209 /* Allow basic dynamic memory management. */
210 RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk));
211
212 /* Allow some status inquiries. */
213 RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname));
214 RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid));
215 RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid));
216 RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid));
217 RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp));
218
219 /* Allow operations on open file descriptors. File descriptors are
220 capabilities, and operating on them shouldn't cause security
221 issues. */
222 RULE (SCMP_ACT_ALLOW, SCMP_SYS (read));
223 RULE (SCMP_ACT_ALLOW, SCMP_SYS (write));
224 RULE (SCMP_ACT_ALLOW, SCMP_SYS (close));
225 RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek));
226 RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup));
227 RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2));
228 RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat));
229
230 /* Allow read operations on the filesystem. If necessary, these
231 should be further restricted using mount namespaces. */
232 RULE (SCMP_ACT_ALLOW, SCMP_SYS (access));
233 RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat));
234 RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat));
235 RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64));
236 RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat));
237 RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64));
238 RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64));
239 RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat));
240 RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink));
241 RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat));
242 RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd));
243
244 /* Allow opening files, assuming they are only opened for
245 reading. */
246 verify (O_WRONLY != 0);
247 verify (O_RDWR != 0);
248 verify (O_CREAT != 0);
249 RULE (SCMP_ACT_ALLOW, SCMP_SYS (open),
250 SCMP_A1_32 (SCMP_CMP_MASKED_EQ,
251 ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
252 | O_DIRECTORY | O_NOFOLLOW),
253 0));
254 RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat),
255 SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
256 ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
257 | O_DIRECTORY | O_NOFOLLOW),
258 0));
259
260 /* Allow `tcgetpgrp'. */
261 RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl),
262 SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO),
263 SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP));
264
265 /* Allow reading (but not setting) file flags. */
266 RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl),
267 SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
268 RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64),
269 SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
270
271 /* Allow reading random numbers from the kernel. */
272 RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom));
273
274 /* Changing the umask is uncritical. */
275 RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask));
276
277 /* Allow creation of pipes. */
278 RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe));
279 RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2));
280
281 /* Allow reading (but not changing) resource limits. */
282 RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit));
283 RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64),
284 SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
285 SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */);
286
287 /* Block changing resource limits, but don't crash. */
288 RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64),
289 SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
290 SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */);
291
292 /* Emacs installs signal handlers, which is harmless. */
293 RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction));
294 RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction));
295 RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask));
296 RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask));
297
298 /* Allow reading the current time. */
299 RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime),
300 SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME));
301 RULE (SCMP_ACT_ALLOW, SCMP_SYS (time));
302 RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday));
303
304 /* Allow timer support. */
305 RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create));
306 RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create));
307
308 /* Allow thread creation. See the NOTES section in the manual page
309 for the `clone' function. */
310 RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone),
311 SCMP_A0_64 (SCMP_CMP_MASKED_EQ,
312 /* Flags needed to create threads. See
313 create_thread in libc. */
314 ~(CLONE_VM | CLONE_FS | CLONE_FILES
315 | CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD
316 | CLONE_SETTLS | CLONE_PARENT_SETTID
317 | CLONE_CHILD_CLEARTID),
318 0));
319 RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack));
320 RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list));
321
322 /* Allow setting the process name for new threads. */
323 RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
324 SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME));
325
326 /* Allow some event handling functions used by glib. */
327 RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd));
328 RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2));
329 RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4));
330 RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll));
331
332 /* Don't allow creating sockets (network access would be extremely
333 dangerous), but also don't crash. */
334 RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket));
335
336 EXPORT_FILTER (argv[1], seccomp_export_bpf);
337 EXPORT_FILTER (argv[2], seccomp_export_pfc);
338
339 /* When applying a Seccomp filter before executing the Emacs binary
340 (e.g. using the `bwrap' program), we need to allow further system
341 calls. Firstly, the wrapper binary will need to `execve' the
342 Emacs binary. Furthermore, the C library requires some system
343 calls at startup time to set up thread-local storage. */
344 RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve));
345 RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address));
346 RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl),
347 SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS));
348 RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs));
349
350 /* We want to allow starting the Emacs binary itself with the
351 --seccomp flag, so we need to allow the `prctl' and `seccomp'
352 system calls. */
353 RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
354 SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS),
355 SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0),
356 SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0));
357 RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp),
358 SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER),
359 SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC));
360
361 EXPORT_FILTER (argv[3], seccomp_export_bpf);
362 EXPORT_FILTER (argv[4], seccomp_export_pfc);
363}
diff --git a/lisp/array.el b/lisp/array.el
index cd8971bd266..6632da55dd4 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -1,4 +1,4 @@
1;;; array.el --- array editing commands for GNU Emacs 1;;; array.el --- array editing commands for GNU Emacs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc.
4 4
@@ -769,25 +769,25 @@ Return COLUMN."
769 769
770(defvar array-mode-map 770(defvar array-mode-map
771 (let ((map (make-keymap))) 771 (let ((map (make-keymap)))
772 (define-key map "\M-ad" 'array-display-local-variables) 772 (define-key map "\M-ad" #'array-display-local-variables)
773 (define-key map "\M-am" 'array-make-template) 773 (define-key map "\M-am" #'array-make-template)
774 (define-key map "\M-ae" 'array-expand-rows) 774 (define-key map "\M-ae" #'array-expand-rows)
775 (define-key map "\M-ar" 'array-reconfigure-rows) 775 (define-key map "\M-ar" #'array-reconfigure-rows)
776 (define-key map "\M-a=" 'array-what-position) 776 (define-key map "\M-a=" #'array-what-position)
777 (define-key map "\M-ag" 'array-goto-cell) 777 (define-key map "\M-ag" #'array-goto-cell)
778 (define-key map "\M-af" 'array-fill-rectangle) 778 (define-key map "\M-af" #'array-fill-rectangle)
779 (define-key map "\C-n" 'array-next-row) 779 (define-key map "\C-n" #'array-next-row)
780 (define-key map "\C-p" 'array-previous-row) 780 (define-key map "\C-p" #'array-previous-row)
781 (define-key map "\C-f" 'array-forward-column) 781 (define-key map "\C-f" #'array-forward-column)
782 (define-key map "\C-b" 'array-backward-column) 782 (define-key map "\C-b" #'array-backward-column)
783 (define-key map "\M-n" 'array-copy-down) 783 (define-key map "\M-n" #'array-copy-down)
784 (define-key map "\M-p" 'array-copy-up) 784 (define-key map "\M-p" #'array-copy-up)
785 (define-key map "\M-f" 'array-copy-forward) 785 (define-key map "\M-f" #'array-copy-forward)
786 (define-key map "\M-b" 'array-copy-backward) 786 (define-key map "\M-b" #'array-copy-backward)
787 (define-key map "\M-\C-n" 'array-copy-row-down) 787 (define-key map "\M-\C-n" #'array-copy-row-down)
788 (define-key map "\M-\C-p" 'array-copy-row-up) 788 (define-key map "\M-\C-p" #'array-copy-row-up)
789 (define-key map "\M-\C-f" 'array-copy-column-forward) 789 (define-key map "\M-\C-f" #'array-copy-column-forward)
790 (define-key map "\M-\C-b" 'array-copy-column-backward) 790 (define-key map "\M-\C-b" #'array-copy-column-backward)
791 map) 791 map)
792 "Keymap used in array mode.") 792 "Keymap used in array mode.")
793 793
@@ -815,17 +815,17 @@ in array mode may have different values assigned to the variables.
815The variables are: 815The variables are:
816 816
817Variables you assign: 817Variables you assign:
818 array-max-row: The number of rows in the array. 818 `array-max-row': The number of rows in the array.
819 array-max-column: The number of columns in the array. 819 `array-max-column': The number of columns in the array.
820 array-columns-per-line: The number of columns in the array 820 `array-columns-per-line': The number of columns in the array
821 per line of buffer. 821 per line of buffer.
822 array-field-width: The width of each field, in characters. 822 `array-field-width': The width of each field, in characters.
823 array-rows-numbered: A logical variable describing whether to ignore 823 `array-rows-numbered': A logical variable describing whether to ignore
824 row numbers in the buffer. 824 row numbers in the buffer.
825 825
826Variables which are calculated: 826Variables which are calculated:
827 array-line-length: The number of characters in a buffer line. 827 `array-line-length': The number of characters in a buffer line.
828 array-lines-per-row: The number of buffer lines used to 828 `array-lines-per-row': The number of buffer lines used to
829 display each row. 829 display each row.
830 830
831 The following commands are available (an asterisk indicates it may 831 The following commands are available (an asterisk indicates it may
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index c2cb0c7051c..7c2c6f1030d 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -107,7 +107,7 @@ then invokes the normal binding of \\[autoarg-terminate].
107`C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times. 107`C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times.
108 108
109\\{autoarg-mode-map}" 109\\{autoarg-mode-map}"
110 nil " Aarg" autoarg-mode-map :global t :group 'keyboard) 110 :lighter" Aarg" :global t :group 'keyboard)
111 111
112;;;###autoload 112;;;###autoload
113(define-minor-mode autoarg-kp-mode 113(define-minor-mode autoarg-kp-mode
@@ -118,7 +118,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
118`kp-1' etc. to supply digit arguments. 118`kp-1' etc. to supply digit arguments.
119 119
120\\{autoarg-kp-mode-map}" 120\\{autoarg-kp-mode-map}"
121 nil " Aakp" autoarg-kp-mode-map :global t :group 'keyboard 121 :lighter " Aakp" :global t :group 'keyboard
122 (if autoarg-kp-mode 122 (if autoarg-kp-mode
123 (dotimes (i 10) 123 (dotimes (i 10)
124 (let ((sym (intern (format "kp-%d" i)))) 124 (let ((sym (intern (format "kp-%d" i))))
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 57258f9c833..1bb40c90ff5 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -227,10 +227,10 @@ modes, etc., of files. You may still sometimes want to revert
227them manually. 227them manually.
228 228
229Use this option with care since it could lead to excessive auto-reverts. 229Use this option with care since it could lead to excessive auto-reverts.
230For more information, see Info node `(emacs)Autorevert'." 230For more information, see Info node `(emacs)Auto Revert'."
231 :group 'auto-revert 231 :group 'auto-revert
232 :type 'boolean 232 :type 'boolean
233 :link '(info-link "(emacs)Autorevert")) 233 :link '(info-link "(emacs)Auto Revert"))
234 234
235(defcustom global-auto-revert-ignore-modes () 235(defcustom global-auto-revert-ignore-modes ()
236 "List of major modes Global Auto-Revert Mode should not check." 236 "List of major modes Global Auto-Revert Mode should not check."
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 6dd8d9a7ec1..99c9b6290c4 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -836,10 +836,11 @@ The result should not exceed the screen width."
836 "Convert the given STR to a number, according to the value of 836 "Convert the given STR to a number, according to the value of
837`calculator-input-radix'." 837`calculator-input-radix'."
838 (if calculator-input-radix 838 (if calculator-input-radix
839 (string-to-number str (cadr (assq calculator-input-radix 839 (string-to-number str (cadr (assq calculator-input-radix
840 '((bin 2) (oct 8) (hex 16))))) 840 '((bin 2) (oct 8) (hex 16)))))
841 ;; Allow entry of "1.e3". 841 ;; parse numbers similarly to calculators
842 (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str))) 842 ;; (see tests in test/lisp/calculator-tests.el)
843 (let ((str (replace-regexp-in-string "\\.\\([^0-9].*\\)?$" ".0\\1" str)))
843 (float (string-to-number str))))) 844 (float (string-to-number str)))))
844 845
845(defun calculator-push-curnum () 846(defun calculator-push-curnum ()
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 04b525efc8a..6eb086aa14d 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -581,19 +581,19 @@ ALIST is a VTIMEZONE potentially containing historical records."
581 (list 581 (list
582 (car 582 (car
583 (sort components 583 (sort components
584 #'(lambda (a b) 584 (lambda (a b)
585 (let* ((get-recent (lambda (n) 585 (let* ((get-recent (lambda (n)
586 (car 586 (car
587 (sort 587 (sort
588 (delq nil 588 (delq nil
589 (mapcar (lambda (p) 589 (mapcar (lambda (p)
590 (and (memq (car p) '(DTSTART RDATE)) 590 (and (memq (car p) '(DTSTART RDATE))
591 (car (cddr p)))) 591 (car (cddr p))))
592 n)) 592 n))
593 'string-greaterp)))) 593 'string-greaterp))))
594 (a-recent (funcall get-recent (car (cddr a)))) 594 (a-recent (funcall get-recent (car (cddr a))))
595 (b-recent (funcall get-recent (car (cddr b))))) 595 (b-recent (funcall get-recent (car (cddr b)))))
596 (string-greaterp a-recent b-recent)))))))) 596 (string-greaterp a-recent b-recent))))))))
597 597
598(defun icalendar--convert-all-timezones (icalendar) 598(defun icalendar--convert-all-timezones (icalendar)
599 "Convert all timezones in the ICALENDAR into an alist. 599 "Convert all timezones in the ICALENDAR into an alist.
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index aa3236cf256..5a3d2706afd 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -103,46 +103,46 @@ letters, digits, plus or minus signs or colons."
103 ((4) parse-time-months) 103 ((4) parse-time-months)
104 ((5) (100)) 104 ((5) (100))
105 ((2 1 0) 105 ((2 1 0)
106 ,#'(lambda () (and (stringp parse-time-elt) 106 ,(lambda () (and (stringp parse-time-elt)
107 (= (length parse-time-elt) 8) 107 (= (length parse-time-elt) 8)
108 (= (aref parse-time-elt 2) ?:) 108 (= (aref parse-time-elt 2) ?:)
109 (= (aref parse-time-elt 5) ?:))) 109 (= (aref parse-time-elt 5) ?:)))
110 [0 2] [3 5] [6 8]) 110 [0 2] [3 5] [6 8])
111 ((8 7) parse-time-zoneinfo 111 ((8 7) parse-time-zoneinfo
112 ,#'(lambda () (car parse-time-val)) 112 ,(lambda () (car parse-time-val))
113 ,#'(lambda () (cadr parse-time-val))) 113 ,(lambda () (cadr parse-time-val)))
114 ((8) 114 ((8)
115 ,#'(lambda () 115 ,(lambda ()
116 (and (stringp parse-time-elt) 116 (and (stringp parse-time-elt)
117 (= 5 (length parse-time-elt)) 117 (= 5 (length parse-time-elt))
118 (or (= (aref parse-time-elt 0) ?+) 118 (or (= (aref parse-time-elt 0) ?+)
119 (= (aref parse-time-elt 0) ?-)))) 119 (= (aref parse-time-elt 0) ?-))))
120 ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) 120 ,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
121 (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) 121 (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
122 (if (= (aref parse-time-elt 0) ?-) -1 1)))) 122 (if (= (aref parse-time-elt 0) ?-) -1 1))))
123 ((5 4 3) 123 ((5 4 3)
124 ,#'(lambda () (and (stringp parse-time-elt) 124 ,(lambda () (and (stringp parse-time-elt)
125 (= (length parse-time-elt) 10) 125 (= (length parse-time-elt) 10)
126 (= (aref parse-time-elt 4) ?-) 126 (= (aref parse-time-elt 4) ?-)
127 (= (aref parse-time-elt 7) ?-))) 127 (= (aref parse-time-elt 7) ?-)))
128 [0 4] [5 7] [8 10]) 128 [0 4] [5 7] [8 10])
129 ((2 1 0) 129 ((2 1 0)
130 ,#'(lambda () (and (stringp parse-time-elt) 130 ,(lambda () (and (stringp parse-time-elt)
131 (= (length parse-time-elt) 5) 131 (= (length parse-time-elt) 5)
132 (= (aref parse-time-elt 2) ?:))) 132 (= (aref parse-time-elt 2) ?:)))
133 [0 2] [3 5] ,#'(lambda () 0)) 133 [0 2] [3 5] ,(lambda () 0))
134 ((2 1 0) 134 ((2 1 0)
135 ,#'(lambda () (and (stringp parse-time-elt) 135 ,(lambda () (and (stringp parse-time-elt)
136 (= (length parse-time-elt) 4) 136 (= (length parse-time-elt) 4)
137 (= (aref parse-time-elt 1) ?:))) 137 (= (aref parse-time-elt 1) ?:)))
138 [0 1] [2 4] ,#'(lambda () 0)) 138 [0 1] [2 4] ,(lambda () 0))
139 ((2 1 0) 139 ((2 1 0)
140 ,#'(lambda () (and (stringp parse-time-elt) 140 ,(lambda () (and (stringp parse-time-elt)
141 (= (length parse-time-elt) 7) 141 (= (length parse-time-elt) 7)
142 (= (aref parse-time-elt 1) ?:))) 142 (= (aref parse-time-elt 1) ?:)))
143 [0 1] [2 4] [5 7]) 143 [0 1] [2 4] [5 7])
144 ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) 144 ((5) (50 110) ,(lambda () (+ 1900 parse-time-elt)))
145 ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) 145 ((5) (0 49) ,(lambda () (+ 2000 parse-time-elt))))
146 "(slots predicate extractor...)") 146 "(slots predicate extractor...)")
147;;;###autoload(put 'parse-time-rules 'risky-local-variable t) 147;;;###autoload(put 'parse-time-rules 'risky-local-variable t)
148 148
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index 78950159199..c6bf15205fd 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -254,7 +254,7 @@ available and the current buffer was set up for parsing. Return
254non-nil if the minor mode is enabled." 254non-nil if the minor mode is enabled."
255;; 255;;
256;;\\{semantic-decoration-map}" 256;;\\{semantic-decoration-map}"
257 nil nil nil 257 :lighter nil
258 (if semantic-decoration-mode 258 (if semantic-decoration-mode
259 (if (not (and (featurep 'semantic) (semantic-active-p))) 259 (if (not (and (featurep 'semantic) (semantic-active-p)))
260 (progn 260 (progn
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index dba289fdd75..4c3bb6c238b 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -31,7 +31,12 @@
31(require 'semantic/format) 31(require 'semantic/format)
32;; FIXME this is a generated file, but we need to load this file to 32;; FIXME this is a generated file, but we need to load this file to
33;; generate it! 33;; generate it!
34(require 'semantic/grammar-wy) 34;; We need `semantic/grammar-wy.el' but we're also needed to generate
35;; that file from `grammar.wy', so to break the dependency, we keep
36;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008.
37(eval-and-compile
38 (unless (require 'semantic/grammar-wy nil t)
39 (load "semantic/grm-wy-boot")))
35(require 'semantic/idle) 40(require 'semantic/idle)
36(require 'help-fns) 41(require 'help-fns)
37(require 'semantic/analyze) 42(require 'semantic/analyze)
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grm-wy-boot.el
index b3014034374..b3014034374 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grm-wy-boot.el
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 420a457b0ea..b883573a30f 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -171,7 +171,8 @@ date, and reparses while the user is idle (not typing.)
171 171
172The minor mode can be turned on only if semantic feature is 172The minor mode can be turned on only if semantic feature is
173available and the current buffer was set up for parsing. Return 173available and the current buffer was set up for parsing. Return
174non-nil if the minor mode is enabled." nil nil nil 174non-nil if the minor mode is enabled."
175 :lighter nil
175 (if semantic-idle-scheduler-mode 176 (if semantic-idle-scheduler-mode
176 (if (not (and (featurep 'semantic) (semantic-active-p))) 177 (if (not (and (featurep 'semantic) (semantic-active-p)))
177 (progn 178 (progn
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index d43cdb15c0d..18087da9ac9 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -1,7 +1,6 @@
1;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el 1;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation, 3;; Copyright (C) 1988-2021 Free Software Foundation, Inc.
4;; Inc.
5 4
6;; Author: Olin Shivers <olin.shivers@cs.cmu.edu> 5;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
7;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
@@ -26,20 +25,18 @@
26 25
27;; This is a customization of comint-mode (see comint.el) 26;; This is a customization of comint-mode (see comint.el)
28;; 27;;
29;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces 28;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
30;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al.. 29;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
31;; 8/88 30;; 8/88
32;; 31;;
33;; Please send me bug reports, bug fixes, and extensions, so that I can 32;; Please send me bug reports, bug fixes, and extensions, so that I can
34;; merge them into the master source. 33;; merge them into the master source.
35;; 34;;
36;; The changelog is at the end of this file.
37;;
38;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user 35;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
39;; interface that communicates process state back to the superior emacs by 36;; interface that communicates process state back to the superior emacs by
40;; outputting special control sequences. The Emacs package, xscheme.el, has 37;; outputting special control sequences. The Emacs package, xscheme.el, has
41;; lots and lots of special purpose code to read these control sequences, and 38;; lots and lots of special purpose code to read these control sequences, and
42;; so is very tightly integrated with the cscheme process. The cscheme 39;; so is very tightly integrated with the cscheme process. The cscheme
43;; interrupt handler and debugger read single character commands in cbreak 40;; interrupt handler and debugger read single character commands in cbreak
44;; mode; when this happens, xscheme.el switches to special keymaps that bind 41;; mode; when this happens, xscheme.el switches to special keymaps that bind
45;; the single letter command keys to emacs functions that directly send the 42;; the single letter command keys to emacs functions that directly send the
@@ -49,18 +46,18 @@
49;; 46;;
50;; Here's a summary of the pros and cons, as I see them. 47;; Here's a summary of the pros and cons, as I see them.
51;; xscheme: Tightly integrated with inferior cscheme process! A few commands 48;; xscheme: Tightly integrated with inferior cscheme process! A few commands
52;; not in cmuscheme. But. Integration is a bit of a hack. Input 49;; not in cmuscheme. But. Integration is a bit of a hack. Input
53;; history only keeps the immediately prior input. Bizarre 50;; history only keeps the immediately prior input. Bizarre
54;; keybindings. 51;; keybindings.
55;; 52;;
56;; cmuscheme: Not tightly integrated with inferior cscheme process. But. 53;; cmuscheme: Not tightly integrated with inferior cscheme process. But.
57;; Carefully integrated functionality with the entire suite of 54;; Carefully integrated functionality with the entire suite of
58;; comint-derived CMU process modes. Keybindings reminiscent of 55;; comint-derived CMU process modes. Keybindings reminiscent of
59;; Zwei and Hemlock. Good input history. A few commands not in 56;; Zwei and Hemlock. Good input history. A few commands not in
60;; xscheme. 57;; xscheme.
61;; 58;;
62;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme 59;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
63;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* 60;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
64;; Cscheme-specific; you must use cmuscheme.el. Interested parties are 61;; Cscheme-specific; you must use cmuscheme.el. Interested parties are
65;; invited to port xscheme functionality on top of comint mode... 62;; invited to port xscheme functionality on top of comint mode...
66 63
@@ -70,18 +67,18 @@
70;; Created. 67;; Created.
71;; 68;;
72;; 2/15/89 Olin 69;; 2/15/89 Olin
73;; Removed -emacs flag from process invocation. It's only useful for 70;; Removed -emacs flag from process invocation. It's only useful for
74;; cscheme, and makes cscheme assume it's running under xscheme.el, 71;; cscheme, and makes cscheme assume it's running under xscheme.el,
75;; which messes things up royally. A bug. 72;; which messes things up royally. A bug.
76;; 73;;
77;; 5/22/90 Olin 74;; 5/22/90 Olin
78;; - Upgraded to use comint-send-string and comint-send-region. 75;; - Upgraded to use comint-send-string and comint-send-region.
79;; - run-scheme now offers to let you edit the command line if 76;; - run-scheme now offers to let you edit the command line if
80;; you invoke it with a prefix-arg. M-x scheme is redundant, and 77;; you invoke it with a prefix-arg. M-x scheme is redundant, and
81;; has been removed. 78;; has been removed.
82;; - Explicit references to process "scheme" have been replaced with 79;; - Explicit references to process "scheme" have been replaced with
83;; (scheme-proc). This allows better handling of multiple process bufs. 80;; (scheme-proc). This allows better handling of multiple process bufs.
84;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. 81;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
85;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist 82;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
86;; and friends, but interested hackers might find a useful application 83;; and friends, but interested hackers might find a useful application
87;; of this facility. 84;; of this facility.
@@ -95,42 +92,37 @@
95(require 'scheme) 92(require 'scheme)
96(require 'comint) 93(require 'comint)
97 94
98
99(defgroup cmuscheme nil 95(defgroup cmuscheme nil
100 "Run a scheme process in a buffer." 96 "Run a scheme process in a buffer."
101 :group 'scheme) 97 :group 'scheme)
102 98
103;;; INFERIOR SCHEME MODE STUFF
104;;;============================================================================
105
106(defcustom inferior-scheme-mode-hook nil 99(defcustom inferior-scheme-mode-hook nil
107 "Hook for customizing inferior-scheme mode." 100 "Hook for customizing inferior-scheme mode."
108 :type 'hook 101 :type 'hook)
109 :group 'cmuscheme)
110 102
111(defvar inferior-scheme-mode-map 103(defvar inferior-scheme-mode-map
112 (let ((m (make-sparse-keymap))) 104 (let ((m (make-sparse-keymap)))
113 (define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention 105 (define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention
114 (define-key m "\C-x\C-e" 'scheme-send-last-sexp) 106 (define-key m "\C-x\C-e" #'scheme-send-last-sexp)
115 (define-key m "\C-c\C-l" 'scheme-load-file) 107 (define-key m "\C-c\C-l" #'scheme-load-file)
116 (define-key m "\C-c\C-k" 'scheme-compile-file) 108 (define-key m "\C-c\C-k" #'scheme-compile-file)
117 (scheme-mode-commands m) 109 (scheme-mode-commands m)
118 m)) 110 m))
119 111
120;; Install the process communication commands in the scheme-mode keymap. 112;; Install the process communication commands in the scheme-mode keymap.
121(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention 113(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention
122(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention 114(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention
123(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition) 115(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition)
124(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) 116(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go)
125(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) 117(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region)
126(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) 118(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go)
127(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) 119(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition)
128(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) 120(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go)
129(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure) 121(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure)
130(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form) 122(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form)
131(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) 123(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme)
132(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) 124(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file)
133(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" 125(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile"
134 126
135(let ((map (lookup-key scheme-mode-map [menu-bar scheme]))) 127(let ((map (lookup-key scheme-mode-map [menu-bar scheme])))
136 (define-key map [separator-eval] '("--")) 128 (define-key map [separator-eval] '("--"))
@@ -157,8 +149,7 @@
157 (define-key map [send-region] 149 (define-key map [send-region]
158 '("Evaluate Region" . scheme-send-region)) 150 '("Evaluate Region" . scheme-send-region))
159 (define-key map [send-sexp] 151 (define-key map [send-sexp]
160 '("Evaluate Last S-expression" . scheme-send-last-sexp)) 152 '("Evaluate Last S-expression" . scheme-send-last-sexp)))
161 )
162 153
163(defvar scheme-buffer) 154(defvar scheme-buffer)
164 155
@@ -209,8 +200,7 @@ to continue it."
209(defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" 200(defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
210 "Input matching this regexp are not saved on the history list. 201 "Input matching this regexp are not saved on the history list.
211Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters." 202Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
212 :type 'regexp 203 :type 'regexp)
213 :group 'cmuscheme)
214 204
215(defun scheme-input-filter (str) 205(defun scheme-input-filter (str)
216 "Don't save anything matching `inferior-scheme-filter-regexp'." 206 "Don't save anything matching `inferior-scheme-filter-regexp'."
@@ -242,7 +232,7 @@ is run).
242 scheme-program-name))) 232 scheme-program-name)))
243 (if (not (comint-check-proc "*scheme*")) 233 (if (not (comint-check-proc "*scheme*"))
244 (let ((cmdlist (split-string-and-unquote cmd))) 234 (let ((cmdlist (split-string-and-unquote cmd)))
245 (set-buffer (apply 'make-comint "scheme" (car cmdlist) 235 (set-buffer (apply #'make-comint "scheme" (car cmdlist)
246 (scheme-start-file (car cmdlist)) (cdr cmdlist))) 236 (scheme-start-file (car cmdlist)) (cdr cmdlist)))
247 (inferior-scheme-mode))) 237 (inferior-scheme-mode)))
248 (setq scheme-program-name cmd) 238 (setq scheme-program-name cmd)
@@ -282,8 +272,7 @@ in this order. Return nil if no start file found."
282 272
283(defcustom scheme-compile-exp-command "(compile '%s)" 273(defcustom scheme-compile-exp-command "(compile '%s)"
284 "Template for issuing commands to compile arbitrary Scheme expressions." 274 "Template for issuing commands to compile arbitrary Scheme expressions."
285 :type 'string 275 :type 'string)
286 :group 'cmuscheme)
287 276
288(defun scheme-compile-region (start end) 277(defun scheme-compile-region (start end)
289 "Compile the current region in the inferior Scheme process. 278 "Compile the current region in the inferior Scheme process.
@@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use
311 (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\") 300 (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\")
312 301
313For Scheme 48 and Scsh use \",trace %s\"." 302For Scheme 48 and Scsh use \",trace %s\"."
314 :type 'string 303 :type 'string)
315 :group 'cmuscheme)
316 304
317(defcustom scheme-untrace-command "(untrace %s)" 305(defcustom scheme-untrace-command "(untrace %s)"
318 "Template for switching off tracing of a Scheme procedure. 306 "Template for switching off tracing of a Scheme procedure.
319Scheme 48 and Scsh users should set this variable to \",untrace %s\"." 307Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
320 308 :type 'string)
321 :type 'string
322 :group 'cmuscheme)
323 309
324(defun scheme-trace-procedure (proc &optional untrace) 310(defun scheme-trace-procedure (proc &optional untrace)
325 "Trace procedure PROC in the inferior Scheme process. 311 "Trace procedure PROC in the inferior Scheme process.
@@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure PROC."
341(defcustom scheme-macro-expand-command "(expand %s)" 327(defcustom scheme-macro-expand-command "(expand %s)"
342 "Template for macro-expanding a Scheme form. 328 "Template for macro-expanding a Scheme form.
343For Scheme 48 and Scsh use \",expand %s\"." 329For Scheme 48 and Scsh use \",expand %s\"."
344 :type 'string 330 :type 'string)
345 :group 'cmuscheme)
346 331
347(defun scheme-expand-current-form () 332(defun scheme-expand-current-form ()
348 "Macro-expand the form at point in the inferior Scheme process." 333 "Macro-expand the form at point in the inferior Scheme process."
@@ -410,8 +395,7 @@ Then switch to the process buffer."
410If it's loaded into a buffer that is in one of these major modes, it's 395If it's loaded into a buffer that is in one of these major modes, it's
411considered a scheme source file by `scheme-load-file' and `scheme-compile-file'. 396considered a scheme source file by `scheme-load-file' and `scheme-compile-file'.
412Used by these commands to determine defaults." 397Used by these commands to determine defaults."
413 :type '(repeat function) 398 :type '(repeat function))
414 :group 'cmuscheme)
415 399
416(defvar scheme-prev-l/c-dir/file nil 400(defvar scheme-prev-l/c-dir/file nil
417 "Caches the last (directory . file) pair. 401 "Caches the last (directory . file) pair.
@@ -514,8 +498,7 @@ command to run."
514(defcustom cmuscheme-load-hook nil 498(defcustom cmuscheme-load-hook nil
515 "This hook is run when cmuscheme is loaded in. 499 "This hook is run when cmuscheme is loaded in.
516This is a good place to put keybindings." 500This is a good place to put keybindings."
517 :type 'hook 501 :type 'hook)
518 :group 'cmuscheme)
519(make-obsolete-variable 'cmuscheme-load-hook 502(make-obsolete-variable 'cmuscheme-load-hook
520 "use `with-eval-after-load' instead." "28.1") 503 "use `with-eval-after-load' instead." "28.1")
521 504
diff --git a/lisp/comint.el b/lisp/comint.el
index b04d404676d..ef34174305f 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1627,7 +1627,6 @@ or to the last history element for a backward search."
1627 (if isearch-forward 1627 (if isearch-forward
1628 (comint-goto-input (1- (ring-length comint-input-ring))) 1628 (comint-goto-input (1- (ring-length comint-input-ring)))
1629 (comint-goto-input nil)) 1629 (comint-goto-input nil))
1630 (setq isearch-success t)
1631 (goto-char (if isearch-forward (comint-line-beginning-position) (point-max)))) 1630 (goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
1632 1631
1633(defun comint-history-isearch-push-state () 1632(defun comint-history-isearch-push-state ()
@@ -1798,6 +1797,10 @@ Ignore duplicates if `comint-input-ignoredups' is non-nil."
1798 (min size (- comint-input-ring-size size))))) 1797 (min size (- comint-input-ring-size size)))))
1799 (ring-insert comint-input-ring cmd))) 1798 (ring-insert comint-input-ring cmd)))
1800 1799
1800(defconst comint--prompt-rear-nonsticky
1801 '(field inhibit-line-move-field-capture read-only font-lock-face)
1802 "Text properties we set on the prompt and don't want to leak past it.")
1803
1801(defun comint-send-input (&optional no-newline artificial) 1804(defun comint-send-input (&optional no-newline artificial)
1802 "Send input to process. 1805 "Send input to process.
1803After the process output mark, sends all text from the process mark to 1806After the process output mark, sends all text from the process mark to
@@ -1917,7 +1920,8 @@ Similarly for Soar, Scheme, etc."
1917 (unless (or no-newline comint-use-prompt-regexp) 1920 (unless (or no-newline comint-use-prompt-regexp)
1918 ;; Cover the terminating newline 1921 ;; Cover the terminating newline
1919 (add-text-properties end (1+ end) 1922 (add-text-properties end (1+ end)
1920 '(rear-nonsticky t 1923 `(rear-nonsticky
1924 ,comint--prompt-rear-nonsticky
1921 field boundary 1925 field boundary
1922 inhibit-line-move-field-capture t))))) 1926 inhibit-line-move-field-capture t)))))
1923 1927
@@ -2124,9 +2128,10 @@ Make backspaces delete the previous character."
2124 (unless comint-use-prompt-regexp 2128 (unless comint-use-prompt-regexp
2125 (with-silent-modifications 2129 (with-silent-modifications
2126 (add-text-properties comint-last-output-start (point) 2130 (add-text-properties comint-last-output-start (point)
2127 '(front-sticky 2131 `(rear-nonsticky
2132 ,comint--prompt-rear-nonsticky
2133 front-sticky
2128 (field inhibit-line-move-field-capture) 2134 (field inhibit-line-move-field-capture)
2129 rear-nonsticky t
2130 field output 2135 field output
2131 inhibit-line-move-field-capture t)))) 2136 inhibit-line-move-field-capture t))))
2132 2137
@@ -2155,7 +2160,9 @@ Make backspaces delete the previous character."
2155 (font-lock-prepend-text-property prompt-start (point) 2160 (font-lock-prepend-text-property prompt-start (point)
2156 'font-lock-face 2161 'font-lock-face
2157 'comint-highlight-prompt) 2162 'comint-highlight-prompt)
2158 (add-text-properties prompt-start (point) '(rear-nonsticky t))) 2163 (add-text-properties prompt-start (point)
2164 `(rear-nonsticky
2165 ,comint--prompt-rear-nonsticky)))
2159 (goto-char saved-point))))))) 2166 (goto-char saved-point)))))))
2160 2167
2161(defun comint-preinput-scroll-to-bottom () 2168(defun comint-preinput-scroll-to-bottom ()
@@ -2251,23 +2258,23 @@ This function could be on `comint-output-filter-functions' or bound to a key."
2251 (let ((inhibit-read-only t)) 2258 (let ((inhibit-read-only t))
2252 (delete-region (point-min) (point))))) 2259 (delete-region (point-min) (point)))))
2253 2260
2254(defun comint-strip-ctrl-m (&optional _string) 2261(defun comint-strip-ctrl-m (&optional _string interactive)
2255 "Strip trailing `^M' characters from the current output group. 2262 "Strip trailing `^M' characters from the current output group.
2256This function could be on `comint-output-filter-functions' or bound to a key." 2263This function could be on `comint-output-filter-functions' or bound to a key."
2257 (interactive) 2264 (interactive (list nil t))
2258 (let ((process (get-buffer-process (current-buffer)))) 2265 (let ((process (get-buffer-process (current-buffer))))
2259 (if (not process) 2266 (if (not process)
2260 ;; This function may be used in 2267 ;; This function may be used in
2261 ;; `comint-output-filter-functions', and in that case, if 2268 ;; `comint-output-filter-functions', and in that case, if
2262 ;; there's no process, then we should do nothing. If 2269 ;; there's no process, then we should do nothing. If
2263 ;; interactive, report an error. 2270 ;; interactive, report an error.
2264 (when (called-interactively-p 'interactive) 2271 (when interactive
2265 (error "No process in the current buffer")) 2272 (error "No process in the current buffer"))
2266 (let ((pmark (process-mark process))) 2273 (let ((pmark (process-mark process)))
2267 (save-excursion 2274 (save-excursion
2268 (condition-case nil 2275 (condition-case nil
2269 (goto-char 2276 (goto-char
2270 (if (called-interactively-p 'interactive) 2277 (if interactive
2271 comint-last-input-end comint-last-output-start)) 2278 comint-last-input-end comint-last-output-start))
2272 (error nil)) 2279 (error nil))
2273 (while (re-search-forward "\r+$" pmark t) 2280 (while (re-search-forward "\r+$" pmark t)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index e2b73513bd5..31a896088a5 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -1,4 +1,4 @@
1;;; cus-dep.el --- find customization dependencies 1;;; cus-dep.el --- find customization dependencies -*- 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;; 4;;
@@ -132,7 +132,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
132 'custom-where name) 132 'custom-where name)
133 ;; Eval to get the 'custom-group, -tag, 133 ;; Eval to get the 'custom-group, -tag,
134 ;; -version, group-documentation etc properties. 134 ;; -version, group-documentation etc properties.
135 (eval expr)) 135 (eval expr t))
136 ;; Eval failed for some reason. Eg maybe the 136 ;; Eval failed for some reason. Eg maybe the
137 ;; defcustom uses something defined earlier 137 ;; defcustom uses something defined earlier
138 ;; in the file (we haven't loaded the file). 138 ;; in the file (we haven't loaded the file).
@@ -164,7 +164,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
164 (let ((members (get symbol 'custom-group)) 164 (let ((members (get symbol 'custom-group))
165 where found) 165 where found)
166 (when members 166 (when members
167 (dolist (member (mapcar 'car members)) 167 (dolist (member (mapcar #'car members))
168 (setq where (get member 'custom-where)) 168 (setq where (get member 'custom-where))
169 (unless (or (null where) 169 (unless (or (null where)
170 (member where found)) 170 (member where found))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index d5f49108767..8fe612fa0b1 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2980,7 +2980,7 @@ a file name. Otherwise, it searches the whole buffer without restrictions."
2980When on, Isearch skips matches outside file names using the predicate 2980When on, Isearch skips matches outside file names using the predicate
2981`dired-isearch-filter-filenames' that matches only at file names. 2981`dired-isearch-filter-filenames' that matches only at file names.
2982When off, it uses the original predicate." 2982When off, it uses the original predicate."
2983 nil nil nil 2983 :lighter nil
2984 (if dired-isearch-filenames-mode 2984 (if dired-isearch-filenames-mode
2985 (add-function :before-while (local 'isearch-filter-predicate) 2985 (add-function :before-while (local 'isearch-filter-predicate)
2986 #'dired-isearch-filter-filenames 2986 #'dired-isearch-filter-filenames
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 7f76ef6653a..be8db75c967 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -184,7 +184,7 @@ working directory at all times, and that you set the variable
184This is an alternative to `shell-dirtrack-mode', which works by 184This is an alternative to `shell-dirtrack-mode', which works by
185tracking `cd' and similar commands which change the shell working 185tracking `cd' and similar commands which change the shell working
186directory." 186directory."
187 nil nil nil 187 :lighter nil
188 (if dirtrack-mode 188 (if dirtrack-mode
189 (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t) 189 (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
190 (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))) 190 (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
@@ -192,7 +192,7 @@ directory."
192 192
193(define-minor-mode dirtrack-debug-mode 193(define-minor-mode dirtrack-debug-mode
194 "Toggle Dirtrack debugging." 194 "Toggle Dirtrack debugging."
195 nil nil nil 195 :lighter nil
196 (if dirtrack-debug-mode 196 (if dirtrack-debug-mode
197 (display-buffer (get-buffer-create dirtrack-debug-buffer)))) 197 (display-buffer (get-buffer-create dirtrack-debug-buffer))))
198 198
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 39d2a1d1e2a..6b037aa2a6c 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -24,8 +24,8 @@
24 24
25;;; Commentary: 25;;; Commentary:
26 26
27;; This file provides the lisp part of the GConf and XSetting code in 27;; This file provides the Lisp part of the GConf and XSetting code in
28;; xsetting.c. But it is nothing that prevents it from being used by 28;; xsetting.c. But there is nothing that prevents it from being used by
29;; other configuration schemes. 29;; other configuration schemes.
30 30
31;;; Code: 31;;; Code:
@@ -92,3 +92,6 @@ Changes can be
92 92
93(define-key special-event-map [config-changed-event] 93(define-key special-event-map [config-changed-event]
94 #'dynamic-setting-handle-config-changed-event) 94 #'dynamic-setting-handle-config-changed-event)
95
96(provide 'dynamic-setting)
97;;; dynamic-setting.el ends here
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 3d7db44a86d..84de69a2ce1 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,4 +1,4 @@
1;;; edmacro.el --- keyboard macro editor 1;;; edmacro.el --- keyboard macro editor -*- 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
@@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal notation."
74 74
75(defvar edmacro-mode-map 75(defvar edmacro-mode-map
76 (let ((map (make-sparse-keymap))) 76 (let ((map (make-sparse-keymap)))
77 (define-key map "\C-c\C-c" 'edmacro-finish-edit) 77 (define-key map "\C-c\C-c" #'edmacro-finish-edit)
78 (define-key map "\C-c\C-q" 'edmacro-insert-key) 78 (define-key map "\C-c\C-q" #'edmacro-insert-key)
79 map)) 79 map))
80 80
81(defvar edmacro-store-hook) 81(defvar edmacro-store-hook)
@@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise way."
177 (set-buffer-modified-p nil)) 177 (set-buffer-modified-p nil))
178 (run-hooks 'edmacro-format-hook))))) 178 (run-hooks 'edmacro-format-hook)))))
179 179
180;;; The next two commands are provided for convenience and backward 180;; The next two commands are provided for convenience and backward
181;;; compatibility. 181;; compatibility.
182 182
183;;;###autoload 183;;;###autoload
184(defun edit-last-kbd-macro (&optional prefix) 184(defun edit-last-kbd-macro (&optional prefix)
@@ -237,8 +237,7 @@ or nil, use a compact 80-column format."
237 ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") 237 ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
238 (when edmacro-store-hook 238 (when edmacro-store-hook
239 (error "\"Command\" line not allowed in this context")) 239 (error "\"Command\" line not allowed in this context"))
240 (let ((str (buffer-substring (match-beginning 1) 240 (let ((str (match-string 1)))
241 (match-end 1))))
242 (unless (equal str "") 241 (unless (equal str "")
243 (setq cmd (and (not (equal str "none")) 242 (setq cmd (and (not (equal str "none"))
244 (intern str))) 243 (intern str)))
@@ -253,8 +252,7 @@ or nil, use a compact 80-column format."
253 (when edmacro-store-hook 252 (when edmacro-store-hook
254 (error "\"Key\" line not allowed in this context")) 253 (error "\"Key\" line not allowed in this context"))
255 (let ((key (edmacro-parse-keys 254 (let ((key (edmacro-parse-keys
256 (buffer-substring (match-beginning 1) 255 (match-string 1))))
257 (match-end 1)))))
258 (unless (equal key "") 256 (unless (equal key "")
259 (if (equal key "none") 257 (if (equal key "none")
260 (setq no-keys t) 258 (setq no-keys t)
@@ -274,16 +272,14 @@ or nil, use a compact 80-column format."
274 ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$") 272 ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
275 (when edmacro-store-hook 273 (when edmacro-store-hook
276 (error "\"Counter\" line not allowed in this context")) 274 (error "\"Counter\" line not allowed in this context"))
277 (let ((str (buffer-substring (match-beginning 1) 275 (let ((str (match-string 1)))
278 (match-end 1))))
279 (unless (equal str "") 276 (unless (equal str "")
280 (setq mac-counter (string-to-number str)))) 277 (setq mac-counter (string-to-number str))))
281 t) 278 t)
282 ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$") 279 ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$")
283 (when edmacro-store-hook 280 (when edmacro-store-hook
284 (error "\"Format\" line not allowed in this context")) 281 (error "\"Format\" line not allowed in this context"))
285 (let ((str (buffer-substring (match-beginning 1) 282 (let ((str (match-string 1)))
286 (match-end 1))))
287 (unless (equal str "") 283 (unless (equal str "")
288 (setq mac-format str))) 284 (setq mac-format str)))
289 t) 285 t)
@@ -475,7 +471,7 @@ doubt, use whitespace."
475 (and (not (memq (aref rest-mac i) pkeys)) 471 (and (not (memq (aref rest-mac i) pkeys))
476 (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") 472 (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ")
477 (cl-callf cl-subseq rest-mac i))))))) 473 (cl-callf cl-subseq rest-mac i)))))))
478 (bind-len (apply 'max 1 474 (bind-len (apply #'max 1
479 (cl-loop for map in maps 475 (cl-loop for map in maps
480 for b = (lookup-key map rest-mac) 476 for b = (lookup-key map rest-mac)
481 when b collect b))) 477 when b collect b)))
@@ -506,7 +502,7 @@ doubt, use whitespace."
506 finally return i)) 502 finally return i))
507 desc) 503 desc)
508 (if (stringp bind) (setq bind nil)) 504 (if (stringp bind) (setq bind nil))
509 (cond ((and (eq bind 'self-insert-command) (not prefix) 505 (cond ((and (eq bind #'self-insert-command) (not prefix)
510 (> text 1) (integerp first) 506 (> text 1) (integerp first)
511 (> first 32) (<= first maxkey) (/= first 92) 507 (> first 32) (<= first maxkey) (/= first 92)
512 (progn 508 (progn
@@ -520,11 +516,11 @@ doubt, use whitespace."
520 desc)))) 516 desc))))
521 (when (or (string-match "^\\^.$" desc) 517 (when (or (string-match "^\\^.$" desc)
522 (member desc res-words)) 518 (member desc res-words))
523 (setq desc (mapconcat 'char-to-string desc " "))) 519 (setq desc (mapconcat #'char-to-string desc " ")))
524 (when verbose 520 (when verbose
525 (setq bind (format "%s * %d" bind text))) 521 (setq bind (format "%s * %d" bind text)))
526 (setq bind-len text)) 522 (setq bind-len text))
527 ((and (eq bind 'execute-extended-command) 523 ((and (eq bind #'execute-extended-command)
528 (> text bind-len) 524 (> text bind-len)
529 (memq (aref rest-mac text) '(return 13)) 525 (memq (aref rest-mac text) '(return 13))
530 (progn 526 (progn
@@ -667,10 +663,8 @@ This function assumes that the events can be stored in a string."
667 (substring word 2 -2) "\r"))) 663 (substring word 2 -2) "\r")))
668 ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) 664 ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
669 (progn 665 (progn
670 (setq word (concat (substring word (match-beginning 1) 666 (setq word (concat (match-string 1 word)
671 (match-end 1)) 667 (match-string 3 word)))
672 (substring word (match-beginning 3)
673 (match-end 3))))
674 (not (string-match 668 (not (string-match
675 "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" 669 "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
676 word)))) 670 word))))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 436f5e48ae1..51b2f9bb98d 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -528,8 +528,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
528 `(condition-case ,var ;Not evaluated. 528 `(condition-case ,var ;Not evaluated.
529 ,(byte-optimize-form exp for-effect) 529 ,(byte-optimize-form exp for-effect)
530 ,@(mapcar (lambda (clause) 530 ,@(mapcar (lambda (clause)
531 `(,(car clause) 531 (let ((byte-optimize--lexvars
532 ,@(byte-optimize-body (cdr clause) for-effect))) 532 (and lexical-binding
533 (if var
534 (cons (list var t)
535 byte-optimize--lexvars)
536 byte-optimize--lexvars))))
537 (cons (car clause)
538 (byte-optimize-body (cdr clause) for-effect))))
533 clauses)))) 539 clauses))))
534 540
535 (`(unwind-protect ,exp . ,exps) 541 (`(unwind-protect ,exp . ,exps)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index afaa13a8695..b37cfebab31 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -498,7 +498,7 @@ places where they originally did not directly appear."
498 (let* ((class (and var (cconv--var-classification (list var) form))) 498 (let* ((class (and var (cconv--var-classification (list var) form)))
499 (newenv 499 (newenv
500 (cond ((eq class :captured+mutated) 500 (cond ((eq class :captured+mutated)
501 (cons `(,var . (car-save ,var)) env)) 501 (cons `(,var . (car-safe ,var)) env))
502 ((assq var env) (cons `(,var) env)) 502 ((assq var env) (cons `(,var) env))
503 (t env))) 503 (t env)))
504 (msg (when (eq class :unused) 504 (msg (when (eq class :unused)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 96b16f7ed45..00cc7777e1a 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1242,7 +1242,7 @@ bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-c
1242checking of documentation strings. 1242checking of documentation strings.
1243 1243
1244\\{checkdoc-minor-mode-map}" 1244\\{checkdoc-minor-mode-map}"
1245 nil checkdoc-minor-mode-string nil 1245 :lighter checkdoc-minor-mode-string
1246 :group 'checkdoc) 1246 :group 'checkdoc)
1247 1247
1248;;; Subst utils 1248;;; Subst utils
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 7f8f7105f33..8b2d3c413af 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous ones.
2141 ;; tail-called any more. 2141 ;; tail-called any more.
2142 (not (memq var shadowings))))) 2142 (not (memq var shadowings)))))
2143 `(,(car exp) ,bindings . ,(funcall opt-exps exps))) 2143 `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
2144 ((and `(condition-case ,err-var ,bodyform . ,handlers)
2145 (guard (not (eq err-var var))))
2146 `(condition-case ,err-var
2147 (progn (setq ,retvar ,bodyform) nil)
2148 . ,(mapcar (lambda (h)
2149 (cons (car h) (funcall opt-exps (cdr h))))
2150 handlers)))
2144 ('nil nil) ;No need to set `retvar' to return nil. 2151 ('nil nil) ;No need to set `retvar' to return nil.
2145 (_ `(progn (setq ,retvar ,exp) nil)))))) 2152 (_ `(progn (setq ,retvar ,exp) nil))))))
2146 2153
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index addb58cdbbe..e23ff5ae513 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -139,39 +139,31 @@ documenting what its argument does. If the word \"ARG\" does not
139appear in DOC, a paragraph is added to DOC explaining 139appear in DOC, a paragraph is added to DOC explaining
140usage of the mode argument. 140usage of the mode argument.
141 141
142Optional INIT-VALUE is the initial value of the mode's variable.
143 Note that the minor mode function won't be called by setting
144 this option, so the value *reflects* the minor mode's natural
145 initial state, rather than *setting* it.
146 In the vast majority of cases it should be nil.
147Optional LIGHTER is displayed in the mode line when the mode is on.
148Optional KEYMAP is the default keymap bound to the mode keymap.
149 If non-nil, it should be a variable name (whose value is a keymap),
150 or an expression that returns either a keymap or a list of
151 (KEY . BINDING) pairs where KEY and BINDING are suitable for
152 `define-key'. If you supply a KEYMAP argument that is not a
153 symbol, this macro defines the variable MODE-map and gives it
154 the value that KEYMAP specifies.
155
156BODY contains code to execute each time the mode is enabled or disabled. 142BODY contains code to execute each time the mode is enabled or disabled.
157 It is executed after toggling the mode, and before running MODE-hook. 143 It is executed after toggling the mode, and before running MODE-hook.
158 Before the actual body code, you can write keyword arguments, i.e. 144 Before the actual body code, you can write keyword arguments, i.e.
159 alternating keywords and values. If you provide BODY, then you must 145 alternating keywords and values. If you provide BODY, then you must
160 provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide 146 provide at least one keyword argument. The following special
161 at least one keyword argument, or both; otherwise, BODY would be
162 misinterpreted as the first omitted argument. The following special
163 keywords are supported (other keywords are passed to `defcustom' if 147 keywords are supported (other keywords are passed to `defcustom' if
164 the minor mode is global): 148 the minor mode is global):
165 149
166:group GROUP Custom group name to use in all generated `defcustom' forms.
167:global GLOBAL If non-nil specifies that the minor mode is not meant to be 150:global GLOBAL If non-nil specifies that the minor mode is not meant to be
168 buffer-local, so don't make the variable MODE buffer-local. 151 buffer-local, so don't make the variable MODE buffer-local.
169 By default, the mode is buffer-local. 152 By default, the mode is buffer-local.
170:init-value VAL Same as the INIT-VALUE argument. 153:init-value VAL the initial value of the mode's variable.
154 Note that the minor mode function won't be called by setting
155 this option, so the value *reflects* the minor mode's natural
156 initial state, rather than *setting* it.
157 In the vast majority of cases it should be nil.
171 Not used if you also specify :variable. 158 Not used if you also specify :variable.
172:lighter SPEC Same as the LIGHTER argument. 159:lighter SPEC Text displayed in the mode line when the mode is on.
173:keymap MAP Same as the KEYMAP argument. 160:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'.
174:require SYM Same as in `defcustom'. 161 If non-nil, it should be a variable name (whose value is
162 a keymap), or an expression that returns either a keymap or
163 a list of (KEY . BINDING) pairs where KEY and BINDING are
164 suitable for `define-key'. If you supply a KEYMAP argument
165 that is not a symbol, this macro defines the variable MODE-map
166 and gives it the value that KEYMAP specifies.
175:interactive VAL Whether this mode should be a command or not. The default 167:interactive VAL Whether this mode should be a command or not. The default
176 is to make it one; use nil to avoid that. If VAL is a list, 168 is to make it one; use nil to avoid that. If VAL is a list,
177 it's interpreted as a list of major modes this minor mode 169 it's interpreted as a list of major modes this minor mode
@@ -185,15 +177,18 @@ BODY contains code to execute each time the mode is enabled or disabled.
185 sets it. If you specify a :variable, this function does 177 sets it. If you specify a :variable, this function does
186 not define a MODE variable (nor any of the terms used 178 not define a MODE variable (nor any of the terms used
187 in :variable). 179 in :variable).
188
189:after-hook A single lisp form which is evaluated after the mode hooks 180:after-hook A single lisp form which is evaluated after the mode hooks
190 have been run. It should not be quoted. 181 have been run. It should not be quoted.
191 182
192For example, you could write 183For example, you could write
193 (define-minor-mode foo-mode \"If enabled, foo on you!\" 184 (define-minor-mode foo-mode \"If enabled, foo on you!\"
194 :lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\" 185 :lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\"
195 ...BODY CODE...)" 186 ...BODY CODE...)
187
188For backward compatibility with the Emacs<21 calling convention,
189BODY can also start with the triplet INIT-VALUE LIGHTER KEYMAP."
196 (declare (doc-string 2) 190 (declare (doc-string 2)
191 (advertised-calling-convention (mode doc &rest body) "28.1")
197 (debug (&define name string-or-null-p 192 (debug (&define name string-or-null-p
198 [&optional [&not keywordp] sexp 193 [&optional [&not keywordp] sexp
199 &optional [&not keywordp] sexp 194 &optional [&not keywordp] sexp
@@ -201,23 +196,12 @@ For example, you could write
201 [&rest [keywordp sexp]] 196 [&rest [keywordp sexp]]
202 def-body))) 197 def-body)))
203 198
204 ;; Allow skipping the first three args.
205 (cond
206 ((keywordp init-value)
207 (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
208 `(,init-value ,lighter))
209 init-value nil lighter nil keymap nil))
210 ((keywordp lighter)
211 (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
212 ((keywordp keymap) (push keymap body) (setq keymap nil)))
213
214 (let* ((last-message (make-symbol "last-message")) 199 (let* ((last-message (make-symbol "last-message"))
215 (mode-name (symbol-name mode)) 200 (mode-name (symbol-name mode))
216 (pretty-name (easy-mmode-pretty-mode-name mode lighter)) 201 (pretty-name nil)
217 (globalp nil) 202 (globalp nil)
218 (set nil) 203 (set nil)
219 (initialize nil) 204 (initialize nil)
220 (group nil)
221 (type nil) 205 (type nil)
222 (extra-args nil) 206 (extra-args nil)
223 (extra-keywords nil) 207 (extra-keywords nil)
@@ -225,14 +209,28 @@ For example, you could write
225 (setter `(setq ,mode)) ;The beginning of the exp to set the mode var. 209 (setter `(setq ,mode)) ;The beginning of the exp to set the mode var.
226 (getter mode) ;The exp to get the mode value. 210 (getter mode) ;The exp to get the mode value.
227 (modefun mode) ;The minor mode function name we're defining. 211 (modefun mode) ;The minor mode function name we're defining.
228 (require t)
229 (after-hook nil) 212 (after-hook nil)
230 (hook (intern (concat mode-name "-hook"))) 213 (hook (intern (concat mode-name "-hook")))
231 (hook-on (intern (concat mode-name "-on-hook"))) 214 (hook-on (intern (concat mode-name "-on-hook")))
232 (hook-off (intern (concat mode-name "-off-hook"))) 215 (hook-off (intern (concat mode-name "-off-hook")))
233 (interactive t) 216 (interactive t)
217 (warnwrap (if (keywordp init-value) #'identity
218 (lambda (exp)
219 (macroexp-warn-and-return
220 "Use keywords rather than deprecated positional arguments to `define-minor-mode'"
221 exp))))
234 keyw keymap-sym tmp) 222 keyw keymap-sym tmp)
235 223
224 ;; Allow skipping the first three args.
225 (cond
226 ((keywordp init-value)
227 (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
228 `(,init-value ,lighter))
229 init-value nil lighter nil keymap nil))
230 ((keywordp lighter)
231 (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
232 ((keywordp keymap) (push keymap body) (setq keymap nil)))
233
236 ;; Check keys. 234 ;; Check keys.
237 (while (keywordp (setq keyw (car body))) 235 (while (keywordp (setq keyw (car body)))
238 (setq body (cdr body)) 236 (setq body (cdr body))
@@ -246,9 +244,7 @@ For example, you could write
246 (:extra-args (setq extra-args (pop body))) 244 (:extra-args (setq extra-args (pop body)))
247 (:set (setq set (list :set (pop body)))) 245 (:set (setq set (list :set (pop body))))
248 (:initialize (setq initialize (list :initialize (pop body)))) 246 (:initialize (setq initialize (list :initialize (pop body))))
249 (:group (setq group (nconc group (list :group (pop body)))))
250 (:type (setq type (list :type (pop body)))) 247 (:type (setq type (list :type (pop body))))
251 (:require (setq require (pop body)))
252 (:keymap (setq keymap (pop body))) 248 (:keymap (setq keymap (pop body)))
253 (:interactive (setq interactive (pop body))) 249 (:interactive (setq interactive (pop body)))
254 (:variable (setq variable (pop body)) 250 (:variable (setq variable (pop body))
@@ -264,6 +260,7 @@ For example, you could write
264 (:after-hook (setq after-hook (pop body))) 260 (:after-hook (setq after-hook (pop body)))
265 (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) 261 (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
266 262
263 (setq pretty-name (easy-mmode-pretty-mode-name mode lighter))
267 (setq keymap-sym (if (and keymap (symbolp keymap)) keymap 264 (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
268 (intern (concat mode-name "-map")))) 265 (intern (concat mode-name "-map"))))
269 266
@@ -301,70 +298,72 @@ or call the function `%s'."))))
301 ,(format base-doc-string pretty-name mode mode) 298 ,(format base-doc-string pretty-name mode mode)
302 ,@set 299 ,@set
303 ,@initialize 300 ,@initialize
304 ,@group
305 ,@type 301 ,@type
306 ,@(unless (eq require t) `(:require ,require))
307 ,@(nreverse extra-keywords))))) 302 ,@(nreverse extra-keywords)))))
308 303
309 ;; The actual function. 304 ;; The actual function.
310 (defun ,modefun (&optional arg ,@extra-args) 305 ,(funcall
311 ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) 306 warnwrap
312 ,(when interactive 307 `(defun ,modefun (&optional arg ,@extra-args)
313 ;; Use `toggle' rather than (if ,mode 0 1) so that using 308 ,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
314 ;; repeat-command still does the toggling correctly. 309 ,(when interactive
315 (if (consp interactive) 310 ;; Use `toggle' rather than (if ,mode 0 1) so that using
316 `(interactive 311 ;; repeat-command still does the toggling correctly.
317 (list (if current-prefix-arg 312 (if (consp interactive)
318 (prefix-numeric-value current-prefix-arg) 313 `(interactive
319 'toggle)) 314 (list (if current-prefix-arg
320 ,@interactive) 315 (prefix-numeric-value current-prefix-arg)
321 '(interactive (list (if current-prefix-arg 316 'toggle))
322 (prefix-numeric-value current-prefix-arg) 317 ,@interactive)
323 'toggle))))) 318 '(interactive
324 (let ((,last-message (current-message))) 319 (list (if current-prefix-arg
325 (,@setter 320 (prefix-numeric-value current-prefix-arg)
326 (cond ((eq arg 'toggle) 321 'toggle)))))
327 (not ,getter)) 322 (let ((,last-message (current-message)))
328 ((and (numberp arg) 323 (,@setter
329 (< arg 1)) 324 (cond ((eq arg 'toggle)
330 nil) 325 (not ,getter))
331 (t 326 ((and (numberp arg)
332 t))) 327 (< arg 1))
333 ;; Keep minor modes list up to date. 328 nil)
334 ,@(if globalp 329 (t
335 ;; When running this byte-compiled code in earlier 330 t)))
336 ;; Emacs versions, these variables may not be defined 331 ;; Keep minor modes list up to date.
337 ;; there. So check defensively, even if they're 332 ,@(if globalp
338 ;; always defined in Emacs 28 and up. 333 ;; When running this byte-compiled code in earlier
339 `((when (boundp 'global-minor-modes) 334 ;; Emacs versions, these variables may not be defined
340 (setq global-minor-modes 335 ;; there. So check defensively, even if they're
341 (delq ',modefun global-minor-modes)) 336 ;; always defined in Emacs 28 and up.
342 (when ,getter 337 `((when (boundp 'global-minor-modes)
343 (push ',modefun global-minor-modes)))) 338 (setq global-minor-modes
344 ;; Ditto check. 339 (delq ',modefun global-minor-modes))
345 `((when (boundp 'local-minor-modes) 340 (when ,getter
346 (setq local-minor-modes (delq ',modefun local-minor-modes)) 341 (push ',modefun global-minor-modes))))
347 (when ,getter 342 ;; Ditto check.
348 (push ',modefun local-minor-modes))))) 343 `((when (boundp 'local-minor-modes)
349 ,@body 344 (setq local-minor-modes
350 ;; The on/off hooks are here for backward compatibility only. 345 (delq ',modefun local-minor-modes))
351 (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) 346 (when ,getter
352 (if (called-interactively-p 'any) 347 (push ',modefun local-minor-modes)))))
353 (progn 348 ,@body
354 ,(if (and globalp (not variable)) 349 ;; The on/off hooks are here for backward compatibility only.
355 `(customize-mark-as-set ',mode)) 350 (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
356 ;; Avoid overwriting a message shown by the body, 351 (if (called-interactively-p 'any)
357 ;; but do overwrite previous messages. 352 (progn
358 (unless (and (current-message) 353 ,(if (and globalp (not variable))
359 (not (equal ,last-message 354 `(customize-mark-as-set ',mode))
360 (current-message)))) 355 ;; Avoid overwriting a message shown by the body,
361 (let ((local ,(if globalp "" " in current buffer"))) 356 ;; but do overwrite previous messages.
362 (message ,(format "%s %%sabled%%s" pretty-name) 357 (unless (and (current-message)
363 (if ,getter "en" "dis") local))))) 358 (not (equal ,last-message
364 ,@(when after-hook `(,after-hook))) 359 (current-message))))
365 (force-mode-line-update) 360 (let ((local ,(if globalp "" " in current buffer")))
366 ;; Return the new setting. 361 (message ,(format "%s %%sabled%%s" pretty-name)
367 ,getter) 362 (if ,getter "en" "dis") local)))))
363 ,@(when after-hook `(,after-hook)))
364 (force-mode-line-update)
365 ;; Return the new setting.
366 ,getter))
368 367
369 ;; Autoloading a define-minor-mode autoloads everything 368 ;; Autoloading a define-minor-mode autoloads everything
370 ;; up-to-here. 369 ;; up-to-here.
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 87b34e7cd57..f6661541a16 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -494,14 +494,16 @@ To implement dynamic menus, either call this from
494`menu-bar-update-hook' or use a menu filter." 494`menu-bar-update-hook' or use a menu filter."
495 (easy-menu-add-item map path (easy-menu-create-menu name items) before)) 495 (easy-menu-add-item map path (easy-menu-create-menu name items) before))
496 496
497(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1" 497(defalias 'easy-menu-remove #'ignore
498 "Remove MENU from the current menu bar. 498 "Remove MENU from the current menu bar.
499Contrary to XEmacs, this is a nop on Emacs since menus are automatically 499Contrary to XEmacs, this is a nop on Emacs since menus are automatically
500\(de)activated when the corresponding keymap is (de)activated. 500\(de)activated when the corresponding keymap is (de)activated.
501 501
502\(fn MENU)") 502\(fn MENU)")
503(make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \
504and can be safely removed." "28.1")
503 505
504(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1" 506(defalias 'easy-menu-add #'ignore
505 "Add the menu to the menubar. 507 "Add the menu to the menubar.
506On Emacs this is a nop, because menus are already automatically 508On Emacs this is a nop, because menus are already automatically
507activated when the corresponding keymap is activated. On XEmacs 509activated when the corresponding keymap is activated. On XEmacs
@@ -511,6 +513,8 @@ You should call this once the menu and keybindings are set up
511completely and menu filter functions can be expected to work. 513completely and menu filter functions can be expected to work.
512 514
513\(fn MENU &optional MAP)") 515\(fn MENU &optional MAP)")
516(make-obsolete 'easy-menu-add "this was always a no-op in Emacs \
517and can be safely removed." "28.1")
514 518
515(defun add-submenu (menu-path submenu &optional before in-menu) 519(defun add-submenu (menu-path submenu &optional before in-menu)
516 "Add submenu SUBMENU in the menu at MENU-PATH. 520 "Add submenu SUBMENU in the menu at MENU-PATH.
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index f1455ffe73b..cbc40193125 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1942,14 +1942,16 @@ a sequence of elements."
1942 ;; Normally, &define is interpreted specially other places. 1942 ;; Normally, &define is interpreted specially other places.
1943 ;; This should only be called inside of a spec list to match the remainder 1943 ;; This should only be called inside of a spec list to match the remainder
1944 ;; of the current list. e.g. ("lambda" &define args def-body) 1944 ;; of the current list. e.g. ("lambda" &define args def-body)
1945 (edebug-make-form-wrapper 1945 (prog1 (edebug-make-form-wrapper
1946 cursor 1946 cursor
1947 (edebug-before-offset cursor) 1947 (edebug-before-offset cursor)
1948 ;; Find the last offset in the list. 1948 ;; Find the last offset in the list.
1949 (let ((offsets (edebug-cursor-offsets cursor))) 1949 (let ((offsets (edebug-cursor-offsets cursor)))
1950 (while (consp offsets) (setq offsets (cdr offsets))) 1950 (while (consp offsets) (setq offsets (cdr offsets)))
1951 offsets) 1951 offsets)
1952 specs)) 1952 specs)
1953 ;; Stop backtracking here (Bug#41988).
1954 (setq edebug-gate t)))
1953 1955
1954(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs) 1956(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
1955 "Compute the name for `&name SPEC FUN` spec operator. 1957 "Compute the name for `&name SPEC FUN` spec operator.
@@ -4114,12 +4116,12 @@ This should be a list of `edebug---frame' objects.")
4114 "Stack frames of the current Edebug Backtrace buffer with instrumentation. 4116 "Stack frames of the current Edebug Backtrace buffer with instrumentation.
4115This should be a list of `edebug---frame' objects.") 4117This should be a list of `edebug---frame' objects.")
4116 4118
4117;; Data structure for backtrace frames with information
4118;; from Edebug instrumentation found in the backtrace.
4119(cl-defstruct 4119(cl-defstruct
4120 (edebug--frame 4120 (edebug--frame
4121 (:constructor edebug--make-frame) 4121 (:constructor edebug--make-frame)
4122 (:include backtrace-frame)) 4122 (:include backtrace-frame))
4123 "Data structure for backtrace frames with information
4124from Edebug instrumentation found in the backtrace."
4123 def-name before-index after-index) 4125 def-name before-index after-index)
4124 4126
4125(defun edebug-pop-to-backtrace () 4127(defun edebug-pop-to-backtrace ()
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index ec1077d447e..641882c9026 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,7 +1,6 @@
1;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- 1;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
2 2
3;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software 3;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
4;;; Foundation, Inc.
5 4
6;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
7;; Keywords: OO, lisp 6;; Keywords: OO, lisp
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 4256bd59584..0e86b923c4a 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -31,6 +31,7 @@
31(with-suppressed-warnings ((lexical pi)) 31(with-suppressed-warnings ((lexical pi))
32 (defconst pi float-pi 32 (defconst pi float-pi
33 "Obsolete since Emacs-23.3. Use `float-pi' instead.")) 33 "Obsolete since Emacs-23.3. Use `float-pi' instead."))
34(make-obsolete-variable 'pi 'float-pi "23.3")
34(internal-make-var-non-special 'pi) 35(internal-make-var-non-special 'pi)
35 36
36(defconst float-e (exp 1) "The value of e (2.7182818...).") 37(defconst float-e (exp 1) "The value of e (2.7182818...).")
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 59ada5ec35a..df864464b77 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -394,7 +394,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
394 394
395;; Record which arguments expect functions, so we can warn when those 395;; Record which arguments expect functions, so we can warn when those
396;; are accidentally quoted with ' rather than with #' 396;; are accidentally quoted with ' rather than with #'
397(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash)) 397(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash
398 map-char-table map-keymap map-keymap-internal))
398 (put f 'funarg-positions '(1))) 399 (put f 'funarg-positions '(1)))
399(dolist (f '( add-hook remove-hook advice-remove advice--remove-function 400(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
400 defalias fset global-set-key run-after-idle-timeout 401 defalias fset global-set-key run-after-idle-timeout
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index ecbca280e59..f4f03133b0f 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -182,7 +182,7 @@ by counted more than once."
182 182
183(cl-defmethod memory-report--object-size-1 (_ (value symbol)) 183(cl-defmethod memory-report--object-size-1 (_ (value symbol))
184 ;; Don't count global symbols -- makes sizes of lists of symbols too 184 ;; Don't count global symbols -- makes sizes of lists of symbols too
185 ;; heavey. 185 ;; heavy.
186 (if (intern-soft value obarray) 186 (if (intern-soft value obarray)
187 0 187 0
188 (memory-report--size 'symbol))) 188 (memory-report--size 'symbol)))
@@ -214,14 +214,14 @@ by counted more than once."
214 (setf (gethash value counted) t) 214 (setf (gethash value counted) t)
215 (when (car value) 215 (when (car value)
216 (cl-incf total (memory-report--object-size counted (car value)))) 216 (cl-incf total (memory-report--object-size counted (car value))))
217 (if (cdr value) 217 (let ((next (cdr value)))
218 (if (consp (cdr value)) 218 (setq value (when next
219 (if (gethash (cdr value) counted) 219 (if (consp next)
220 (setq value nil) 220 (unless (gethash next counted)
221 (setq value (cdr value))) 221 (cdr value))
222 (cl-incf total (memory-report--object-size counted (cdr value))) 222 (cl-incf total (memory-report--object-size
223 (setq value nil)) 223 counted next))
224 (setq value nil))) 224 nil)))))
225 total)) 225 total))
226 226
227(cl-defmethod memory-report--object-size-1 (counted (value vector)) 227(cl-defmethod memory-report--object-size-1 (counted (value vector))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 994433063ce..ab3cb3c5ace 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -57,7 +57,7 @@
57;; 57;;
58;; SMIE: Weakness is Power! Auto-indentation with incomplete information 58;; SMIE: Weakness is Power! Auto-indentation with incomplete information
59;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1. 59;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
60;; doi: 10.22152/programming-journal.org/2020/5/1 60;; doi: 10.22152/programming-journal.org/2021/5/1
61 61
62;; A good background to understand the development (especially the parts 62;; A good background to understand the development (especially the parts
63;; building the 2D precedence tables and then computing the precedence levels 63;; building the 2D precedence tables and then computing the precedence levels
@@ -68,7 +68,7 @@
68;; OTOH we had to kill many chickens, read many coffee grounds, and practice 68;; OTOH we had to kill many chickens, read many coffee grounds, and practice
69;; untold numbers of black magic spells, to come up with the indentation code. 69;; untold numbers of black magic spells, to come up with the indentation code.
70;; Since then, some of that code has been beaten into submission, but the 70;; Since then, some of that code has been beaten into submission, but the
71;; smie-indent-keyword is still pretty obscure. 71;; `smie-indent-keyword' function is still pretty obscure.
72 72
73 73
74;; Conflict resolution: 74;; Conflict resolution:
@@ -247,7 +247,7 @@ be either:
247 ;; (exp (exp (or "+" "*" "=" ..) exp)). 247 ;; (exp (exp (or "+" "*" "=" ..) exp)).
248 ;; Basically, make it EBNF (except for the specification of a separator in 248 ;; Basically, make it EBNF (except for the specification of a separator in
249 ;; the repetition, maybe). 249 ;; the repetition, maybe).
250 (let* ((nts (mapcar 'car bnf)) ;Non-terminals. 250 (let* ((nts (mapcar #'car bnf)) ;Non-terminals.
251 (first-ops-table ()) 251 (first-ops-table ())
252 (last-ops-table ()) 252 (last-ops-table ())
253 (first-nts-table ()) 253 (first-nts-table ())
@@ -266,7 +266,7 @@ be either:
266 (push resolver precs)) 266 (push resolver precs))
267 (t (error "Unknown resolver %S" resolver)))) 267 (t (error "Unknown resolver %S" resolver))))
268 (apply #'smie-merge-prec2s over 268 (apply #'smie-merge-prec2s over
269 (mapcar 'smie-precs->prec2 precs)))) 269 (mapcar #'smie-precs->prec2 precs))))
270 again) 270 again)
271 (dolist (rules bnf) 271 (dolist (rules bnf)
272 (let ((nt (car rules)) 272 (let ((nt (car rules))
@@ -497,7 +497,7 @@ CSTS is a list of pairs representing arcs in a graph."
497 res)) 497 res))
498 cycle))) 498 cycle)))
499 (mapconcat 499 (mapconcat
500 (lambda (elems) (mapconcat 'identity elems "=")) 500 (lambda (elems) (mapconcat #'identity elems "="))
501 (append names (list (car names))) 501 (append names (list (car names)))
502 " < "))) 502 " < ")))
503 503
@@ -567,7 +567,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
567 ;; Then eliminate trivial constraints iteratively. 567 ;; Then eliminate trivial constraints iteratively.
568 (let ((i 0)) 568 (let ((i 0))
569 (while csts 569 (while csts
570 (let ((rhvs (mapcar 'cdr csts)) 570 (let ((rhvs (mapcar #'cdr csts))
571 (progress nil)) 571 (progress nil))
572 (dolist (cst csts) 572 (dolist (cst csts)
573 (unless (memq (car cst) rhvs) 573 (unless (memq (car cst) rhvs)
@@ -657,8 +657,8 @@ use syntax-tables to handle them in efficient C code.")
657Same calling convention as `smie-forward-token-function' except 657Same calling convention as `smie-forward-token-function' except
658it should move backward to the beginning of the previous token.") 658it should move backward to the beginning of the previous token.")
659 659
660(defalias 'smie-op-left 'car) 660(defalias 'smie-op-left #'car)
661(defalias 'smie-op-right 'cadr) 661(defalias 'smie-op-right #'cadr)
662 662
663(defun smie-default-backward-token () 663(defun smie-default-backward-token ()
664 (forward-comment (- (point))) 664 (forward-comment (- (point)))
@@ -974,8 +974,7 @@ I.e. a good choice can be:
974(defcustom smie-blink-matching-inners t 974(defcustom smie-blink-matching-inners t
975 "Whether SMIE should blink to matching opener for inner keywords. 975 "Whether SMIE should blink to matching opener for inner keywords.
976If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." 976If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
977 :type 'boolean 977 :type 'boolean)
978 :group 'smie)
979 978
980(defun smie-blink-matching-check (start end) 979(defun smie-blink-matching-check (start end)
981 (save-excursion 980 (save-excursion
@@ -1141,8 +1140,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
1141 1140
1142(defcustom smie-indent-basic 4 1141(defcustom smie-indent-basic 4
1143 "Basic amount of indentation." 1142 "Basic amount of indentation."
1144 :type 'integer 1143 :type 'integer)
1145 :group 'smie)
1146 1144
1147(defvar smie-rules-function #'ignore 1145(defvar smie-rules-function #'ignore
1148 "Function providing the indentation rules. 1146 "Function providing the indentation rules.
@@ -1189,7 +1187,7 @@ designed specifically for use in this function.")
1189 (and ;; (looking-at comment-start-skip) ;(bug#16041). 1187 (and ;; (looking-at comment-start-skip) ;(bug#16041).
1190 (forward-comment (point-max)))))) 1188 (forward-comment (point-max))))))
1191 1189
1192(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) 1190(defalias 'smie-rule-hanging-p #'smie-indent--hanging-p)
1193(defun smie-indent--hanging-p () 1191(defun smie-indent--hanging-p ()
1194 "Return non-nil if the current token is \"hanging\". 1192 "Return non-nil if the current token is \"hanging\".
1195A hanging keyword is one that's at the end of a line except it's not at 1193A hanging keyword is one that's at the end of a line except it's not at
@@ -1205,7 +1203,7 @@ the beginning of a line."
1205 (funcall smie--hanging-eolp-function) 1203 (funcall smie--hanging-eolp-function)
1206 (point)))))) 1204 (point))))))
1207 1205
1208(defalias 'smie-rule-bolp 'smie-indent--bolp) 1206(defalias 'smie-rule-bolp #'smie-indent--bolp)
1209(defun smie-indent--bolp () 1207(defun smie-indent--bolp ()
1210 "Return non-nil if the current token is the first on the line." 1208 "Return non-nil if the current token is the first on the line."
1211 (save-excursion (skip-chars-backward " \t") (bolp))) 1209 (save-excursion (skip-chars-backward " \t") (bolp)))
@@ -1421,7 +1419,7 @@ BASE-POS is the position relative to which offsets should be applied."
1421 (forward-sexp 1) 1419 (forward-sexp 1)
1422 nil) 1420 nil)
1423 ((eobp) nil) 1421 ((eobp) nil)
1424 (t (error "Bumped into unknown token"))))) 1422 (t (error "Bumped into unknown token: %S" tok)))))
1425 1423
1426(defun smie-indent-backward-token () 1424(defun smie-indent-backward-token ()
1427 "Skip token backward and return it, along with its levels." 1425 "Skip token backward and return it, along with its levels."
@@ -1810,9 +1808,11 @@ Each function is called with no argument, shouldn't move point, and should
1810return either nil if it has no opinion, or an integer representing the column 1808return either nil if it has no opinion, or an integer representing the column
1811to which that point should be aligned, if we were to reindent it.") 1809to which that point should be aligned, if we were to reindent it.")
1812 1810
1811(defalias 'smie--funcall #'funcall) ;Debugging/tracing convenience indirection.
1812
1813(defun smie-indent-calculate () 1813(defun smie-indent-calculate ()
1814 "Compute the indentation to use for point." 1814 "Compute the indentation to use for point."
1815 (run-hook-with-args-until-success 'smie-indent-functions)) 1815 (run-hook-wrapped 'smie-indent-functions #'smie--funcall))
1816 1816
1817(defun smie-indent-line () 1817(defun smie-indent-line ()
1818 "Indent current line using the SMIE indentation engine." 1818 "Indent current line using the SMIE indentation engine."
@@ -2016,7 +2016,7 @@ value with which to replace it."
2016 ;; FIXME improve value-type. 2016 ;; FIXME improve value-type.
2017 :type '(choice (const nil) 2017 :type '(choice (const nil)
2018 (alist :key-type symbol)) 2018 (alist :key-type symbol))
2019 :initialize 'custom-initialize-set 2019 :initialize #'custom-initialize-set
2020 :set #'smie-config--setter) 2020 :set #'smie-config--setter)
2021 2021
2022(defun smie-config-local (rules) 2022(defun smie-config-local (rules)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 0c299b48b90..0b10dfdc0af 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -410,8 +410,7 @@ specified by `tabulated-list-sort-key'. It then erases the
410buffer and inserts the entries with `tabulated-list-printer'. 410buffer and inserts the entries with `tabulated-list-printer'.
411 411
412Optional argument REMEMBER-POS, if non-nil, means to move point 412Optional argument REMEMBER-POS, if non-nil, means to move point
413to the entry with the same ID element as the current line and 413to the entry with the same ID element as the current line.
414recenter window line accordingly.
415 414
416Non-nil UPDATE argument means to use an alternative printing 415Non-nil UPDATE argument means to use an alternative printing
417method which is faster if most entries haven't changed since the 416method which is faster if most entries haven't changed since the
@@ -424,18 +423,10 @@ changing `tabulated-list-sort-key'."
424 (funcall tabulated-list-entries) 423 (funcall tabulated-list-entries)
425 tabulated-list-entries)) 424 tabulated-list-entries))
426 (sorter (tabulated-list--get-sorter)) 425 (sorter (tabulated-list--get-sorter))
427 entry-id saved-pt saved-col window-line) 426 entry-id saved-pt saved-col)
428 (and remember-pos 427 (and remember-pos
429 (setq entry-id (tabulated-list-get-id)) 428 (setq entry-id (tabulated-list-get-id))
430 (setq saved-col (current-column)) 429 (setq saved-col (current-column)))
431 (when (eq (window-buffer) (current-buffer))
432 (setq window-line
433 (save-excursion
434 (save-restriction
435 (widen)
436 (narrow-to-region (window-start) (point))
437 (goto-char (point-min))
438 (vertical-motion (buffer-size)))))))
439 ;; Sort the entries, if necessary. 430 ;; Sort the entries, if necessary.
440 (when sorter 431 (when sorter
441 (setq entries (sort entries sorter))) 432 (setq entries (sort entries sorter)))
@@ -490,9 +481,7 @@ changing `tabulated-list-sort-key'."
490 ;; If REMEMBER-POS was specified, move to the "old" location. 481 ;; If REMEMBER-POS was specified, move to the "old" location.
491 (if saved-pt 482 (if saved-pt
492 (progn (goto-char saved-pt) 483 (progn (goto-char saved-pt)
493 (move-to-column saved-col) 484 (move-to-column saved-col))
494 (when window-line
495 (recenter window-line)))
496 (goto-char (point-min))))) 485 (goto-char (point-min)))))
497 486
498(defun tabulated-list-print-entry (id cols) 487(defun tabulated-list-print-entry (id cols)
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index e46e3684c8a..33bf5adabe6 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -198,7 +198,9 @@ encryption is used."
198 (mapcar #'car (epg-context-result-for 198 (mapcar #'car (epg-context-result-for
199 context 'encrypted-to))) 199 context 'encrypted-to)))
200 (if (or beg end) 200 (if (or beg end)
201 (setq string (substring string (or beg 0) end))) 201 (setq string (substring string
202 (or beg 0)
203 (and end (min end (length string))))))
202 (save-excursion 204 (save-excursion
203 ;; If visiting, bind off buffer-file-name so that 205 ;; If visiting, bind off buffer-file-name so that
204 ;; file-locking will not ask whether we should 206 ;; file-locking will not ask whether we should
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 7e100569b0f..7eac1f89986 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -59,7 +59,7 @@ Otherwise, signal an error."
59;;;###autoload 59;;;###autoload
60(define-minor-mode epa-mail-mode 60(define-minor-mode epa-mail-mode
61 "A minor-mode for composing encrypted/clearsigned mails." 61 "A minor-mode for composing encrypted/clearsigned mails."
62 nil " epa-mail" epa-mail-mode-map) 62 :lighter " epa-mail")
63 63
64;;; Utilities 64;;; Utilities
65 65
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 234b4b5a71d..219af3741fa 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -415,33 +415,33 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
415 (pcase (intern (downcase (pcomplete-arg 1))) 415 (pcase (intern (downcase (pcomplete-arg 1)))
416 ('chat (mapcar (lambda (elt) (plist-get elt :nick)) 416 ('chat (mapcar (lambda (elt) (plist-get elt :nick))
417 (cl-remove-if-not 417 (cl-remove-if-not
418 #'(lambda (elt) 418 (lambda (elt)
419 (eq (plist-get elt :type) 'CHAT)) 419 (eq (plist-get elt :type) 'CHAT))
420 erc-dcc-list))) 420 erc-dcc-list)))
421 ('close (delete-dups 421 ('close (delete-dups
422 (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) 422 (mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
423 erc-dcc-list))) 423 erc-dcc-list)))
424 ('get (mapcar #'erc-dcc-nick 424 ('get (mapcar #'erc-dcc-nick
425 (cl-remove-if-not 425 (cl-remove-if-not
426 #'(lambda (elt) 426 (lambda (elt)
427 (eq (plist-get elt :type) 'GET)) 427 (eq (plist-get elt :type) 'GET))
428 erc-dcc-list))) 428 erc-dcc-list)))
429 ('send (pcomplete-erc-all-nicks)))) 429 ('send (pcomplete-erc-all-nicks))))
430 (pcomplete-here 430 (pcomplete-here
431 (pcase (intern (downcase (pcomplete-arg 2))) 431 (pcase (intern (downcase (pcomplete-arg 2)))
432 ('get (mapcar (lambda (elt) (plist-get elt :file)) 432 ('get (mapcar (lambda (elt) (plist-get elt :file))
433 (cl-remove-if-not 433 (cl-remove-if-not
434 #'(lambda (elt) 434 (lambda (elt)
435 (and (eq (plist-get elt :type) 'GET) 435 (and (eq (plist-get elt :type) 'GET)
436 (erc-nick-equal-p (erc-extract-nick 436 (erc-nick-equal-p (erc-extract-nick
437 (plist-get elt :nick)) 437 (plist-get elt :nick))
438 (pcomplete-arg 1)))) 438 (pcomplete-arg 1))))
439 erc-dcc-list))) 439 erc-dcc-list)))
440 ('close (mapcar #'erc-dcc-nick 440 ('close (mapcar #'erc-dcc-nick
441 (cl-remove-if-not 441 (cl-remove-if-not
442 #'(lambda (elt) 442 (lambda (elt)
443 (eq (plist-get elt :type) 443 (eq (plist-get elt :type)
444 (intern (upcase (pcomplete-arg 1))))) 444 (intern (upcase (pcomplete-arg 1)))))
445 erc-dcc-list))) 445 erc-dcc-list)))
446 ('send (pcomplete-entries))))) 446 ('send (pcomplete-entries)))))
447 447
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 0312d221ece..41256682c00 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -46,7 +46,6 @@ the mode if ARG is omitted or nil.
46 46
47ERC fill mode is a global minor mode. When enabled, messages in 47ERC fill mode is a global minor mode. When enabled, messages in
48the channel buffers are filled." 48the channel buffers are filled."
49 nil nil nil
50 :global t 49 :global t
51 (if erc-fill-mode 50 (if erc-fill-mode
52 (erc-fill-enable) 51 (erc-fill-enable)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 8be55558823..2364d45d6f3 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -464,9 +464,6 @@ ERC Track minor mode is a global minor mode. It exists for the
464sole purpose of providing the C-c C-SPC and C-c C-@ keybindings. 464sole purpose of providing the C-c C-SPC and C-c C-@ keybindings.
465Make sure that you have enabled the track module, otherwise the 465Make sure that you have enabled the track module, otherwise the
466keybindings will not do anything useful." 466keybindings will not do anything useful."
467 :init-value nil
468 :lighter ""
469 :keymap erc-track-minor-mode-map
470 :global t) 467 :global t)
471 468
472(defun erc-track-minor-mode-maybe (&optional buffer) 469(defun erc-track-minor-mode-maybe (&optional buffer)
@@ -686,9 +683,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
686 (let* ((buffers (mapcar #'car erc-modified-channels-alist)) 683 (let* ((buffers (mapcar #'car erc-modified-channels-alist))
687 (counts (mapcar #'cadr erc-modified-channels-alist)) 684 (counts (mapcar #'cadr erc-modified-channels-alist))
688 (faces (mapcar #'cddr erc-modified-channels-alist)) 685 (faces (mapcar #'cddr erc-modified-channels-alist))
689 (long-names (mapcar #'(lambda (buf) 686 (long-names (mapcar (lambda (buf)
690 (or (buffer-name buf) 687 (or (buffer-name buf)
691 "")) 688 ""))
692 buffers)) 689 buffers))
693 (short-names (if (functionp erc-track-shorten-function) 690 (short-names (if (functionp erc-track-shorten-function)
694 (funcall erc-track-shorten-function 691 (funcall erc-track-shorten-function
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2f6e48dce1a..e20aa8057de 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1289,7 +1289,6 @@ With a prefix argument ARG, enable %s if ARG is positive,
1289and disable it otherwise. If called from Lisp, enable the mode 1289and disable it otherwise. If called from Lisp, enable the mode
1290if ARG is omitted or nil. 1290if ARG is omitted or nil.
1291%s" name name doc) 1291%s" name name doc)
1292 nil nil nil
1293 ;; FIXME: We don't know if this group exists, so this `:group' may 1292 ;; FIXME: We don't know if this group exists, so this `:group' may
1294 ;; actually just silence a valid warning about the fact that the var 1293 ;; actually just silence a valid warning about the fact that the var
1295 ;; is not associated with any group. 1294 ;; is not associated with any group.
@@ -2321,7 +2320,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
2321 (use-local-map (make-sparse-keymap)) 2320 (use-local-map (make-sparse-keymap))
2322 (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) 2321 (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
2323 (add-hook 'kill-buffer-hook 2322 (add-hook 'kill-buffer-hook
2324 #'(lambda () (setq erc-debug-irc-protocol nil)) 2323 (lambda () (setq erc-debug-irc-protocol nil))
2325 nil 'local) 2324 nil 'local)
2326 (goto-char (point-max)) 2325 (goto-char (point-max))
2327 (let ((inhibit-read-only t)) 2326 (let ((inhibit-read-only t))
@@ -2945,9 +2944,9 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
2945 (if (null (erc-with-server-buffer erc-ignore-list)) 2944 (if (null (erc-with-server-buffer erc-ignore-list))
2946 (erc-display-line (erc-make-notice "Ignore list is empty") 'active) 2945 (erc-display-line (erc-make-notice "Ignore list is empty") 'active)
2947 (erc-display-line (erc-make-notice "Ignore list:") 'active) 2946 (erc-display-line (erc-make-notice "Ignore list:") 'active)
2948 (mapc #'(lambda (item) 2947 (mapc (lambda (item)
2949 (erc-display-line (erc-make-notice item) 2948 (erc-display-line (erc-make-notice item)
2950 'active)) 2949 'active))
2951 (erc-with-server-buffer erc-ignore-list)))) 2950 (erc-with-server-buffer erc-ignore-list))))
2952 t) 2951 t)
2953 2952
@@ -3129,8 +3128,8 @@ were most recently invited. See also `invitation'."
3129 (when chnl 3128 (when chnl
3130 ;; Prevent double joining of same channel on same server. 3129 ;; Prevent double joining of same channel on same server.
3131 (let* ((joined-channels 3130 (let* ((joined-channels
3132 (mapcar #'(lambda (chanbuf) 3131 (mapcar (lambda (chanbuf)
3133 (with-current-buffer chanbuf (erc-default-target))) 3132 (with-current-buffer chanbuf (erc-default-target)))
3134 (erc-channel-list erc-server-process))) 3133 (erc-channel-list erc-server-process)))
3135 (server (with-current-buffer (process-buffer erc-server-process) 3134 (server (with-current-buffer (process-buffer erc-server-process)
3136 (or erc-session-server erc-server-announced-name))) 3135 (or erc-session-server erc-server-announced-name)))
@@ -4149,9 +4148,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
4149 (mapconcat 4148 (mapconcat
4150 #'identity 4149 #'identity
4151 (let (res) 4150 (let (res)
4152 (mapc #'(lambda (x) 4151 (mapc (lambda (x)
4153 (if (stringp x) 4152 (if (stringp x)
4154 (setq res (append res (list x))))) 4153 (setq res (append res (list x)))))
4155 parsed) 4154 parsed)
4156 res) 4155 res)
4157 " "))) 4156 " ")))
@@ -4539,10 +4538,10 @@ See also: `erc-echo-notice-in-user-buffers',
4539 ;; Remove the unbanned masks from the ban list 4538 ;; Remove the unbanned masks from the ban list
4540 (setq erc-channel-banlist 4539 (setq erc-channel-banlist
4541 (cl-delete-if 4540 (cl-delete-if
4542 #'(lambda (y) 4541 (lambda (y)
4543 (member (upcase (cdr y)) 4542 (member (upcase (cdr y))
4544 (mapcar #'upcase 4543 (mapcar #'upcase
4545 (cdr (split-string mode))))) 4544 (cdr (split-string mode)))))
4546 erc-channel-banlist))) 4545 erc-channel-banlist)))
4547 ((string-match "^\\+" mode) 4546 ((string-match "^\\+" mode)
4548 ;; Add the banned mask(s) to the ban list 4547 ;; Add the banned mask(s) to the ban list
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 369382906c8..96c9a60deab 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -37,23 +37,19 @@ finish."
37(defcustom eshell-proc-load-hook nil 37(defcustom eshell-proc-load-hook nil
38 "A hook that gets run when `eshell-proc' is loaded." 38 "A hook that gets run when `eshell-proc' is loaded."
39 :version "24.1" ; removed eshell-proc-initialize 39 :version "24.1" ; removed eshell-proc-initialize
40 :type 'hook 40 :type 'hook)
41 :group 'eshell-proc)
42 41
43(defcustom eshell-process-wait-seconds 0 42(defcustom eshell-process-wait-seconds 0
44 "The number of seconds to delay waiting for a synchronous process." 43 "The number of seconds to delay waiting for a synchronous process."
45 :type 'integer 44 :type 'integer)
46 :group 'eshell-proc)
47 45
48(defcustom eshell-process-wait-milliseconds 50 46(defcustom eshell-process-wait-milliseconds 50
49 "The number of milliseconds to delay waiting for a synchronous process." 47 "The number of milliseconds to delay waiting for a synchronous process."
50 :type 'integer 48 :type 'integer)
51 :group 'eshell-proc)
52 49
53(defcustom eshell-done-messages-in-minibuffer t 50(defcustom eshell-done-messages-in-minibuffer t
54 "If non-nil, subjob \"Done\" messages will display in minibuffer." 51 "If non-nil, subjob \"Done\" messages will display in minibuffer."
55 :type 'boolean 52 :type 'boolean)
56 :group 'eshell-proc)
57 53
58(defcustom eshell-delete-exited-processes t 54(defcustom eshell-delete-exited-processes t
59 "If nil, process entries will stick around until `jobs' is run. 55 "If nil, process entries will stick around until `jobs' is run.
@@ -72,14 +68,12 @@ subjob is done is that it will no longer appear in the
72 68
73Note that Eshell will have to be restarted for a change in this 69Note that Eshell will have to be restarted for a change in this
74variable's value to take effect." 70variable's value to take effect."
75 :type 'boolean 71 :type 'boolean)
76 :group 'eshell-proc)
77 72
78(defcustom eshell-reset-signals 73(defcustom eshell-reset-signals
79 "^\\(interrupt\\|killed\\|quit\\|stopped\\)" 74 "^\\(interrupt\\|killed\\|quit\\|stopped\\)"
80 "If a termination signal matches this regexp, the terminal will be reset." 75 "If a termination signal matches this regexp, the terminal will be reset."
81 :type 'regexp 76 :type 'regexp)
82 :group 'eshell-proc)
83 77
84(defcustom eshell-exec-hook nil 78(defcustom eshell-exec-hook nil
85 "Called each time a process is exec'd by `eshell-gather-process-output'. 79 "Called each time a process is exec'd by `eshell-gather-process-output'.
@@ -88,8 +82,7 @@ It is useful for things that must be done each time a process is
88executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag'). 82executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag').
89In contrast, `eshell-mode-hook' is only executed once, when the buffer 83In contrast, `eshell-mode-hook' is only executed once, when the buffer
90is created." 84is created."
91 :type 'hook 85 :type 'hook)
92 :group 'eshell-proc)
93 86
94(defcustom eshell-kill-hook nil 87(defcustom eshell-kill-hook nil
95 "Called when a process run by `eshell-gather-process-output' has ended. 88 "Called when a process run by `eshell-gather-process-output' has ended.
@@ -99,8 +92,7 @@ nil, in which case the user attempted to send a signal, but there was
99no relevant process. This can be used for displaying help 92no relevant process. This can be used for displaying help
100information, for example." 93information, for example."
101 :version "24.1" ; removed eshell-reset-after-proc 94 :version "24.1" ; removed eshell-reset-after-proc
102 :type 'hook 95 :type 'hook)
103 :group 'eshell-proc)
104 96
105;;; Internal Variables: 97;;; Internal Variables:
106 98
@@ -126,8 +118,7 @@ information, for example."
126Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments 118Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
127PROC and STATUS to functions on the latter." 119PROC and STATUS to functions on the latter."
128 ;; Was there till 24.1, but it is not optional. 120 ;; Was there till 24.1, but it is not optional.
129 (if (memq #'eshell-reset-after-proc eshell-kill-hook) 121 (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
130 (setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook)))
131 (eshell-reset-after-proc status) 122 (eshell-reset-after-proc status)
132 (run-hook-with-args 'eshell-kill-hook proc status)) 123 (run-hook-with-args 'eshell-kill-hook proc status))
133 124
@@ -165,7 +156,7 @@ The signals which will cause this to happen are matched by
165 eshell-process-wait-milliseconds)))) 156 eshell-process-wait-milliseconds))))
166 (setq procs (cdr procs)))) 157 (setq procs (cdr procs))))
167 158
168(defalias 'eshell/wait 'eshell-wait-for-process) 159(defalias 'eshell/wait #'eshell-wait-for-process)
169 160
170(defun eshell/jobs (&rest _args) 161(defun eshell/jobs (&rest _args)
171 "List processes, if there are any." 162 "List processes, if there are any."
@@ -457,8 +448,7 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC."
457 448
458(defcustom eshell-kill-process-wait-time 5 449(defcustom eshell-kill-process-wait-time 5
459 "Seconds to wait between sending termination signals to a subprocess." 450 "Seconds to wait between sending termination signals to a subprocess."
460 :type 'integer 451 :type 'integer)
461 :group 'eshell-proc)
462 452
463(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL) 453(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
464 "Signals used to kill processes when an Eshell buffer exits. 454 "Signals used to kill processes when an Eshell buffer exits.
@@ -466,8 +456,7 @@ Eshell calls each of these signals in order when an Eshell buffer is
466killed; if the process is still alive afterwards, Eshell waits a 456killed; if the process is still alive afterwards, Eshell waits a
467number of seconds defined by `eshell-kill-process-wait-time', and 457number of seconds defined by `eshell-kill-process-wait-time', and
468tries the next signal in the list." 458tries the next signal in the list."
469 :type '(repeat symbol) 459 :type '(repeat symbol))
470 :group 'eshell-proc)
471 460
472(defcustom eshell-kill-processes-on-exit nil 461(defcustom eshell-kill-processes-on-exit nil
473 "If non-nil, kill active processes when exiting an Eshell buffer. 462 "If non-nil, kill active processes when exiting an Eshell buffer.
@@ -489,8 +478,7 @@ long to delay between signals."
489 :type '(choice (const :tag "Kill all, don't ask" t) 478 :type '(choice (const :tag "Kill all, don't ask" t)
490 (const :tag "Ask before killing" ask) 479 (const :tag "Ask before killing" ask)
491 (const :tag "Ask for each process" every) 480 (const :tag "Ask for each process" every)
492 (const :tag "Don't kill subprocesses" nil)) 481 (const :tag "Don't kill subprocesses" nil)))
493 :group 'eshell-proc)
494 482
495(defun eshell-round-robin-kill (&optional query) 483(defun eshell-round-robin-kill (&optional query)
496 "Kill current process by trying various signals in sequence. 484 "Kill current process by trying various signals in sequence.
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index a48f62654d5..30104816f07 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -23,6 +23,7 @@
23 23
24;;; Code: 24;;; Code:
25 25
26(require 'seq)
26(eval-when-compile (require 'cl-lib)) 27(eval-when-compile (require 'cl-lib))
27 28
28(defgroup eshell-util nil 29(defgroup eshell-util nil
@@ -37,25 +38,21 @@
37If nil, t will be represented only in the exit code of the function, 38If nil, t will be represented only in the exit code of the function,
38and not printed as a string. This causes Lisp functions to behave 39and not printed as a string. This causes Lisp functions to behave
39similarly to external commands, as far as successful result output." 40similarly to external commands, as far as successful result output."
40 :type 'boolean 41 :type 'boolean)
41 :group 'eshell-util)
42 42
43(defcustom eshell-group-file "/etc/group" 43(defcustom eshell-group-file "/etc/group"
44 "If non-nil, the name of the group file on your system." 44 "If non-nil, the name of the group file on your system."
45 :type '(choice (const :tag "No group file" nil) file) 45 :type '(choice (const :tag "No group file" nil) file))
46 :group 'eshell-util)
47 46
48(defcustom eshell-passwd-file "/etc/passwd" 47(defcustom eshell-passwd-file "/etc/passwd"
49 "If non-nil, the name of the passwd file on your system." 48 "If non-nil, the name of the passwd file on your system."
50 :type '(choice (const :tag "No passwd file" nil) file) 49 :type '(choice (const :tag "No passwd file" nil) file))
51 :group 'eshell-util)
52 50
53(defcustom eshell-hosts-file "/etc/hosts" 51(defcustom eshell-hosts-file "/etc/hosts"
54 "The name of the /etc/hosts file. 52 "The name of the /etc/hosts file.
55Use `pcomplete-hosts-file' instead; this variable is obsolete and 53Use `pcomplete-hosts-file' instead; this variable is obsolete and
56has no effect." 54has no effect."
57 :type '(choice (const :tag "No hosts file" nil) file) 55 :type '(choice (const :tag "No hosts file" nil) file))
58 :group 'eshell-util)
59;; Don't make it into an alias, because it doesn't really work with 56;; Don't make it into an alias, because it doesn't really work with
60;; custom and risks creating duplicate entries. Just point users to 57;; custom and risks creating duplicate entries. Just point users to
61;; the other variable, which is less frustrating. 58;; the other variable, which is less frustrating.
@@ -64,25 +61,21 @@ has no effect."
64(defcustom eshell-handle-errors t 61(defcustom eshell-handle-errors t
65 "If non-nil, Eshell will handle errors itself. 62 "If non-nil, Eshell will handle errors itself.
66Setting this to nil is offered as an aid to debugging only." 63Setting this to nil is offered as an aid to debugging only."
67 :type 'boolean 64 :type 'boolean)
68 :group 'eshell-util)
69 65
70(defcustom eshell-private-file-modes 384 ; umask 177 66(defcustom eshell-private-file-modes 384 ; umask 177
71 "The file-modes value to use for creating \"private\" files." 67 "The file-modes value to use for creating \"private\" files."
72 :type 'integer 68 :type 'integer)
73 :group 'eshell-util)
74 69
75(defcustom eshell-private-directory-modes 448 ; umask 077 70(defcustom eshell-private-directory-modes 448 ; umask 077
76 "The file-modes value to use for creating \"private\" directories." 71 "The file-modes value to use for creating \"private\" directories."
77 :type 'integer 72 :type 'integer)
78 :group 'eshell-util)
79 73
80(defcustom eshell-tar-regexp 74(defcustom eshell-tar-regexp
81 "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'" 75 "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
82 "Regular expression used to match tar file names." 76 "Regular expression used to match tar file names."
83 :version "24.1" ; added xz 77 :version "24.1" ; added xz
84 :type 'regexp 78 :type 'regexp)
85 :group 'eshell-util)
86 79
87(defcustom eshell-convert-numeric-arguments t 80(defcustom eshell-convert-numeric-arguments t
88 "If non-nil, converting arguments of numeric form to Lisp numbers. 81 "If non-nil, converting arguments of numeric form to Lisp numbers.
@@ -99,16 +92,14 @@ following in your init file:
99Any function with the property `eshell-no-numeric-conversions' set to 92Any function with the property `eshell-no-numeric-conversions' set to
100a non-nil value, will be passed strings, not numbers, even when an 93a non-nil value, will be passed strings, not numbers, even when an
101argument matches `eshell-number-regexp'." 94argument matches `eshell-number-regexp'."
102 :type 'boolean 95 :type 'boolean)
103 :group 'eshell-util)
104 96
105(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?" 97(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?"
106 "Regular expression used to match numeric arguments. 98 "Regular expression used to match numeric arguments.
107If `eshell-convert-numeric-arguments' is non-nil, and an argument 99If `eshell-convert-numeric-arguments' is non-nil, and an argument
108matches this regexp, it will be converted to a Lisp number, using the 100matches this regexp, it will be converted to a Lisp number, using the
109function `string-to-number'." 101function `string-to-number'."
110 :type 'regexp 102 :type 'regexp)
111 :group 'eshell-util)
112 103
113(defcustom eshell-ange-ls-uids nil 104(defcustom eshell-ange-ls-uids nil
114 "List of user/host/id strings, used to determine remote ownership." 105 "List of user/host/id strings, used to determine remote ownership."
@@ -116,8 +107,7 @@ function `string-to-number'."
116 (string :tag "Hostname") 107 (string :tag "Hostname")
117 (repeat (cons :tag "User/UID List" 108 (repeat (cons :tag "User/UID List"
118 (string :tag "Username") 109 (string :tag "Username")
119 (repeat :tag "UIDs" string))))) 110 (repeat :tag "UIDs" string))))))
120 :group 'eshell-util)
121 111
122;;; Internal Variables: 112;;; Internal Variables:
123 113
@@ -308,11 +298,11 @@ Prepend remote identification of `default-directory', if any."
308 298
309(defsubst eshell-stringify-list (args) 299(defsubst eshell-stringify-list (args)
310 "Convert each element of ARGS into a string value." 300 "Convert each element of ARGS into a string value."
311 (mapcar 'eshell-stringify args)) 301 (mapcar #'eshell-stringify args))
312 302
313(defsubst eshell-flatten-and-stringify (&rest args) 303(defsubst eshell-flatten-and-stringify (&rest args)
314 "Flatten and stringify all of the ARGS into a single string." 304 "Flatten and stringify all of the ARGS into a single string."
315 (mapconcat 'eshell-stringify (flatten-tree args) " ")) 305 (mapconcat #'eshell-stringify (flatten-tree args) " "))
316 306
317(defsubst eshell-directory-files (regexp &optional directory) 307(defsubst eshell-directory-files (regexp &optional directory)
318 "Return a list of files in the given DIRECTORY matching REGEXP." 308 "Return a list of files in the given DIRECTORY matching REGEXP."
@@ -471,7 +461,7 @@ list."
471 461
472(defsubst eshell-copy-environment () 462(defsubst eshell-copy-environment ()
473 "Return an unrelated copy of `process-environment'." 463 "Return an unrelated copy of `process-environment'."
474 (mapcar 'concat process-environment)) 464 (mapcar #'concat process-environment))
475 465
476(defun eshell-subgroups (groupsym) 466(defun eshell-subgroups (groupsym)
477 "Return all of the subgroups of GROUPSYM." 467 "Return all of the subgroups of GROUPSYM."
@@ -619,70 +609,68 @@ gid format. Valid values are `string' and `integer', defaulting to
619 "If the `processp' function does not exist, PROC is not a process." 609 "If the `processp' function does not exist, PROC is not a process."
620 (and (fboundp 'processp) (processp proc))) 610 (and (fboundp 'processp) (processp proc)))
621 611
622; (defun eshell-copy-file 612;; (defun eshell-copy-file
623; (file newname &optional ok-if-already-exists keep-date) 613;; (file newname &optional ok-if-already-exists keep-date)
624; "Copy FILE to NEWNAME. See docs for `copy-file'." 614;; "Copy FILE to NEWNAME. See docs for `copy-file'."
625; (let (copied) 615;; (let (copied)
626; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file) 616;; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
627; (let ((front (match-string 1 file)) 617;; (let ((front (match-string 1 file))
628; (back (match-string 2 file)) 618;; (back (match-string 2 file))
629; buffer) 619;; buffer)
630; (if (and front (string-match eshell-tar-regexp front) 620;; (if (and front (string-match eshell-tar-regexp front)
631; (setq buffer (find-file-noselect front))) 621;; (setq buffer (find-file-noselect front)))
632; (with-current-buffer buffer 622;; (with-current-buffer buffer
633; (goto-char (point-min)) 623;; (goto-char (point-min))
634; (if (re-search-forward (concat " " (regexp-quote back) 624;; (if (re-search-forward (concat " " (regexp-quote back)
635; "$") nil t) 625;; "$") nil t)
636; (progn 626;; (progn
637; (tar-copy (if (file-directory-p newname) 627;; (tar-copy (if (file-directory-p newname)
638; (expand-file-name 628;; (expand-file-name
639; (file-name-nondirectory back) newname) 629;; (file-name-nondirectory back) newname)
640; newname)) 630;; newname))
641; (setq copied t)) 631;; (setq copied t))
642; (error "%s not found in tar file %s" back front)))))) 632;; (error "%s not found in tar file %s" back front))))))
643; (unless copied 633;; (unless copied
644; (copy-file file newname ok-if-already-exists keep-date)))) 634;; (copy-file file newname ok-if-already-exists keep-date))))
645 635
646; (defun eshell-file-attributes (filename) 636;; (defun eshell-file-attributes (filename)
647; "Return a list of attributes of file FILENAME. 637;; "Return a list of attributes of file FILENAME.
648; See the documentation for `file-attributes'." 638;; See the documentation for `file-attributes'."
649; (let (result) 639;; (let (result)
650; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename) 640;; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
651; (let ((front (match-string 1 filename)) 641;; (let ((front (match-string 1 filename))
652; (back (match-string 2 filename)) 642;; (back (match-string 2 filename))
653; buffer) 643;; buffer)
654; (when (and front (string-match eshell-tar-regexp front) 644;; (when (and front (string-match eshell-tar-regexp front)
655; (setq buffer (find-file-noselect front))) 645;; (setq buffer (find-file-noselect front)))
656; (with-current-buffer buffer 646;; (with-current-buffer buffer
657; (goto-char (point-min)) 647;; (goto-char (point-min))
658; (when (re-search-forward (concat " " (regexp-quote back) 648;; (when (re-search-forward (concat " " (regexp-quote back)
659; "\\s-*$") nil t) 649;; "\\s-*$") nil t)
660; (let* ((descrip (tar-current-descriptor)) 650;; (let* ((descrip (tar-current-descriptor))
661; (tokens (tar-desc-tokens descrip))) 651;; (tokens (tar-desc-tokens descrip)))
662; (setq result 652;; (setq result
663; (list 653;; (list
664; (cond 654;; (cond
665; ((eq (tar-header-link-type tokens) 5) 655;; ((eq (tar-header-link-type tokens) 5)
666; t) 656;; t)
667; ((eq (tar-header-link-type tokens) t) 657;; ((eq (tar-header-link-type tokens) t)
668; (tar-header-link-name tokens))) 658;; (tar-header-link-name tokens)))
669; 1 659;; 1
670; (tar-header-uid tokens) 660;; (tar-header-uid tokens)
671; (tar-header-gid tokens) 661;; (tar-header-gid tokens)
672; (tar-header-date tokens) 662;; (tar-header-date tokens)
673; (tar-header-date tokens) 663;; (tar-header-date tokens)
674; (tar-header-date tokens) 664;; (tar-header-date tokens)
675; (tar-header-size tokens) 665;; (tar-header-size tokens)
676; (concat 666;; (file-modes-number-to-symbolic
677; (cond 667;; (logior (tar-header-mode tokens)
678; ((eq (tar-header-link-type tokens) 5) "d") 668;; (cond
679; ((eq (tar-header-link-type tokens) t) "l") 669;; ((eq (tar-header-link-type tokens) 5) 16384)
680; (t "-")) 670;; ((eq (tar-header-link-type tokens) t) 32768))))
681; (tar-grind-file-mode (tar-header-mode tokens) 671;; nil nil nil))))))))
682; (make-string 9 ? ) 0)) 672;; (or result
683; nil nil nil)))))))) 673;; (file-attributes filename))))
684; (or result
685; (file-attributes filename))))
686 674
687;; Obsolete. 675;; Obsolete.
688 676
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 2d06658b55c..8db1b42db44 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -539,6 +539,7 @@ filter out the color from the output."
539This is installed as a `revert-buffer-function' in the *Colors* buffer." 539This is installed as a `revert-buffer-function' in the *Colors* buffer."
540 (list-colors-display nil (buffer-name) list-colors-callback)) 540 (list-colors-display nil (buffer-name) list-colors-callback))
541 541
542;;;###autoload
542(defun list-colors-display (&optional list buffer-name callback) 543(defun list-colors-display (&optional list buffer-name callback)
543 "Display names of defined colors, and show what they look like. 544 "Display names of defined colors, and show what they look like.
544If the optional argument LIST is non-nil, it should be a list of 545If the optional argument LIST is non-nil, it should be a list of
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 23e4562f4b1..9e1954256a6 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -1,4 +1,4 @@
1;;; files-x.el --- extended file handling commands 1;;; files-x.el --- extended file handling commands -*- 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
@@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).")
602 "Normalize plist CRITERIA according to properties. 602 "Normalize plist CRITERIA according to properties.
603Return a reordered plist." 603Return a reordered plist."
604 (apply 604 (apply
605 'append 605 #'append
606 (mapcar 606 (mapcar
607 (lambda (property) 607 (lambda (property)
608 (when (and (plist-member criteria property) (plist-get criteria property)) 608 (when (and (plist-member criteria property) (plist-get criteria property))
diff --git a/lisp/files.el b/lisp/files.el
index b18d4bda764..ac508665c35 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7638,6 +7638,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
7638 ;; Rights relative to the previous file modes. 7638 ;; Rights relative to the previous file modes.
7639 ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) 7639 ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
7640 ((= char ?u) (let ((uright (logand #o4700 from))) 7640 ((= char ?u) (let ((uright (logand #o4700 from)))
7641 ;; FIXME: These divisions/shifts seem to be right
7642 ;; for the `7' part of the #o4700 mask, but not
7643 ;; for the `4' part. Same below for `g' and `o'.
7641 (+ uright (/ uright #o10) (/ uright #o100)))) 7644 (+ uright (/ uright #o10) (/ uright #o100))))
7642 ((= char ?g) (let ((gright (logand #o2070 from))) 7645 ((= char ?g) (let ((gright (logand #o2070 from)))
7643 (+ gright (/ gright #o10) (* gright #o10)))) 7646 (+ gright (/ gright #o10) (* gright #o10))))
@@ -7672,11 +7675,28 @@ as in \"og+rX-w\"."
7672 op char-right))) 7675 op char-right)))
7673 num-rights)) 7676 num-rights))
7674 7677
7675(defun file-modes-number-to-symbolic (mode) 7678(defun file-modes-number-to-symbolic (mode &optional filetype)
7679 "Return a string describing a a file's MODE.
7680For instance, if MODE is #o700, then it produces `-rwx------'.
7681FILETYPE if provided should be a character denoting the type of file,
7682such as `?d' for a directory, or `?l' for a symbolic link and will override
7683the leading `-' char."
7676 (string 7684 (string
7677 (if (zerop (logand 8192 mode)) 7685 (or filetype
7678 (if (zerop (logand 16384 mode)) ?- ?d) 7686 (pcase (lsh mode -12)
7679 ?c) ; completeness 7687 ;; POSIX specifies that the file type is included in st_mode
7688 ;; and provides names for the file types but values only for
7689 ;; the permissions (e.g., S_IWOTH=2).
7690
7691 ;; (#o017 ??) ;; #define S_IFMT 00170000
7692 (#o014 ?s) ;; #define S_IFSOCK 0140000
7693 (#o012 ?l) ;; #define S_IFLNK 0120000
7694 ;; (8 ??) ;; #define S_IFREG 0100000
7695 (#o006 ?b) ;; #define S_IFBLK 0060000
7696 (#o004 ?d) ;; #define S_IFDIR 0040000
7697 (#o002 ?c) ;; #define S_IFCHR 0020000
7698 (#o001 ?p) ;; #define S_IFIFO 0010000
7699 (_ ?-)))
7680 (if (zerop (logand 256 mode)) ?- ?r) 7700 (if (zerop (logand 256 mode)) ?- ?r)
7681 (if (zerop (logand 128 mode)) ?- ?w) 7701 (if (zerop (logand 128 mode)) ?- ?w)
7682 (if (zerop (logand 64 mode)) 7702 (if (zerop (logand 64 mode))
diff --git a/lisp/find-file.el b/lisp/find-file.el
index 8cc9c972ed4..6c3c0f123b1 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -1,4 +1,4 @@
1;;; find-file.el --- find a file corresponding to this one given a pattern 1;;; find-file.el --- find a file corresponding to this one given a pattern -*- lexical-binding: t; -*-
2 2
3;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au> 3;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au>
4;; Maintainer: emacs-devel@gnu.org 4;; Maintainer: emacs-devel@gnu.org
@@ -39,8 +39,8 @@
39;; and just has a different extension as described by the ff-other-file-alist 39;; and just has a different extension as described by the ff-other-file-alist
40;; variable: 40;; variable:
41;; 41;;
42;; '(("\\.cc$" (".hh" ".h")) 42;; '(("\\.cc\\'" (".hh" ".h"))
43;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp"))) 43;; ("\\.hh\\'" (".cc" ".C" ".CC" ".cxx" ".cpp")))
44;; 44;;
45;; If the current file has a .cc extension, ff-find-other-file will attempt 45;; If the current file has a .cc extension, ff-find-other-file will attempt
46;; to look for a .hh file, and then a .h file in some directory as described 46;; to look for a .hh file, and then a .h file in some directory as described
@@ -55,8 +55,8 @@
55;; format above can be changed to include a function to be called when the 55;; format above can be changed to include a function to be called when the
56;; current file matches the regexp: 56;; current file matches the regexp:
57;; 57;;
58;; '(("\\.cc$" cc--function) 58;; '(("\\.cc\\'" cc--function)
59;; ("\\.hh$" hh-function)) 59;; ("\\.hh\\'" hh-function))
60;; 60;;
61;; These functions must return a list consisting of the possible names of the 61;; These functions must return a list consisting of the possible names of the
62;; corresponding file, with or without path. There is no real need for more 62;; corresponding file, with or without path. There is no real need for more
@@ -64,10 +64,10 @@
64;; file-alist: 64;; file-alist:
65;; 65;;
66;; (setq cc-other-file-alist 66;; (setq cc-other-file-alist
67;; '(("\\.cc$" ff-cc-hh-converter) 67;; '(("\\.cc\\'" ff-cc-hh-converter)
68;; ("\\.hh$" ff-cc-hh-converter) 68;; ("\\.hh\\'" ff-cc-hh-converter)
69;; ("\\.c$" (".h")) 69;; ("\\.c\\'" (".h"))
70;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")))) 70;; ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
71;; 71;;
72;; ff-cc-hh-converter is included at the end of this file as a reference. 72;; ff-cc-hh-converter is included at the end of this file as a reference.
73;; 73;;
@@ -130,62 +130,51 @@
130 130
131(defcustom ff-pre-find-hook nil 131(defcustom ff-pre-find-hook nil
132 "List of functions to be called before the search for the file starts." 132 "List of functions to be called before the search for the file starts."
133 :type 'hook 133 :type 'hook)
134 :group 'ff)
135 134
136(defcustom ff-pre-load-hook nil 135(defcustom ff-pre-load-hook nil
137 "List of functions to be called before the other file is loaded." 136 "List of functions to be called before the other file is loaded."
138 :type 'hook 137 :type 'hook)
139 :group 'ff)
140 138
141(defcustom ff-post-load-hook nil 139(defcustom ff-post-load-hook nil
142 "List of functions to be called after the other file is loaded." 140 "List of functions to be called after the other file is loaded."
143 :type 'hook 141 :type 'hook)
144 :group 'ff)
145 142
146(defcustom ff-not-found-hook nil 143(defcustom ff-not-found-hook nil
147 "List of functions to be called if the other file could not be found." 144 "List of functions to be called if the other file could not be found."
148 :type 'hook 145 :type 'hook)
149 :group 'ff)
150 146
151(defcustom ff-file-created-hook nil 147(defcustom ff-file-created-hook nil
152 "List of functions to be called if the other file needs to be created." 148 "List of functions to be called if the other file needs to be created."
153 :type 'hook 149 :type 'hook)
154 :group 'ff)
155 150
156(defcustom ff-case-fold-search nil 151(defcustom ff-case-fold-search nil
157 "Non-nil means ignore cases in matches (see `case-fold-search'). 152 "Non-nil means ignore cases in matches (see `case-fold-search').
158If you have extensions in different cases, you will want this to be nil." 153If you have extensions in different cases, you will want this to be nil."
159 :type 'boolean 154 :type 'boolean)
160 :group 'ff)
161 155
162(defcustom ff-always-in-other-window nil 156(defcustom ff-always-in-other-window nil
163 "If non-nil, find the corresponding file in another window by default. 157 "If non-nil, find the corresponding file in another window by default.
164To override this, give an argument to `ff-find-other-file'." 158To override this, give an argument to `ff-find-other-file'."
165 :type 'boolean 159 :type 'boolean)
166 :group 'ff)
167 160
168(defcustom ff-ignore-include nil 161(defcustom ff-ignore-include nil
169 "If non-nil, ignore `#include' lines." 162 "If non-nil, ignore `#include' lines."
170 :type 'boolean 163 :type 'boolean)
171 :group 'ff)
172 164
173(defcustom ff-always-try-to-create t 165(defcustom ff-always-try-to-create t
174 "If non-nil, always attempt to create the other file if it was not found." 166 "If non-nil, always attempt to create the other file if it was not found."
175 :type 'boolean 167 :type 'boolean)
176 :group 'ff)
177 168
178(defcustom ff-quiet-mode nil 169(defcustom ff-quiet-mode nil
179 "If non-nil, trace which directories are being searched." 170 "If non-nil, trace which directories are being searched."
180 :type 'boolean 171 :type 'boolean)
181 :group 'ff)
182 172
183;;;###autoload 173;;;###autoload
184(defcustom ff-special-constructs 174(defcustom ff-special-constructs
185 ;; C/C++ include, for NeXTstep too 175 ;; C/C++ include, for NeXTstep too
186 `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") . 176 `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
187 (lambda () 177 ,(lambda () (match-string 2))))
188 (buffer-substring (match-beginning 2) (match-end 2)))))
189 ;; We include `ff-treat-as-special' documentation here so that autoload 178 ;; We include `ff-treat-as-special' documentation here so that autoload
190 ;; can make it available to be read prior to loading this file. 179 ;; can make it available to be read prior to loading this file.
191 "List of special constructs recognized by `ff-treat-as-special'. 180 "List of special constructs recognized by `ff-treat-as-special'.
@@ -194,8 +183,7 @@ If REGEXP matches the current line (from the beginning of the line),
194`ff-treat-as-special' calls function EXTRACT with no args. 183`ff-treat-as-special' calls function EXTRACT with no args.
195If EXTRACT returns nil, keep trying. Otherwise, return the 184If EXTRACT returns nil, keep trying. Otherwise, return the
196filename that EXTRACT returned." 185filename that EXTRACT returned."
197 :type '(repeat (cons regexp function)) 186 :type '(repeat (cons regexp function)))
198 :group 'ff)
199 187
200(defvaralias 'ff-related-file-alist 'ff-other-file-alist) 188(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
201(defcustom ff-other-file-alist 'cc-other-file-alist 189(defcustom ff-other-file-alist 'cc-other-file-alist
@@ -207,8 +195,7 @@ directory specified in `ff-search-directories'. If a file is not found,
207a new one is created with the first matching extension (`.cc' yields `.hh'). 195a new one is created with the first matching extension (`.cc' yields `.hh').
208This alist should be set by the major mode." 196This alist should be set by the major mode."
209 :type '(choice (repeat (list regexp (choice (repeat string) function))) 197 :type '(choice (repeat (list regexp (choice (repeat string) function)))
210 symbol) 198 symbol))
211 :group 'ff)
212 199
213(defcustom ff-search-directories 'cc-search-directories 200(defcustom ff-search-directories 'cc-search-directories
214 "List of directories to search for a specific file. 201 "List of directories to search for a specific file.
@@ -231,14 +218,12 @@ not exist, it is replaced (silently) with an empty string.
231The stars are *not* wildcards: they are searched for together with 218The stars are *not* wildcards: they are searched for together with
232the preceding slash. The star represents all the subdirectories except 219the preceding slash. The star represents all the subdirectories except
233`..', and each of these subdirectories will be searched in turn." 220`..', and each of these subdirectories will be searched in turn."
234 :type '(choice (repeat directory) symbol) 221 :type '(choice (repeat directory) symbol))
235 :group 'ff)
236 222
237(defcustom cc-search-directories 223(defcustom cc-search-directories
238 '("." "/usr/include" "/usr/local/include/*") 224 '("." "/usr/include" "/usr/local/include/*")
239 "See the description of the `ff-search-directories' variable." 225 "See the description of the `ff-search-directories' variable."
240 :type '(repeat directory) 226 :type '(repeat directory))
241 :group 'ff)
242 227
243(defcustom cc-other-file-alist 228(defcustom cc-other-file-alist
244 '(("\\.cc\\'" (".hh" ".h")) 229 '(("\\.cc\\'" (".hh" ".h"))
@@ -269,17 +254,15 @@ since the search algorithm searches sequentially through each directory
269specified in `ff-search-directories'. If a file is not found, a new one 254specified in `ff-search-directories'. If a file is not found, a new one
270is created with the first matching extension (`.cc' yields `.hh')." 255is created with the first matching extension (`.cc' yields `.hh')."
271 :version "24.4" ; add .m 256 :version "24.4" ; add .m
272 :type '(repeat (list regexp (choice (repeat string) function))) 257 :type '(repeat (list regexp (choice (repeat string) function))))
273 :group 'ff)
274 258
275(defcustom modula2-other-file-alist 259(defcustom modula2-other-file-alist
276 '( 260 '(
277 ("\\.mi$" (".md")) ;; Modula-2 module definition 261 ("\\.mi\\'" (".md")) ;; Modula-2 module definition
278 ("\\.md$" (".mi")) ;; and implementation. 262 ("\\.md\\'" (".mi")) ;; and implementation.
279 ) 263 )
280 "See the description for the `ff-search-directories' variable." 264 "See the description for the `ff-search-directories' variable."
281 :type '(repeat (list regexp (choice (repeat string) function))) 265 :type '(repeat (list regexp (choice (repeat string) function))))
282 :group 'ff)
283 266
284 267
285;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 268;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -308,16 +291,14 @@ See also the documentation for `ff-find-other-file'.
308 291
309If optional IN-OTHER-WINDOW is non-nil, find the file in another window." 292If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
310 (interactive "P") 293 (interactive "P")
311 (let ((ignore ff-ignore-include)) 294 (let ((ff-ignore-include t))
312 (setq ff-ignore-include t) 295 (ff-find-the-other-file in-other-window)))
313 (ff-find-the-other-file in-other-window)
314 (setq ff-ignore-include ignore)))
315 296
316;;;###autoload 297;;;###autoload
317(defalias 'ff-find-related-file 'ff-find-other-file) 298(defalias 'ff-find-related-file #'ff-find-other-file)
318 299
319;;;###autoload 300;;;###autoload
320(defun ff-find-other-file (&optional in-other-window ignore-include) 301(defun ff-find-other-file (&optional in-other-window ignore-include event)
321 "Find the header or source file corresponding to this file. 302 "Find the header or source file corresponding to this file.
322Being on a `#include' line pulls in that file. 303Being on a `#include' line pulls in that file.
323 304
@@ -369,11 +350,11 @@ Variables of interest include:
369 350
370 - `ff-file-created-hook' 351 - `ff-file-created-hook'
371 List of functions to be called if the other file has been created." 352 List of functions to be called if the other file has been created."
372 (interactive "P") 353 (interactive (list current-prefix-arg nil last-nonmenu-event))
373 (let ((ignore ff-ignore-include)) 354 (save-excursion
374 (setq ff-ignore-include ignore-include) 355 (posn-set-point (event-end event))
375 (ff-find-the-other-file in-other-window) 356 (let ((ff-ignore-include ignore-include))
376 (setq ff-ignore-include ignore))) 357 (ff-find-the-other-file in-other-window))))
377 358
378;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 359;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
379;; Support functions 360;; Support functions
@@ -413,9 +394,9 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
413 (message "Working...") 394 (message "Working...")
414 395
415 (setq dirs 396 (setq dirs
416 (if (symbolp ff-search-directories) 397 (ff-list-replace-env-vars (if (symbolp ff-search-directories)
417 (ff-list-replace-env-vars (symbol-value ff-search-directories)) 398 (symbol-value ff-search-directories)
418 (ff-list-replace-env-vars ff-search-directories))) 399 ff-search-directories)))
419 400
420 (setq fname (ff-treat-as-special)) 401 (setq fname (ff-treat-as-special))
421 402
@@ -454,11 +435,10 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
454 ;; if we have a function to generate new names, 435 ;; if we have a function to generate new names,
455 ;; invoke it with the name of the current file 436 ;; invoke it with the name of the current file
456 (if (and (atom action) (fboundp action)) 437 (if (and (atom action) (fboundp action))
457 (progn 438 (setq suffixes (funcall action (ff-buffer-file-name))
458 (setq suffixes (funcall action (ff-buffer-file-name)) 439 match (cons (car match) (list suffixes))
459 match (cons (car match) (list suffixes)) 440 stub nil
460 stub nil 441 default-name (car suffixes))
461 default-name (car suffixes)))
462 442
463 ;; otherwise build our filename stub 443 ;; otherwise build our filename stub
464 (cond 444 (cond
@@ -472,7 +452,8 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
472 (t 452 (t
473 (setq format (concat "\\(.+\\)" (car match))) 453 (setq format (concat "\\(.+\\)" (car match)))
474 (string-match format fname) 454 (string-match format fname)
475 (setq stub (substring fname (match-beginning 1) (match-end 1))) 455 ;; FIXME: What if `string-match' failed?
456 (setq stub (match-string 1 fname))
476 )) 457 ))
477 458
478 ;; if we find nothing, we should try to get a file like this one 459 ;; if we find nothing, we should try to get a file like this one
@@ -522,89 +503,6 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
522 503
523 found)) ;; return buffer-name or filename 504 found)) ;; return buffer-name or filename
524 505
525(defun ff-other-file-name ()
526 "Return name of the header or source file corresponding to the current file.
527Being on a `#include' line pulls in that file, but see the help on
528the `ff-ignore-include' variable."
529
530 (let (match ;; matching regexp for this file
531 suffixes ;; set of replacing regexps for the matching regexp
532 action ;; function to generate the names of the other files
533 fname ;; basename of this file
534 pos ;; where we start matching filenames
535 stub ;; name of the file without extension
536 alist ;; working copy of the list of file extensions
537 pathname ;; the pathname of the file or the #include line
538 format ;; what we have to match
539 found ;; name of the file or buffer found - nil if none
540 dirs) ;; local value of ff-search-directories
541
542 (message "Working...")
543
544 (setq dirs
545 (if (symbolp ff-search-directories)
546 (ff-list-replace-env-vars (symbol-value ff-search-directories))
547 (ff-list-replace-env-vars ff-search-directories)))
548
549 (setq fname (ff-treat-as-special))
550
551 (cond
552 ((and (not ff-ignore-include) fname)
553 (setq found (ff-get-file-name dirs fname nil)))
554
555 ;; let's just get the corresponding file
556 (t
557 (setq alist (if (symbolp ff-other-file-alist)
558 (symbol-value ff-other-file-alist)
559 ff-other-file-alist)
560 pathname (or (ff-buffer-file-name) "/none.none"))
561
562 (setq fname (file-name-nondirectory pathname)
563 match (car alist))
564
565 ;; find the table entry corresponding to this file
566 (setq pos (ff-string-match (car match) fname))
567 (while (and match (if (and pos (>= pos 0)) nil (not pos)))
568 (setq alist (cdr alist))
569 (setq match (car alist))
570 (setq pos (ff-string-match (car match) fname)))
571
572 ;; no point going on if we haven't found anything
573 (when match
574
575 ;; otherwise, suffixes contains what we need
576 (setq suffixes (car (cdr match))
577 action (car (cdr match))
578 found nil)
579
580 ;; if we have a function to generate new names,
581 ;; invoke it with the name of the current file
582 (if (and (atom action) (fboundp action))
583 (progn
584 (setq suffixes (funcall action (ff-buffer-file-name))
585 match (cons (car match) (list suffixes))
586 stub nil))
587
588 ;; otherwise build our filename stub
589 (cond
590
591 ;; get around the problem that 0 and nil both mean false!
592 ((= pos 0)
593 (setq format "")
594 (setq stub "")
595 )
596
597 (t
598 (setq format (concat "\\(.+\\)" (car match)))
599 (string-match format fname)
600 (setq stub (substring fname (match-beginning 1) (match-end 1)))
601 )))
602
603 ;; do the real work - find the file
604 (setq found
605 (ff-get-file-name dirs stub suffixes)))))
606 found)) ;; return buffer-name or filename
607
608(defun ff-get-file (search-dirs filename &optional suffix-list other-window) 506(defun ff-get-file (search-dirs filename &optional suffix-list other-window)
609 "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). 507 "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub).
610If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search 508If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search
@@ -709,11 +607,10 @@ name of the first file found."
709 607
710 ;; otherwise dir matches the '/*', so search each dir separately 608 ;; otherwise dir matches the '/*', so search each dir separately
711 (progn 609 (progn
712 (if (match-beginning 2) 610 (setq rest (if (match-beginning 2)
713 (setq rest (substring dir (match-beginning 2) (match-end 2))) 611 (match-string 2 dir)
714 (setq rest "") 612 ""))
715 ) 613 (setq dir (match-string 1 dir))
716 (setq dir (substring dir (match-beginning 1) (match-end 1)))
717 614
718 (let ((dirlist (ff-all-dirs-under dir '(".."))) 615 (let ((dirlist (ff-all-dirs-under dir '("..")))
719 this-dir compl-dirs) 616 this-dir compl-dirs)
@@ -743,8 +640,8 @@ name of the first file found."
743(defun ff-string-match (regexp string &optional start) 640(defun ff-string-match (regexp string &optional start)
744 "Like `string-match', but set `case-fold-search' temporarily. 641 "Like `string-match', but set `case-fold-search' temporarily.
745The value used comes from `ff-case-fold-search'." 642The value used comes from `ff-case-fold-search'."
746 (let ((case-fold-search ff-case-fold-search)) 643 (if regexp
747 (if regexp 644 (let ((case-fold-search ff-case-fold-search))
748 (string-match regexp string start)))) 645 (string-match regexp string start))))
749 646
750(defun ff-list-replace-env-vars (search-list) 647(defun ff-list-replace-env-vars (search-list)
@@ -752,12 +649,12 @@ The value used comes from `ff-case-fold-search'."
752 (let (list 649 (let (list
753 (var (car search-list))) 650 (var (car search-list)))
754 (while search-list 651 (while search-list
755 (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var) 652 (if (string-match "\\(.*\\)\\$[({]*\\([[:alnum:]_]+\\)[)}]*\\(.*\\)" var)
756 (setq var 653 (setq var
757 (concat 654 (concat
758 (substring var (match-beginning 1) (match-end 1)) 655 (match-string 1 var)
759 (getenv (substring var (match-beginning 2) (match-end 2))) 656 (getenv (match-string 2 var))
760 (substring var (match-beginning 3) (match-end 3))))) 657 (match-string 3 var))))
761 (setq search-list (cdr search-list)) 658 (setq search-list (cdr search-list))
762 (setq list (cons var list)) 659 (setq list (cons var list))
763 (setq var (car search-list))) 660 (setq var (car search-list)))
@@ -782,11 +679,7 @@ See variable `ff-special-constructs'."
782 (setq match (cdr elem))) 679 (setq match (cdr elem)))
783 fname))) 680 fname)))
784 681
785(defun ff-basename (string) 682(define-obsolete-function-alias 'ff-basename #'file-name-nondirectory "28.1")
786 "Return the basename of pathname STRING."
787 (setq string (concat "/" string))
788 (string-match ".*/\\([^/]+\\)$" string)
789 (setq string (substring string (match-beginning 1) (match-end 1))))
790 683
791(defun ff-all-dirs-under (here &optional exclude) 684(defun ff-all-dirs-under (here &optional exclude)
792 "Get all the directory files under directory HERE. 685 "Get all the directory files under directory HERE.
@@ -800,7 +693,7 @@ Exclude all files in the optional EXCLUDE list."
800 (setq file (car files)) 693 (setq file (car files))
801 (if (and 694 (if (and
802 (file-directory-p file) 695 (file-directory-p file)
803 (not (member (ff-basename file) exclude))) 696 (not (member (file-name-nondirectory file) exclude)))
804 (setq dirlist (cons file dirlist))) 697 (setq dirlist (cons file dirlist)))
805 (setq files (cdr files))) 698 (setq files (cdr files)))
806 (setq dirlist (reverse dirlist)))) 699 (setq dirlist (reverse dirlist))))
@@ -820,84 +713,65 @@ or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs.
820If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is 713If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is
821called before `ff-post-load-hook'." 714called before `ff-post-load-hook'."
822 (run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks) 715 (run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks)
823 (if (or 716 (funcall (if (or
824 (and in-other-window (not ff-always-in-other-window)) 717 (and in-other-window (not ff-always-in-other-window))
825 (and (not in-other-window) ff-always-in-other-window)) 718 (and (not in-other-window) ff-always-in-other-window))
826 (funcall f2 file) 719 f2 f1)
827 (funcall f1 file)) 720 file)
828 (if new-file 721 (if new-file
829 (run-hooks 'ff-file-created-hook 'ff-file-created-hooks)) 722 (run-hooks 'ff-file-created-hook 'ff-file-created-hooks))
830 (run-hooks 'ff-post-load-hook 'ff-post-load-hooks)) 723 (run-hooks 'ff-post-load-hook 'ff-post-load-hooks))
831 724
832(defun ff-find-file (file &optional in-other-window new-file) 725(defun ff-find-file (file &optional in-other-window new-file)
833 "Like `find-file', but may show the file in another window." 726 "Like `find-file', but may show the file in another window."
834 (ff-switch-file 'find-file 727 (ff-switch-file #'find-file
835 'find-file-other-window 728 #'find-file-other-window
836 file in-other-window new-file)) 729 file in-other-window new-file))
837 730
838(defun ff-switch-to-buffer (buffer-or-name &optional in-other-window) 731(defun ff-switch-to-buffer (buffer-or-name &optional in-other-window)
839 "Like `switch-to-buffer', but may show the buffer in another window." 732 "Like `switch-to-buffer', but may show the buffer in another window."
840 733
841 (ff-switch-file 'switch-to-buffer 734 (ff-switch-file #'switch-to-buffer
842 'switch-to-buffer-other-window 735 #'switch-to-buffer-other-window
843 buffer-or-name in-other-window nil)) 736 buffer-or-name in-other-window nil))
844 737
845;;;###autoload 738;;;###autoload
846(defun ff-mouse-find-other-file (event) 739(define-obsolete-function-alias
847 "Visit the file you click on." 740 'ff-mouse-find-other-file #'ff-find-other-file "28.1")
848 (interactive "e")
849 (save-excursion
850 (mouse-set-point event)
851 (ff-find-other-file nil)))
852 741
853;;;###autoload 742;;;###autoload
854(defun ff-mouse-find-other-file-other-window (event) 743(define-obsolete-function-alias
855 "Visit the file you click on in another window." 744 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1")
856 (interactive "e") 745;;;###autoload
857 (save-excursion 746(defun ff-find-other-file-other-window (event)
858 (mouse-set-point event) 747 "Visit the file you point at in another window."
859 (ff-find-other-file t))) 748 (interactive (list last-nonmenu-event))
749 (ff-find-other-file t nil event))
860 750
861;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 751;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
862;; This section offers an example of user defined function to select files 752;; This section offers an example of user defined function to select files
863 753
864(defun ff-upcase-p (string &optional start end) 754(defun ff-upcase-p (string)
865 "Return t if STRING is all uppercase. 755 "Return t if STRING is all uppercase."
866Given START and/or END, checks between these characters." 756 ;; FIXME: Why `ff-string-match' since `[:upper:]' only makes
867 (let (match str) 757 ;; sense when `case-fold-search' is nil?
868 (if (not start) 758 (ff-string-match "\\`[[:upper:]]*\\'" string))
869 (setq start 0))
870 (if (not end)
871 (setq end (length string)))
872 (if (= start end)
873 (setq end (1+ end)))
874 (setq str (substring string start end))
875 (if (and
876 (ff-string-match "[A-Z]+" str)
877 (setq match (match-data))
878 (= (car match) 0)
879 (= (car (cdr match)) (length str)))
880 t
881 nil)))
882 759
883(defun ff-cc-hh-converter (arg) 760(defun ff-cc-hh-converter (arg)
884 "Discriminate file extensions. 761 "Discriminate file extensions.
885Build up a new file list based possibly on part of the directory name 762Build up a new file list based possibly on part of the directory name
886and the name of the file passed in." 763and the name of the file passed in."
887 (ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg) 764 (ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg)
888 (let ((dire (if (match-beginning 2) 765 (let ((dire (match-string 2 arg))
889 (substring arg (match-beginning 2) (match-end 2)) nil)) 766 (file (match-string 3 arg))
890 (file (if (match-beginning 3) 767 (extn (match-string 4 arg))
891 (substring arg (match-beginning 3) (match-end 3)) nil))
892 (extn (if (match-beginning 4)
893 (substring arg (match-beginning 4) (match-end 4)) nil))
894 return-list) 768 return-list)
895 (cond 769 (cond
896 ;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h} 770 ;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h}
897 ((and (string= extn "cc") 771 ((and (string= extn "cc")
898 (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file)) 772 (ff-string-match "^\\([[:lower:]]+\\)\\([[:upper:]].+\\)$" file))
899 (let ((stub (substring file (match-beginning 2) (match-end 2)))) 773 (let ((stub (match-string 2 file)))
900 (setq dire (upcase (substring file (match-beginning 1) (match-end 1)))) 774 (setq dire (upcase (match-string 1 file)))
901 (setq return-list (list (concat stub ".hh") 775 (setq return-list (list (concat stub ".hh")
902 (concat stub ".h") 776 (concat stub ".h")
903 (concat file ".hh") 777 (concat file ".hh")
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 3419d7f5981..cadf2746ba1 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -1,4 +1,4 @@
1;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode 1;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -*- 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
@@ -33,7 +33,7 @@
33;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) 33;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry)
34;; to expose the body or C-c C-i to expose the child (level-2) headings. 34;; to expose the body or C-c C-i to expose the child (level-2) headings.
35;; 35;;
36;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body 36;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the body
37;; and child subheadings and narrows the buffer so that only the level-1 37;; and child subheadings and narrows the buffer so that only the level-1
38;; heading, the body and the level-2 headings are visible. If you now want to 38;; heading, the body and the level-2 headings are visible. If you now want to
39;; look under one of the level-2 headings, position the cursor on it and do C-c 39;; look under one of the level-2 headings, position the cursor on it and do C-c
@@ -57,7 +57,7 @@
57;; zoomed-in heading. This is useful for restricting changes to a particular 57;; zoomed-in heading. This is useful for restricting changes to a particular
58;; chapter or section of your document. 58;; chapter or section of your document.
59;; 59;;
60;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides 60;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides
61;; all the text and subheadings under the top-level heading and returns you to 61;; all the text and subheadings under the top-level heading and returns you to
62;; the previous view of the buffer. Specifying a numeric argument exits that 62;; the previous view of the buffer. Specifying a numeric argument exits that
63;; many folds. Specifying a zero argument exits *all* folds. 63;; many folds. Specifying a zero argument exits *all* folds.
@@ -216,6 +216,8 @@ An end marker of nil means the fold ends after (point-max).")
216(defvar-local foldout-mode-line-string nil 216(defvar-local foldout-mode-line-string nil
217 "Mode line string announcing that we are in an outline fold.") 217 "Mode line string announcing that we are in an outline fold.")
218 218
219;; FIXME: This should be rewritten as a proper minor mode.
220
219;; put our minor mode string immediately following outline-minor-mode's 221;; put our minor mode string immediately following outline-minor-mode's
220(or (assq 'foldout-mode-line-string minor-mode-alist) 222(or (assq 'foldout-mode-line-string minor-mode-alist)
221 (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) 223 (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist)
@@ -227,8 +229,7 @@ An end marker of nil means the fold ends after (point-max).")
227 (error "Can't find outline-minor-mode in minor-mode-alist")) 229 (error "Can't find outline-minor-mode in minor-mode-alist"))
228 230
229 ;; slip our fold announcement into the list 231 ;; slip our fold announcement into the list
230 (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) 232 (setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))))
231 ))
232 233
233 234
234 235
@@ -275,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg) changes this:-
275 ((> exposure-value 0) 276 ((> exposure-value 0)
276 (outline-show-children exposure-value)) 277 (outline-show-children exposure-value))
277 (t 278 (t
278 (outline-show-subtree)) 279 (outline-show-subtree)))
279 )
280 280
281 ;; save the location of the fold we are entering 281 ;; save the location of the fold we are entering
282 (setq foldout-fold-list (cons (cons start-marker end-marker) 282 (setq foldout-fold-list (cons (cons start-marker end-marker)
283 foldout-fold-list)) 283 foldout-fold-list))
284 284
285 ;; update the mode line 285 ;; update the mode line
286 (foldout-update-mode-line) 286 (foldout-update-mode-line))))
287 )))
288 287
289 288
290(defun foldout-exit-fold (&optional num-folds) 289(defun foldout-exit-fold (&optional num-folds)
@@ -308,8 +307,7 @@ exited and text is left visible."
308 ;; have we been told not to hide the fold? 307 ;; have we been told not to hide the fold?
309 ((< num-folds 0) 308 ((< num-folds 0)
310 (setq hide-fold nil 309 (setq hide-fold nil
311 num-folds (- num-folds))) 310 num-folds (- num-folds))))
312 )
313 311
314 ;; limit the number of folds if we've been told to exit too many 312 ;; limit the number of folds if we've been told to exit too many
315 (setq num-folds (min num-folds (length foldout-fold-list))) 313 (setq num-folds (min num-folds (length foldout-fold-list)))
@@ -482,8 +480,8 @@ Signal an error if the final event isn't the same type as the first one."
482 event) 480 event)
483 481
484(defun foldout-mouse-goto-heading (event) 482(defun foldout-mouse-goto-heading (event)
485 "Go to the heading where the mouse event started. Signal an error 483 "Go to the heading where the mouse EVENT started.
486if the event didn't occur on a heading." 484Signal an error if the event didn't occur on a heading."
487 (goto-char (posn-point (event-start event))) 485 (goto-char (posn-point (event-start event)))
488 (or (outline-on-heading-p) 486 (or (outline-on-heading-p)
489 ;; outline.el sometimes treats beginning-of-buffer as a heading 487 ;; outline.el sometimes treats beginning-of-buffer as a heading
@@ -505,17 +503,16 @@ M-C-down-mouse-{1,2,3}.
505 503
506Valid modifiers are shift, control, meta, alt, hyper and super.") 504Valid modifiers are shift, control, meta, alt, hyper and super.")
507 505
508(if foldout-inhibit-key-bindings 506(unless foldout-inhibit-key-bindings
509 () 507 (define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree)
510 (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) 508 (define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold)
511 (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold)
512 (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) 509 (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix)))
513 (unless map 510 (unless map
514 (setq map (make-sparse-keymap)) 511 (setq map (make-sparse-keymap))
515 (define-key outline-minor-mode-map outline-minor-mode-prefix map)) 512 (define-key outline-minor-mode-map outline-minor-mode-prefix map))
516 (define-key map "\C-z" 'foldout-zoom-subtree) 513 (define-key map "\C-z" #'foldout-zoom-subtree)
517 (define-key map "\C-x" 'foldout-exit-fold)) 514 (define-key map "\C-x" #'foldout-exit-fold))
518 (let* ((modifiers (apply 'concat 515 (let* ((modifiers (apply #'concat
519 (mapcar (lambda (modifier) 516 (mapcar (lambda (modifier)
520 (vector 517 (vector
521 (cond 518 (cond
@@ -525,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
525 ((eq modifier 'alt) ?A) 522 ((eq modifier 'alt) ?A)
526 ((eq modifier 'hyper) ?H) 523 ((eq modifier 'hyper) ?H)
527 ((eq modifier 'super) ?s) 524 ((eq modifier 'super) ?s)
528 (t (error "invalid mouse modifier %s" 525 (t (error "Invalid mouse modifier %s"
529 modifier))) 526 modifier)))
530 ?-)) 527 ?-))
531 foldout-mouse-modifiers))) 528 foldout-mouse-modifiers)))
@@ -533,14 +530,13 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
533 (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) 530 (mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
534 (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) 531 (mouse-3 (vector (intern (concat modifiers "down-mouse-3")))))
535 532
536 (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) 533 (define-key outline-mode-map mouse-1 #'foldout-mouse-zoom)
537 (define-key outline-mode-map mouse-2 'foldout-mouse-show) 534 (define-key outline-mode-map mouse-2 #'foldout-mouse-show)
538 (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) 535 (define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit)
539 536
540 (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) 537 (define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom)
541 (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) 538 (define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show)
542 (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) 539 (define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit)))
543 ))
544 540
545;; Obsolete. 541;; Obsolete.
546 542
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 4b695424977..db06a607660 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -126,7 +126,6 @@ buffer local value for `font-lock-defaults', via its mode hook.
126The above is the default behavior of `font-lock-mode'; you may 126The above is the default behavior of `font-lock-mode'; you may
127specify your own function which is called when `font-lock-mode' 127specify your own function which is called when `font-lock-mode'
128is toggled via `font-lock-function'." 128is toggled via `font-lock-function'."
129 nil nil nil
130 :after-hook (font-lock-initial-fontify) 129 :after-hook (font-lock-initial-fontify)
131 ;; Don't turn on Font Lock mode if we don't have a display (we're running a 130 ;; Don't turn on Font Lock mode if we don't have a display (we're running a
132 ;; batch job) or if the buffer is invisible (the name starts with a space). 131 ;; batch job) or if the buffer is invisible (the name starts with a space).
diff --git a/lisp/frame.el b/lisp/frame.el
index 2b6e4a60b83..bca160175a5 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -301,7 +301,7 @@ This function runs the abnormal hook `move-frame-functions'."
301(declare-function tool-bar-mode "tool-bar" (&optional arg)) 301(declare-function tool-bar-mode "tool-bar" (&optional arg))
302(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) 302(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
303 303
304(defalias 'tool-bar-lines-needed 'tool-bar-height) 304(defalias 'tool-bar-lines-needed #'tool-bar-height)
305 305
306;; startup.el calls this function after loading the user's init 306;; startup.el calls this function after loading the user's init
307;; file. Now default-frame-alist and initial-frame-alist contain 307;; file. Now default-frame-alist and initial-frame-alist contain
@@ -690,8 +690,8 @@ is not considered (see `next-frame')."
690 0)) 690 0))
691 (select-frame-set-input-focus (selected-frame))) 691 (select-frame-set-input-focus (selected-frame)))
692 692
693(defalias 'next-multiframe-window 'next-window-any-frame) 693(defalias 'next-multiframe-window #'next-window-any-frame)
694(defalias 'previous-multiframe-window 'previous-window-any-frame) 694(defalias 'previous-multiframe-window #'previous-window-any-frame)
695 695
696(defun window-system-for-display (display) 696(defun window-system-for-display (display)
697 "Return the window system for DISPLAY. 697 "Return the window system for DISPLAY.
@@ -782,7 +782,7 @@ If DISPLAY is nil, that stands for the selected frame's display."
782 (format "Delete %s frames? " (length frames)) 782 (format "Delete %s frames? " (length frames))
783 (format "Delete %s ? " (car frames)))))) 783 (format "Delete %s ? " (car frames))))))
784 (error "Abort!") 784 (error "Abort!")
785 (mapc 'delete-frame frames) 785 (mapc #'delete-frame frames)
786 (x-close-connection display)))) 786 (x-close-connection display))))
787 787
788(defun make-frame-command () 788(defun make-frame-command ()
@@ -1162,8 +1162,8 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
1162 :group 'faces 1162 :group 'faces
1163 :set #'(lambda (var value) 1163 :set #'(lambda (var value)
1164 (set-default var value) 1164 (set-default var value)
1165 (mapc 'frame-set-background-mode (frame-list))) 1165 (mapc #'frame-set-background-mode (frame-list)))
1166 :initialize 'custom-initialize-changed 1166 :initialize #'custom-initialize-changed
1167 :type '(choice (const dark) 1167 :type '(choice (const dark)
1168 (const light) 1168 (const light)
1169 (const :tag "automatic" nil))) 1169 (const :tag "automatic" nil)))
@@ -1176,6 +1176,27 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
1176 1176
1177(defvar inhibit-frame-set-background-mode nil) 1177(defvar inhibit-frame-set-background-mode nil)
1178 1178
1179(defun frame--current-backround-mode (frame)
1180 (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
1181 (bg-color (frame-parameter frame 'background-color))
1182 (tty-type (tty-type frame))
1183 (default-bg-mode
1184 (if (or (window-system frame)
1185 (and tty-type
1186 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
1187 tty-type)))
1188 'light
1189 'dark)))
1190 (cond (frame-default-bg-mode)
1191 ((equal bg-color "unspecified-fg") ; inverted colors
1192 (if (eq default-bg-mode 'light) 'dark 'light))
1193 ((not (color-values bg-color frame))
1194 default-bg-mode)
1195 ((color-dark-p (mapcar (lambda (c) (/ c 65535.0))
1196 (color-values bg-color frame)))
1197 'dark)
1198 (t 'light))))
1199
1179(defun frame-set-background-mode (frame &optional keep-face-specs) 1200(defun frame-set-background-mode (frame &optional keep-face-specs)
1180 "Set up display-dependent faces on FRAME. 1201 "Set up display-dependent faces on FRAME.
1181Display-dependent faces are those which have different definitions 1202Display-dependent faces are those which have different definitions
@@ -1184,30 +1205,8 @@ according to the `background-mode' and `display-type' frame parameters.
1184If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate 1205If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
1185face specs for the new background mode." 1206face specs for the new background mode."
1186 (unless inhibit-frame-set-background-mode 1207 (unless inhibit-frame-set-background-mode
1187 (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) 1208 (let* ((bg-mode
1188 (bg-color (frame-parameter frame 'background-color)) 1209 (frame--current-backround-mode frame))
1189 (tty-type (tty-type frame))
1190 (default-bg-mode
1191 (if (or (window-system frame)
1192 (and tty-type
1193 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
1194 tty-type)))
1195 'light
1196 'dark))
1197 (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
1198 (bg-mode
1199 (cond (frame-default-bg-mode)
1200 ((equal bg-color "unspecified-fg") ; inverted colors
1201 non-default-bg-mode)
1202 ((not (color-values bg-color frame))
1203 default-bg-mode)
1204 ((>= (apply '+ (color-values bg-color frame))
1205 ;; Just looking at the screen, colors whose
1206 ;; values add up to .6 of the white total
1207 ;; still look dark to me.
1208 (* (apply '+ (color-values "white" frame)) .6))
1209 'light)
1210 (t 'dark)))
1211 (display-type 1210 (display-type
1212 (cond ((null (window-system frame)) 1211 (cond ((null (window-system frame))
1213 (if (tty-display-color-p frame) 'color 'mono)) 1212 (if (tty-display-color-p frame) 'color 'mono))
@@ -1273,6 +1272,26 @@ the `background-mode' terminal parameter."
1273 (intern (downcase bg-resource)))) 1272 (intern (downcase bg-resource))))
1274 (terminal-parameter frame 'background-mode))) 1273 (terminal-parameter frame 'background-mode)))
1275 1274
1275;; FIXME: This needs to be significantly improved before we can use it:
1276;; - Fix the "scope" to be consistent: the code below is partly per-frame
1277;; and partly all-frames :-(
1278;; - Make it interact correctly with color themes (e.g. modus-themes).
1279;; Maybe automatically disabling color themes that disagree with the
1280;; selected value of `dark-mode'.
1281;; - Check interaction with "(in|re)verse-video".
1282;;
1283;; (define-minor-mode dark-mode
1284;; "Use light text on dark background."
1285;; :global t
1286;; :group 'faces
1287;; (when (eq dark-mode
1288;; (eq 'light (frame--current-backround-mode (selected-frame))))
1289;; ;; FIXME: Change the face's SPEC instead?
1290;; (set-face-attribute 'default nil
1291;; :foreground (face-attribute 'default :background)
1292;; :background (face-attribute 'default :foreground))
1293;; (frame-set-background-mode (selected-frame))))
1294
1276 1295
1277;;;; Frame configurations 1296;;;; Frame configurations
1278 1297
@@ -1357,9 +1376,9 @@ differing font heights."
1357If FRAME is omitted, describe the currently selected frame." 1376If FRAME is omitted, describe the currently selected frame."
1358 (cdr (assq 'width (frame-parameters frame)))) 1377 (cdr (assq 'width (frame-parameters frame))))
1359 1378
1360(defalias 'frame-border-width 'frame-internal-border-width) 1379(defalias 'frame-border-width #'frame-internal-border-width)
1361(defalias 'frame-pixel-width 'frame-native-width) 1380(defalias 'frame-pixel-width #'frame-native-width)
1362(defalias 'frame-pixel-height 'frame-native-height) 1381(defalias 'frame-pixel-height #'frame-native-height)
1363 1382
1364(defun frame-inner-width (&optional frame) 1383(defun frame-inner-width (&optional frame)
1365 "Return inner width of FRAME in pixels. 1384 "Return inner width of FRAME in pixels.
@@ -1991,9 +2010,9 @@ frame's display)."
1991 (fboundp 'image-mask-p) 2010 (fboundp 'image-mask-p)
1992 (fboundp 'image-size))) 2011 (fboundp 'image-size)))
1993 2012
1994(defalias 'display-blink-cursor-p 'display-graphic-p) 2013(defalias 'display-blink-cursor-p #'display-graphic-p)
1995(defalias 'display-multi-frame-p 'display-graphic-p) 2014(defalias 'display-multi-frame-p #'display-graphic-p)
1996(defalias 'display-multi-font-p 'display-graphic-p) 2015(defalias 'display-multi-font-p #'display-graphic-p)
1997 2016
1998(defun display-selections-p (&optional display) 2017(defun display-selections-p (&optional display)
1999 "Return non-nil if DISPLAY supports selections. 2018 "Return non-nil if DISPLAY supports selections.
@@ -2340,13 +2359,15 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to
2340the opposite frame edge from the edge indicated in the input spec." 2359the opposite frame edge from the edge indicated in the input spec."
2341 (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame))) 2360 (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
2342 2361
2343(defun delete-other-frames (&optional frame) 2362(defun delete-other-frames (&optional frame iconify)
2344 "Delete all frames on FRAME's terminal, except FRAME. 2363 "Delete all frames on FRAME's terminal, except FRAME.
2345If FRAME uses another frame's minibuffer, the minibuffer frame is 2364If FRAME uses another frame's minibuffer, the minibuffer frame is
2346left untouched. Do not delete any of FRAME's child frames. If 2365left untouched. Do not delete any of FRAME's child frames. If
2347FRAME is a child frame, delete its siblings only. FRAME must be 2366FRAME is a child frame, delete its siblings only. FRAME must be
2348a live frame and defaults to the selected one." 2367a live frame and defaults to the selected one.
2349 (interactive) 2368If the prefix arg ICONIFY is non-nil, just iconify the frames rather than
2369deleting them."
2370 (interactive "i\nP")
2350 (setq frame (window-normalize-frame frame)) 2371 (setq frame (window-normalize-frame frame))
2351 (let ((minibuffer-frame (window-frame (minibuffer-window frame))) 2372 (let ((minibuffer-frame (window-frame (minibuffer-window frame)))
2352 (this (next-frame frame t)) 2373 (this (next-frame frame t))
@@ -2361,7 +2382,7 @@ a live frame and defaults to the selected one."
2361 (and parent (not (eq (frame-parent this) parent))) 2382 (and parent (not (eq (frame-parent this) parent)))
2362 ;; Do not delete a child frame of FRAME. 2383 ;; Do not delete a child frame of FRAME.
2363 (eq (frame-parent this) frame)) 2384 (eq (frame-parent this) frame))
2364 (delete-frame this)) 2385 (if iconify (iconify-frame this) (delete-frame this)))
2365 (setq this next)) 2386 (setq this next))
2366 ;; In a second round consider all remaining frames. 2387 ;; In a second round consider all remaining frames.
2367 (setq this (next-frame frame t)) 2388 (setq this (next-frame frame t))
@@ -2373,7 +2394,7 @@ a live frame and defaults to the selected one."
2373 (and parent (not (eq (frame-parent this) parent))) 2394 (and parent (not (eq (frame-parent this) parent)))
2374 ;; Do not delete a child frame of FRAME. 2395 ;; Do not delete a child frame of FRAME.
2375 (eq (frame-parent this) frame)) 2396 (eq (frame-parent this) frame))
2376 (delete-frame this)) 2397 (if iconify (iconify-frame this) (delete-frame this)))
2377 (setq this next)))) 2398 (setq this next))))
2378 2399
2379 2400
@@ -2399,7 +2420,7 @@ parameters `bottom-divider-width' and `right-divider-width'."
2399 :type '(choice (const :tag "Bottom only" bottom-only) 2420 :type '(choice (const :tag "Bottom only" bottom-only)
2400 (const :tag "Right only" right-only) 2421 (const :tag "Right only" right-only)
2401 (const :tag "Bottom and right" t)) 2422 (const :tag "Bottom and right" t))
2402 :initialize 'custom-initialize-default 2423 :initialize #'custom-initialize-default
2403 :set (lambda (symbol value) 2424 :set (lambda (symbol value)
2404 (set-default symbol value) 2425 (set-default symbol value)
2405 (when window-divider-mode 2426 (when window-divider-mode
@@ -2420,7 +2441,7 @@ parameter `bottom-divider-width'."
2420 :type '(restricted-sexp 2441 :type '(restricted-sexp
2421 :tag "Default width of bottom dividers" 2442 :tag "Default width of bottom dividers"
2422 :match-alternatives (window-divider-width-valid-p)) 2443 :match-alternatives (window-divider-width-valid-p))
2423 :initialize 'custom-initialize-default 2444 :initialize #'custom-initialize-default
2424 :set (lambda (symbol value) 2445 :set (lambda (symbol value)
2425 (set-default symbol value) 2446 (set-default symbol value)
2426 (when window-divider-mode 2447 (when window-divider-mode
@@ -2437,7 +2458,7 @@ parameter `right-divider-width'."
2437 :type '(restricted-sexp 2458 :type '(restricted-sexp
2438 :tag "Default width of right dividers" 2459 :tag "Default width of right dividers"
2439 :match-alternatives (window-divider-width-valid-p)) 2460 :match-alternatives (window-divider-width-valid-p))
2440 :initialize 'custom-initialize-default 2461 :initialize #'custom-initialize-default
2441 :set (lambda (symbol value) 2462 :set (lambda (symbol value)
2442 (set-default symbol value) 2463 (set-default symbol value)
2443 (when window-divider-mode 2464 (when window-divider-mode
@@ -2714,14 +2735,14 @@ See also `toggle-frame-maximized'."
2714 2735
2715;;;; Key bindings 2736;;;; Key bindings
2716 2737
2717(define-key ctl-x-5-map "2" 'make-frame-command) 2738(define-key ctl-x-5-map "2" #'make-frame-command)
2718(define-key ctl-x-5-map "1" 'delete-other-frames) 2739(define-key ctl-x-5-map "1" #'delete-other-frames)
2719(define-key ctl-x-5-map "0" 'delete-frame) 2740(define-key ctl-x-5-map "0" #'delete-frame)
2720(define-key ctl-x-5-map "o" 'other-frame) 2741(define-key ctl-x-5-map "o" #'other-frame)
2721(define-key ctl-x-5-map "5" 'other-frame-prefix) 2742(define-key ctl-x-5-map "5" #'other-frame-prefix)
2722(define-key global-map [f11] 'toggle-frame-fullscreen) 2743(define-key global-map [f11] #'toggle-frame-fullscreen)
2723(define-key global-map [(meta f10)] 'toggle-frame-maximized) 2744(define-key global-map [(meta f10)] #'toggle-frame-maximized)
2724(define-key esc-map [f10] 'toggle-frame-maximized) 2745(define-key esc-map [f10] #'toggle-frame-maximized)
2725 2746
2726 2747
2727;; Misc. 2748;; Misc.
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 0f4e1ae4a6e..4505d8513f9 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -32,6 +32,17 @@
32;; 32;;
33;; (require 'generic-x) 33;; (require 'generic-x)
34;; 34;;
35;; You can decide which modes to load by setting the variable
36;; `generic-extras-enable-list'. Its default value is platform-
37;; specific. The recommended way to set this variable is through
38;; customize:
39;;
40;; M-x customize-option RET generic-extras-enable-list RET
41;;
42;; This lets you select generic modes from the list of available
43;; modes. If you manually set `generic-extras-enable-list' in your
44;; .emacs, do it BEFORE loading generic-x with (require 'generic-x).
45;;
35;; You can also send in new modes; if the file types are reasonably 46;; You can also send in new modes; if the file types are reasonably
36;; common, we would like to install them. 47;; common, we would like to install them.
37;; 48;;
@@ -173,7 +184,88 @@ This hook will be installed if the variable
173;; Other Generic modes 184;; Other Generic modes
174;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 185;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
175 186
187;; If you add a generic mode to this file, put it in one of these four
188;; lists as well.
189
190(defconst generic-default-modes
191 '(apache-conf-generic-mode
192 apache-log-generic-mode
193 hosts-generic-mode
194 java-manifest-generic-mode
195 java-properties-generic-mode
196 javascript-generic-mode
197 show-tabs-generic-mode
198 vrml-generic-mode)
199 "List of generic modes that are defined by default.")
200
201(defconst generic-mswindows-modes
202 '(bat-generic-mode
203 inf-generic-mode
204 ini-generic-mode
205 rc-generic-mode
206 reg-generic-mode
207 rul-generic-mode)
208 "List of generic modes that are defined by default on MS-Windows.")
209
210(defconst generic-unix-modes
211 '(alias-generic-mode
212 ansible-inventory-generic-mode
213 etc-fstab-generic-mode
214 etc-modules-conf-generic-mode
215 etc-passwd-generic-mode
216 etc-services-generic-mode
217 etc-sudoers-generic-mode
218 fvwm-generic-mode
219 inetd-conf-generic-mode
220 mailagent-rules-generic-mode
221 mailrc-generic-mode
222 named-boot-generic-mode
223 named-database-generic-mode
224 prototype-generic-mode
225 resolve-conf-generic-mode
226 samba-generic-mode
227 x-resource-generic-mode
228 xmodmap-generic-mode)
229 "List of generic modes that are defined by default on Unix.")
230
231(defconst generic-other-modes
232 '(astap-generic-mode
233 ibis-generic-mode
234 pkginfo-generic-mode
235 spice-generic-mode)
236 "List of generic modes that are not defined by default.")
237
238(defcustom generic-extras-enable-list
239 (append generic-default-modes
240 (if (memq system-type '(windows-nt ms-dos))
241 generic-mswindows-modes
242 generic-unix-modes)
243 nil)
244 "List of generic modes to define.
245Each entry in the list should be a symbol. If you set this variable
246directly, without using customize, you must reload generic-x to put
247your changes into effect."
248 :type (let (list)
249 (dolist (mode
250 (sort (append generic-default-modes
251 generic-mswindows-modes
252 generic-unix-modes
253 generic-other-modes
254 nil)
255 (lambda (a b)
256 (string< (symbol-name b)
257 (symbol-name a))))
258 (cons 'set list))
259 (push `(const ,mode) list)))
260 :set (lambda (s v)
261 (set-default s v)
262 (unless load-in-progress
263 (load "generic-x")))
264 :version "22.1")
265
176;;; Apache 266;;; Apache
267(when (memq 'apache-conf-generic-mode generic-extras-enable-list)
268
177(define-generic-mode apache-conf-generic-mode 269(define-generic-mode apache-conf-generic-mode
178 '(?#) 270 '(?#)
179 nil 271 nil
@@ -186,7 +278,9 @@ This hook will be installed if the variable
186 '((nil "^\\([-A-Za-z0-9_]+\\)" 1) 278 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
187 ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) 279 ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
188 ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))) 280 ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
189 "Generic mode for Apache or HTTPD configuration files.") 281 "Generic mode for Apache or HTTPD configuration files."))
282
283(when (memq 'apache-log-generic-mode generic-extras-enable-list)
190 284
191(define-generic-mode apache-log-generic-mode 285(define-generic-mode apache-log-generic-mode
192 nil 286 nil
@@ -197,9 +291,11 @@ This hook will be installed if the variable
197 (2 font-lock-variable-name-face))) 291 (2 font-lock-variable-name-face)))
198 '("access_log\\'") 292 '("access_log\\'")
199 nil 293 nil
200 "Generic mode for Apache log files.") 294 "Generic mode for Apache log files."))
201 295
202;;; Samba 296;;; Samba
297(when (memq 'samba-generic-mode generic-extras-enable-list)
298
203(define-generic-mode samba-generic-mode 299(define-generic-mode samba-generic-mode
204 '(?\; ?#) 300 '(?\; ?#)
205 nil 301 nil
@@ -209,11 +305,13 @@ This hook will be installed if the variable
209 (2 font-lock-type-face))) 305 (2 font-lock-type-face)))
210 '("smb\\.conf\\'") 306 '("smb\\.conf\\'")
211 '(generic-bracket-support) 307 '(generic-bracket-support)
212 "Generic mode for Samba configuration files.") 308 "Generic mode for Samba configuration files."))
213 309
214;;; Fvwm 310;;; Fvwm
215;; This is pretty basic. Also, modes for other window managers could 311;; This is pretty basic. Also, modes for other window managers could
216;; be defined as well. 312;; be defined as well.
313(when (memq 'fvwm-generic-mode generic-extras-enable-list)
314
217(define-generic-mode fvwm-generic-mode 315(define-generic-mode fvwm-generic-mode
218 '(?#) 316 '(?#)
219 '("AddToMenu" 317 '("AddToMenu"
@@ -232,28 +330,33 @@ This hook will be installed if the variable
232 nil 330 nil
233 '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") 331 '("\\.fvwmrc\\'" "\\.fvwm2rc\\'")
234 nil 332 nil
235 "Generic mode for FVWM configuration files.") 333 "Generic mode for FVWM configuration files."))
236 334
237;;; X Resource 335;;; X Resource
238;; I'm pretty sure I've seen an actual mode to do this, but I don't 336;; I'm pretty sure I've seen an actual mode to do this, but I don't
239;; think it's standard with Emacs 337;; think it's standard with Emacs
338(when (memq 'x-resource-generic-mode generic-extras-enable-list)
339
240(define-generic-mode x-resource-generic-mode 340(define-generic-mode x-resource-generic-mode
241 '(?!) 341 '(?!)
242 nil 342 nil
243 '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) 343 '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face))
244 '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") 344 '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'")
245 nil 345 nil
246 "Generic mode for X Resource configuration files.") 346 "Generic mode for X Resource configuration files."))
247 347
348(if (memq 'xmodmap-generic-mode generic-extras-enable-list)
248(define-generic-mode xmodmap-generic-mode 349(define-generic-mode xmodmap-generic-mode
249 '(?!) 350 '(?!)
250 '("add" "clear" "keycode" "keysym" "remove" "pointer") 351 '("add" "clear" "keycode" "keysym" "remove" "pointer")
251 nil 352 nil
252 '("[xX]modmap\\(rc\\)?\\'") 353 '("[xX]modmap\\(rc\\)?\\'")
253 nil 354 nil
254 "Simple mode for xmodmap files.") 355 "Simple mode for xmodmap files."))
255 356
256;;; Hosts 357;;; Hosts
358(when (memq 'hosts-generic-mode generic-extras-enable-list)
359
257(define-generic-mode hosts-generic-mode 360(define-generic-mode hosts-generic-mode
258 '(?#) 361 '(?#)
259 '("localhost") 362 '("localhost")
@@ -261,20 +364,27 @@ This hook will be installed if the variable
261 ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face)) 364 ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
262 '("[hH][oO][sS][tT][sS]\\'") 365 '("[hH][oO][sS][tT][sS]\\'")
263 nil 366 nil
264 "Generic mode for HOSTS files.") 367 "Generic mode for HOSTS files."))
265 368
266;;; Windows INF files 369;;; Windows INF files
267 370
371;; If i-g-m-f-f-h is defined, then so is i-g-m.
372(declare-function ini-generic-mode "generic-x")
373
374(when (memq 'inf-generic-mode generic-extras-enable-list)
375
268(define-generic-mode inf-generic-mode 376(define-generic-mode inf-generic-mode
269 '(?\;) 377 '(?\;)
270 nil 378 nil
271 '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) 379 '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face))
272 '("\\.[iI][nN][fF]\\'") 380 '("\\.[iI][nN][fF]\\'")
273 '(generic-bracket-support) 381 '(generic-bracket-support)
274 "Generic mode for MS-Windows INF files.") 382 "Generic mode for MS-Windows INF files."))
275 383
276;;; Windows INI files 384;;; Windows INI files
277;; Should define escape character as well! 385;; Should define escape character as well!
386(when (memq 'ini-generic-mode generic-extras-enable-list)
387
278(define-generic-mode ini-generic-mode 388(define-generic-mode ini-generic-mode
279 '(?\;) 389 '(?\;)
280 nil 390 nil
@@ -301,9 +411,13 @@ like an INI file. You can add this hook to `find-file-hook'."
301 (goto-char (point-min)) 411 (goto-char (point-min))
302 (and (looking-at "^\\s-*\\[.*\\]") 412 (and (looking-at "^\\s-*\\[.*\\]")
303 (ini-generic-mode))))) 413 (ini-generic-mode)))))
414(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
415 'ini-generic-mode-find-file-hook "28.1"))
304 416
305;;; Windows REG files 417;;; Windows REG files
306;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! 418;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
419(when (memq 'reg-generic-mode generic-extras-enable-list)
420
307(define-generic-mode reg-generic-mode 421(define-generic-mode reg-generic-mode
308 '(?\;) 422 '(?\;)
309 '("key" "classes_root" "REGEDIT" "REGEDIT4") 423 '("key" "classes_root" "REGEDIT" "REGEDIT4")
@@ -314,11 +428,19 @@ like an INI file. You can add this hook to `find-file-hook'."
314 (lambda () 428 (lambda ()
315 (setq imenu-generic-expression 429 (setq imenu-generic-expression
316 '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))) 430 '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
317 "Generic mode for MS-Windows Registry files.") 431 "Generic mode for MS-Windows Registry files."))
432
433(declare-function w32-shell-name "w32-fns" ())
434
435;;; DOS/Windows BAT files
436(when (memq 'bat-generic-mode generic-extras-enable-list)
437 (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4"))
318 438
319;;; Mailagent 439;;; Mailagent
320;; Mailagent is a Unix mail filtering program. Anyone wanna do a 440;; Mailagent is a Unix mail filtering program. Anyone wanna do a
321;; generic mode for procmail? 441;; generic mode for procmail?
442(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list)
443
322(define-generic-mode mailagent-rules-generic-mode 444(define-generic-mode mailagent-rules-generic-mode
323 '(?#) 445 '(?#)
324 '("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT") 446 '("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT")
@@ -329,9 +451,11 @@ like an INI file. You can add this hook to `find-file-hook'."
329 (lambda () 451 (lambda ()
330 (setq imenu-generic-expression 452 (setq imenu-generic-expression
331 '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))) 453 '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
332 "Generic mode for Mailagent rules files.") 454 "Generic mode for Mailagent rules files."))
333 455
334;; Solaris/Sys V prototype files 456;; Solaris/Sys V prototype files
457(when (memq 'prototype-generic-mode generic-extras-enable-list)
458
335(define-generic-mode prototype-generic-mode 459(define-generic-mode prototype-generic-mode
336 '(?#) 460 '(?#)
337 nil 461 nil
@@ -350,9 +474,11 @@ like an INI file. You can add this hook to `find-file-hook'."
350 (2 font-lock-variable-name-face))) 474 (2 font-lock-variable-name-face)))
351 '("prototype\\'") 475 '("prototype\\'")
352 nil 476 nil
353 "Generic mode for Sys V prototype files.") 477 "Generic mode for Sys V prototype files."))
354 478
355;; Solaris/Sys V pkginfo files 479;; Solaris/Sys V pkginfo files
480(when (memq 'pkginfo-generic-mode generic-extras-enable-list)
481
356(define-generic-mode pkginfo-generic-mode 482(define-generic-mode pkginfo-generic-mode
357 '(?#) 483 '(?#)
358 nil 484 nil
@@ -361,9 +487,17 @@ like an INI file. You can add this hook to `find-file-hook'."
361 (2 font-lock-variable-name-face))) 487 (2 font-lock-variable-name-face)))
362 '("pkginfo\\'") 488 '("pkginfo\\'")
363 nil 489 nil
364 "Generic mode for Sys V pkginfo files.") 490 "Generic mode for Sys V pkginfo files."))
491
492;; Javascript mode
493;; Obsolete; defer to js-mode from js.el.
494(when (memq 'javascript-generic-mode generic-extras-enable-list)
495 (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
496 (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3"))
365 497
366;; VRML files 498;; VRML files
499(when (memq 'vrml-generic-mode generic-extras-enable-list)
500
367(define-generic-mode vrml-generic-mode 501(define-generic-mode vrml-generic-mode
368 '(?#) 502 '(?#)
369 '("DEF" 503 '("DEF"
@@ -411,9 +545,11 @@ like an INI file. You can add this hook to `find-file-hook'."
411 ("*Definitions*" 545 ("*Definitions*"
412 "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 546 "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
413 1))))) 547 1)))))
414 "Generic Mode for VRML files.") 548 "Generic Mode for VRML files."))
415 549
416;; Java Manifests 550;; Java Manifests
551(when (memq 'java-manifest-generic-mode generic-extras-enable-list)
552
417(define-generic-mode java-manifest-generic-mode 553(define-generic-mode java-manifest-generic-mode
418 '(?#) 554 '(?#)
419 '("Name" 555 '("Name"
@@ -430,9 +566,11 @@ like an INI file. You can add this hook to `find-file-hook'."
430 (2 font-lock-constant-face))) 566 (2 font-lock-constant-face)))
431 '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") 567 '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'")
432 nil 568 nil
433 "Generic mode for Java Manifest files.") 569 "Generic mode for Java Manifest files."))
434 570
435;; Java properties files 571;; Java properties files
572(when (memq 'java-properties-generic-mode generic-extras-enable-list)
573
436(define-generic-mode java-properties-generic-mode 574(define-generic-mode java-properties-generic-mode
437 '(?! ?#) 575 '(?! ?#)
438 nil 576 nil
@@ -458,9 +596,11 @@ like an INI file. You can add this hook to `find-file-hook'."
458 (lambda () 596 (lambda ()
459 (setq imenu-generic-expression 597 (setq imenu-generic-expression
460 '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))) 598 '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
461 "Generic mode for Java properties files.") 599 "Generic mode for Java properties files."))
462 600
463;; C shell alias definitions 601;; C shell alias definitions
602(when (memq 'alias-generic-mode generic-extras-enable-list)
603
464(define-generic-mode alias-generic-mode 604(define-generic-mode alias-generic-mode
465 '(?#) 605 '(?#)
466 '("alias" "unalias") 606 '("alias" "unalias")
@@ -473,9 +613,11 @@ like an INI file. You can add this hook to `find-file-hook'."
473 (lambda () 613 (lambda ()
474 (setq imenu-generic-expression 614 (setq imenu-generic-expression
475 '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))) 615 '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
476 "Generic mode for C Shell alias files.") 616 "Generic mode for C Shell alias files."))
477 617
478;; Ansible inventory files 618;; Ansible inventory files
619(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list)
620
479(define-generic-mode ansible-inventory-generic-mode 621(define-generic-mode ansible-inventory-generic-mode
480 '(?#) 622 '(?#)
481 nil 623 nil
@@ -494,10 +636,12 @@ like an INI file. You can add this hook to `find-file-hook'."
494 (setq imenu-generic-expression 636 (setq imenu-generic-expression
495 '((nil "^\\s-*\\[\\(.*\\)\\]" 1) 637 '((nil "^\\s-*\\[\\(.*\\)\\]" 1)
496 ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))) 638 ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
497 "Generic mode for Ansible inventory files.") 639 "Generic mode for Ansible inventory files."))
498 640
499;;; Windows RC files 641;;; Windows RC files
500;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) 642;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira)
643(when (memq 'rc-generic-mode generic-extras-enable-list)
644
501(define-generic-mode rc-generic-mode 645(define-generic-mode rc-generic-mode
502 ;; '(?\/) 646 ;; '(?\/)
503 '("//") 647 '("//")
@@ -577,13 +721,15 @@ like an INI file. You can add this hook to `find-file-hook'."
577 '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" 721 '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
578 (1 font-lock-constant-face) 722 (1 font-lock-constant-face)
579 (2 font-lock-variable-name-face nil t)))) 723 (2 font-lock-variable-name-face nil t))))
580 '("\\.[rR][cC]\\'") 724 '("\\.[rR][cC]\\'")
581 nil 725 nil
582 "Generic mode for MS-Windows Resource files.") 726 "Generic mode for MS-Windows Resource files."))
583 727
584;; InstallShield RUL files 728;; InstallShield RUL files
585;; Contributed by Alfred.Correira@Pervasive.Com 729;; Contributed by Alfred.Correira@Pervasive.Com
586;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com> 730;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com>
731(when (memq 'rul-generic-mode generic-extras-enable-list)
732
587(eval-when-compile 733(eval-when-compile
588 734
589;;; build the regexp strings using regexp-opt 735;;; build the regexp strings using regexp-opt
@@ -1226,9 +1372,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1226 > "begin" \n 1372 > "begin" \n
1227 > _ \n 1373 > _ \n
1228 resume: 1374 resume:
1229 > "end;") 1375 > "end;"))
1230 1376
1231;; Additions by ACorreir@pervasive-sw.com (Alfred Correira) 1377;; Additions by ACorreir@pervasive-sw.com (Alfred Correira)
1378(when (memq 'mailrc-generic-mode generic-extras-enable-list)
1379
1232(define-generic-mode mailrc-generic-mode 1380(define-generic-mode mailrc-generic-mode
1233 '(?#) 1381 '(?#)
1234 '("alias" 1382 '("alias"
@@ -1250,9 +1398,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1250 (2 font-lock-variable-name-face))) 1398 (2 font-lock-variable-name-face)))
1251 '("\\.mailrc\\'") 1399 '("\\.mailrc\\'")
1252 nil 1400 nil
1253 "Mode for mailrc files.") 1401 "Mode for mailrc files."))
1254 1402
1255;; Inetd.conf 1403;; Inetd.conf
1404(when (memq 'inetd-conf-generic-mode generic-extras-enable-list)
1405
1256(define-generic-mode inetd-conf-generic-mode 1406(define-generic-mode inetd-conf-generic-mode
1257 '(?#) 1407 '(?#)
1258 '("stream" 1408 '("stream"
@@ -1267,9 +1417,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1267 (list 1417 (list
1268 (lambda () 1418 (lambda ()
1269 (setq imenu-generic-expression 1419 (setq imenu-generic-expression
1270 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) 1420 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
1271 1421
1272;; Services 1422;; Services
1423(when (memq 'etc-services-generic-mode generic-extras-enable-list)
1424
1273(define-generic-mode etc-services-generic-mode 1425(define-generic-mode etc-services-generic-mode
1274 '(?#) 1426 '(?#)
1275 '("tcp" 1427 '("tcp"
@@ -1282,9 +1434,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1282 (list 1434 (list
1283 (lambda () 1435 (lambda ()
1284 (setq imenu-generic-expression 1436 (setq imenu-generic-expression
1285 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) 1437 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
1286 1438
1287;; Password and Group files 1439;; Password and Group files
1440(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
1441
1288(define-generic-mode etc-passwd-generic-mode 1442(define-generic-mode etc-passwd-generic-mode
1289 nil ;; No comment characters 1443 nil ;; No comment characters
1290 '("root") ;; Only one keyword 1444 '("root") ;; Only one keyword
@@ -1322,9 +1476,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1322 (list 1476 (list
1323 (lambda () 1477 (lambda ()
1324 (setq imenu-generic-expression 1478 (setq imenu-generic-expression
1325 '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))) 1479 '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
1326 1480
1327;; Fstab 1481;; Fstab
1482(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
1483
1328(define-generic-mode etc-fstab-generic-mode 1484(define-generic-mode etc-fstab-generic-mode
1329 '(?#) 1485 '(?#)
1330 '("adfs" 1486 '("adfs"
@@ -1436,9 +1592,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1436 (list 1592 (list
1437 (lambda () 1593 (lambda ()
1438 (setq imenu-generic-expression 1594 (setq imenu-generic-expression
1439 '((nil "^\\([^# \t]+\\)\\s-+" 1)))))) 1595 '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
1440 1596
1441;; /etc/sudoers 1597;; /etc/sudoers
1598(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
1599
1442(define-generic-mode etc-sudoers-generic-mode 1600(define-generic-mode etc-sudoers-generic-mode
1443 '(?#) 1601 '(?#)
1444 '("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias" 1602 '("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias"
@@ -1449,9 +1607,11 @@ like an INI file. You can add this hook to `find-file-hook'."
1449 ("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face)) 1607 ("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face))
1450 '("/etc/sudoers\\'") 1608 '("/etc/sudoers\\'")
1451 nil 1609 nil
1452 "Generic mode for sudoers configuration files.") 1610 "Generic mode for sudoers configuration files."))
1453 1611
1454;; From Jacques Duthen <jacques.duthen@sncf.fr> 1612;; From Jacques Duthen <jacques.duthen@sncf.fr>
1613(when (memq 'show-tabs-generic-mode generic-extras-enable-list)
1614
1455(eval-when-compile 1615(eval-when-compile
1456 1616
1457(defconst show-tabs-generic-mode-font-lock-defaults-1 1617(defconst show-tabs-generic-mode-font-lock-defaults-1
@@ -1489,12 +1649,14 @@ like an INI file. You can add this hook to `find-file-hook'."
1489 nil ;; no auto-mode-alist 1649 nil ;; no auto-mode-alist
1490 ;; '(show-tabs-generic-mode-hook-fun) 1650 ;; '(show-tabs-generic-mode-hook-fun)
1491 nil 1651 nil
1492 "Generic mode to show tabs and trailing spaces.") 1652 "Generic mode to show tabs and trailing spaces."))
1493 1653
1494;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1654;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1495;; DNS modes 1655;; DNS modes
1496;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1656;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1497 1657
1658(when (memq 'named-boot-generic-mode generic-extras-enable-list)
1659
1498(define-generic-mode named-boot-generic-mode 1660(define-generic-mode named-boot-generic-mode
1499 ;; List of comment characters 1661 ;; List of comment characters
1500 '(?\;) 1662 '(?\;)
@@ -1510,7 +1672,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1510 ;; List of additional automode-alist expressions 1672 ;; List of additional automode-alist expressions
1511 '("/etc/named\\.boot\\'") 1673 '("/etc/named\\.boot\\'")
1512 ;; List of set up functions to call 1674 ;; List of set up functions to call
1513 nil) 1675 nil))
1676
1677(when (memq 'named-database-generic-mode generic-extras-enable-list)
1514 1678
1515(define-generic-mode named-database-generic-mode 1679(define-generic-mode named-database-generic-mode
1516 ;; List of comment characters 1680 ;; List of comment characters
@@ -1531,7 +1695,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1531(defun named-database-print-serial () 1695(defun named-database-print-serial ()
1532 "Print a serial number based on the current date." 1696 "Print a serial number based on the current date."
1533 (interactive) 1697 (interactive)
1534 (insert (format-time-string named-database-time-string))) 1698 (insert (format-time-string named-database-time-string))))
1699
1700(when (memq 'resolve-conf-generic-mode generic-extras-enable-list)
1535 1701
1536(define-generic-mode resolve-conf-generic-mode 1702(define-generic-mode resolve-conf-generic-mode
1537 ;; List of comment characters 1703 ;; List of comment characters
@@ -1543,12 +1709,14 @@ like an INI file. You can add this hook to `find-file-hook'."
1543 ;; List of additional auto-mode-alist expressions 1709 ;; List of additional auto-mode-alist expressions
1544 '("/etc/resolve?\\.conf\\'") 1710 '("/etc/resolve?\\.conf\\'")
1545 ;; List of set up functions to call 1711 ;; List of set up functions to call
1546 nil) 1712 nil))
1547 1713
1548;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1714;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1549;; Modes for spice and common electrical engineering circuit netlist formats 1715;; Modes for spice and common electrical engineering circuit netlist formats
1550;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1716;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1551 1717
1718(when (memq 'spice-generic-mode generic-extras-enable-list)
1719
1552(define-generic-mode spice-generic-mode 1720(define-generic-mode spice-generic-mode
1553 nil 1721 nil
1554 '("and" 1722 '("and"
@@ -1584,7 +1752,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1584 ;; Make keywords case-insensitive 1752 ;; Make keywords case-insensitive
1585 (lambda () 1753 (lambda ()
1586 (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) 1754 (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
1587 "Generic mode for SPICE circuit netlist files.") 1755 "Generic mode for SPICE circuit netlist files."))
1756
1757(when (memq 'ibis-generic-mode generic-extras-enable-list)
1588 1758
1589(define-generic-mode ibis-generic-mode 1759(define-generic-mode ibis-generic-mode
1590 '(?|) 1760 '(?|)
@@ -1593,7 +1763,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1593 ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) 1763 ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face))
1594 '("\\.[iI][bB][sS]\\'") 1764 '("\\.[iI][bB][sS]\\'")
1595 '(generic-bracket-support) 1765 '(generic-bracket-support)
1596 "Generic mode for IBIS circuit netlist files.") 1766 "Generic mode for IBIS circuit netlist files."))
1767
1768(when (memq 'astap-generic-mode generic-extras-enable-list)
1597 1769
1598(define-generic-mode astap-generic-mode 1770(define-generic-mode astap-generic-mode
1599 nil 1771 nil
@@ -1627,7 +1799,9 @@ like an INI file. You can add this hook to `find-file-hook'."
1627 ;; Make keywords case-insensitive 1799 ;; Make keywords case-insensitive
1628 (lambda () 1800 (lambda ()
1629 (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) 1801 (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
1630 "Generic mode for ASTAP circuit netlist files.") 1802 "Generic mode for ASTAP circuit netlist files."))
1803
1804(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
1631 1805
1632(define-generic-mode etc-modules-conf-generic-mode 1806(define-generic-mode etc-modules-conf-generic-mode
1633 ;; List of comment characters 1807 ;; List of comment characters
@@ -1669,98 +1843,7 @@ like an INI file. You can add this hook to `find-file-hook'."
1669 ;; List of additional automode-alist expressions 1843 ;; List of additional automode-alist expressions
1670 '("/etc/modules\\.conf" "/etc/conf\\.modules") 1844 '("/etc/modules\\.conf" "/etc/conf\\.modules")
1671 ;; List of set up functions to call 1845 ;; List of set up functions to call
1672 nil) 1846 nil))
1673
1674;; Obsolete
1675
1676(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3")
1677(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")
1678
1679(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4")
1680
1681(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
1682 #'ini-generic-mode-find-file-hook "28.1")
1683
1684(defconst generic-default-modes
1685 '(apache-conf-generic-mode
1686 apache-log-generic-mode
1687 hosts-generic-mode
1688 java-manifest-generic-mode
1689 java-properties-generic-mode
1690 javascript-generic-mode
1691 show-tabs-generic-mode
1692 vrml-generic-mode)
1693 "List of generic modes that are defined by default.")
1694(make-obsolete-variable 'generic-default-modes "no longer used." "28.1")
1695
1696(defconst generic-mswindows-modes
1697 '(bat-generic-mode
1698 inf-generic-mode
1699 ini-generic-mode
1700 rc-generic-mode
1701 reg-generic-mode
1702 rul-generic-mode)
1703 "List of generic modes that are defined by default on MS-Windows.")
1704(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1")
1705
1706(defconst generic-unix-modes
1707 '(alias-generic-mode
1708 ansible-inventory-generic-mode
1709 etc-fstab-generic-mode
1710 etc-modules-conf-generic-mode
1711 etc-passwd-generic-mode
1712 etc-services-generic-mode
1713 etc-sudoers-generic-mode
1714 fvwm-generic-mode
1715 inetd-conf-generic-mode
1716 mailagent-rules-generic-mode
1717 mailrc-generic-mode
1718 named-boot-generic-mode
1719 named-database-generic-mode
1720 prototype-generic-mode
1721 resolve-conf-generic-mode
1722 samba-generic-mode
1723 x-resource-generic-mode
1724 xmodmap-generic-mode)
1725 "List of generic modes that are defined by default on Unix.")
1726(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1")
1727
1728(defconst generic-other-modes
1729 '(astap-generic-mode
1730 ibis-generic-mode
1731 pkginfo-generic-mode
1732 spice-generic-mode)
1733 "List of generic modes that are not defined by default.")
1734(make-obsolete-variable 'generic-other-modes "no longer used." "28.1")
1735
1736(defcustom generic-extras-enable-list
1737 (append generic-default-modes
1738 (if (memq system-type '(windows-nt ms-dos))
1739 generic-mswindows-modes
1740 generic-unix-modes)
1741 nil)
1742 "List of generic modes to define.
1743Each entry in the list should be a symbol. If you set this variable
1744directly, without using customize, you must reload generic-x to put
1745your changes into effect."
1746 :type (let (list)
1747 (dolist (mode
1748 (sort (append generic-default-modes
1749 generic-mswindows-modes
1750 generic-unix-modes
1751 generic-other-modes
1752 nil)
1753 (lambda (a b)
1754 (string< (symbol-name b)
1755 (symbol-name a))))
1756 (cons 'set list))
1757 (push `(const ,mode) list)))
1758 :set (lambda (s v)
1759 (set-default s v)
1760 (unless load-in-progress
1761 (load "generic-x")))
1762 :version "22.1")
1763(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1")
1764 1847
1765(provide 'generic-x) 1848(provide 'generic-x)
1766 1849
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 4249b50b9ff..34947cece89 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1134,9 +1134,7 @@ Returns nil if there is no such line before LIMIT, t otherwise."
1134(define-minor-mode gnus-message-citation-mode 1134(define-minor-mode gnus-message-citation-mode
1135 "Minor mode providing more font-lock support for nested citations. 1135 "Minor mode providing more font-lock support for nested citations.
1136When enabled, it automatically turns on `font-lock-mode'." 1136When enabled, it automatically turns on `font-lock-mode'."
1137 nil ;; init-value 1137 :lighter ""
1138 "" ;; lighter
1139 nil ;; keymap
1140 (when (derived-mode-p 'message-mode) 1138 (when (derived-mode-p 'message-mode)
1141 ;; FIXME: Use font-lock-add-keywords! 1139 ;; FIXME: Use font-lock-add-keywords!
1142 (let ((defaults (car font-lock-defaults)) 1140 (let ((defaults (car font-lock-defaults))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index fad4ef3dcf6..f3b830cf849 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -120,12 +120,13 @@
120 :group 'message-buffers 120 :group 'message-buffers
121 :type 'integer) 121 :type 'integer)
122 122
123(defcustom message-send-rename-function nil 123(defcustom message-send-rename-function #'message-default-send-rename-function
124 "Function called to rename the buffer after sending it." 124 "Function called to rename the buffer after sending it."
125 :group 'message-buffers 125 :group 'message-buffers
126 :type '(choice function (const nil))) 126 :version "28.1"
127 :type 'function)
127 128
128(defcustom message-fcc-handler-function 'message-output 129(defcustom message-fcc-handler-function #'message-output
129 "A function called to save outgoing articles. 130 "A function called to save outgoing articles.
130This function will be called with the name of the file to store the 131This function will be called with the name of the file to store the
131article in. The default function is `message-output' which saves in Unix 132article in. The default function is `message-output' which saves in Unix
@@ -418,7 +419,7 @@ you can explicitly override this setting by calling
418 :type 'string 419 :type 'string
419 :group 'message-various) 420 :group 'message-various)
420 421
421(defcustom message-cross-post-note-function 'message-cross-post-insert-note 422(defcustom message-cross-post-note-function #'message-cross-post-insert-note
422 "Function to use to insert note about Crosspost or Followup-To. 423 "Function to use to insert note about Crosspost or Followup-To.
423The function will be called with four arguments. The function should not only 424The function will be called with four arguments. The function should not only
424insert a note, but also ensure old notes are deleted. See the documentation 425insert a note, but also ensure old notes are deleted. See the documentation
@@ -756,7 +757,7 @@ See also `send-mail-function'."
756 :link '(custom-manual "(message)Mail Variables") 757 :link '(custom-manual "(message)Mail Variables")
757 :group 'message-mail) 758 :group 'message-mail)
758 759
759(defcustom message-send-news-function 'message-send-news 760(defcustom message-send-news-function #'message-send-news
760 "Function to call to send the current buffer as news. 761 "Function to call to send the current buffer as news.
761The headers should be delimited by a line whose contents match the 762The headers should be delimited by a line whose contents match the
762variable `mail-header-separator'." 763variable `mail-header-separator'."
@@ -765,29 +766,32 @@ variable `mail-header-separator'."
765 :link '(custom-manual "(message)News Variables") 766 :link '(custom-manual "(message)News Variables")
766 :type 'function) 767 :type 'function)
767 768
768(defcustom message-reply-to-function nil 769(defcustom message-reply-to-function #'ignore
769 "If non-nil, function that should return a list of headers. 770 "If non-nil, function that should return a list of headers.
770This function should pick out addresses from the To, Cc, and From headers 771This function should pick out addresses from the To, Cc, and From headers
771and respond with new To and Cc headers." 772and respond with new To and Cc headers."
772 :group 'message-interface 773 :group 'message-interface
773 :link '(custom-manual "(message)Reply") 774 :link '(custom-manual "(message)Reply")
774 :type '(choice function (const nil))) 775 :version "28.1"
776 :type 'function)
775 777
776(defcustom message-wide-reply-to-function nil 778(defcustom message-wide-reply-to-function #'ignore
777 "If non-nil, function that should return a list of headers. 779 "If non-nil, function that should return a list of headers.
778This function should pick out addresses from the To, Cc, and From headers 780This function should pick out addresses from the To, Cc, and From headers
779and respond with new To and Cc headers." 781and respond with new To and Cc headers."
780 :group 'message-interface 782 :group 'message-interface
781 :link '(custom-manual "(message)Wide Reply") 783 :link '(custom-manual "(message)Wide Reply")
782 :type '(choice function (const nil))) 784 :version "28.1"
785 :type 'function)
783 786
784(defcustom message-followup-to-function nil 787(defcustom message-followup-to-function #'ignore
785 "If non-nil, function that should return a list of headers. 788 "If non-nil, function that should return a list of headers.
786This function should pick out addresses from the To, Cc, and From headers 789This function should pick out addresses from the To, Cc, and From headers
787and respond with new To and Cc headers." 790and respond with new To and Cc headers."
788 :group 'message-interface 791 :group 'message-interface
789 :link '(custom-manual "(message)Followup") 792 :link '(custom-manual "(message)Followup")
790 :type '(choice function (const nil))) 793 :version "28.1"
794 :type 'function)
791 795
792(defcustom message-extra-wide-headers nil 796(defcustom message-extra-wide-headers nil
793 "If non-nil, a list of additional address headers. 797 "If non-nil, a list of additional address headers.
@@ -1021,7 +1025,7 @@ the signature is inserted."
1021 :version "22.1" 1025 :version "22.1"
1022 :group 'message-various) 1026 :group 'message-various)
1023 1027
1024(defcustom message-citation-line-function 'message-insert-citation-line 1028(defcustom message-citation-line-function #'message-insert-citation-line
1025 "Function called to insert the \"Whomever writes:\" line. 1029 "Function called to insert the \"Whomever writes:\" line.
1026 1030
1027Predefined functions include `message-insert-citation-line' and 1031Predefined functions include `message-insert-citation-line' and
@@ -1103,7 +1107,7 @@ Used by `message-yank-original' via `message-yank-cite'."
1103 :link '(custom-manual "(message)Insertion Variables") 1107 :link '(custom-manual "(message)Insertion Variables")
1104 :type 'integer) 1108 :type 'integer)
1105 1109
1106(defcustom message-cite-function 'message-cite-original-without-signature 1110(defcustom message-cite-function #'message-cite-original-without-signature
1107 "Function for citing an original message. 1111 "Function for citing an original message.
1108Predefined functions include `message-cite-original' and 1112Predefined functions include `message-cite-original' and
1109`message-cite-original-without-signature'. 1113`message-cite-original-without-signature'.
@@ -1116,7 +1120,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
1116 :version "22.3" ;; Gnus 5.10.12 (changed default) 1120 :version "22.3" ;; Gnus 5.10.12 (changed default)
1117 :group 'message-insertion) 1121 :group 'message-insertion)
1118 1122
1119(defcustom message-indent-citation-function 'message-indent-citation 1123(defcustom message-indent-citation-function #'message-indent-citation
1120 "Function for modifying a citation just inserted in the mail buffer. 1124 "Function for modifying a citation just inserted in the mail buffer.
1121This can also be a list of functions. Each function can find the 1125This can also be a list of functions. Each function can find the
1122citation between (point) and (mark t). And each function should leave 1126citation between (point) and (mark t). And each function should leave
@@ -2847,79 +2851,79 @@ Consider adding this function to `message-header-setup-hook'"
2847(unless message-mode-map 2851(unless message-mode-map
2848 (setq message-mode-map (make-keymap)) 2852 (setq message-mode-map (make-keymap))
2849 (set-keymap-parent message-mode-map text-mode-map) 2853 (set-keymap-parent message-mode-map text-mode-map)
2850 (define-key message-mode-map "\C-c?" 'describe-mode) 2854 (define-key message-mode-map "\C-c?" #'describe-mode)
2851 2855
2852 (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) 2856 (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to)
2853 (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) 2857 (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from)
2854 (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) 2858 (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc)
2855 (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) 2859 (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc)
2856 (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) 2860 (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc)
2857 (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) 2861 (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject)
2858 (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) 2862 (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to)
2859 (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) 2863 (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups)
2860 (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) 2864 (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution)
2861 (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) 2865 (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to)
2862 (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) 2866 (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to)
2863 (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) 2867 (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords)
2864 (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) 2868 (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary)
2865 (define-key message-mode-map "\C-c\C-f\C-i" 2869 (define-key message-mode-map "\C-c\C-f\C-i"
2866 'message-insert-or-toggle-importance) 2870 #'message-insert-or-toggle-importance)
2867 (define-key message-mode-map "\C-c\C-f\C-a" 2871 (define-key message-mode-map "\C-c\C-f\C-a"
2868 'message-generate-unsubscribed-mail-followup-to) 2872 #'message-generate-unsubscribed-mail-followup-to)
2869 2873
2870 ;; modify headers (and insert notes in body) 2874 ;; modify headers (and insert notes in body)
2871 (define-key message-mode-map "\C-c\C-fs" 'message-change-subject) 2875 (define-key message-mode-map "\C-c\C-fs" #'message-change-subject)
2872 ;; 2876 ;;
2873 (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) 2877 (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to)
2874 ;; prefix+message-cross-post-followup-to = same w/o cross-post 2878 ;; prefix+message-cross-post-followup-to = same w/o cross-post
2875 (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) 2879 (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc)
2876 (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) 2880 (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header)
2877 ;; mark inserted text 2881 ;; mark inserted text
2878 (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) 2882 (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region)
2879 (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) 2883 (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file)
2880 2884
2881 (define-key message-mode-map "\C-c\C-b" 'message-goto-body) 2885 (define-key message-mode-map "\C-c\C-b" #'message-goto-body)
2882 (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) 2886 (define-key message-mode-map "\C-c\C-i" #'message-goto-signature)
2883 2887
2884 (define-key message-mode-map "\C-c\C-t" 'message-insert-to) 2888 (define-key message-mode-map "\C-c\C-t" #'message-insert-to)
2885 (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) 2889 (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply)
2886 (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) 2890 (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups)
2887 (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) 2891 (define-key message-mode-map "\C-c\C-l" #'message-to-list-only)
2888 (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires) 2892 (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires)
2889 2893
2890 (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) 2894 (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance)
2891 (define-key message-mode-map "\C-c\M-n" 2895 (define-key message-mode-map "\C-c\M-n"
2892 'message-insert-disposition-notification-to) 2896 #'message-insert-disposition-notification-to)
2893 2897
2894 (define-key message-mode-map "\C-c\C-y" 'message-yank-original) 2898 (define-key message-mode-map "\C-c\C-y" #'message-yank-original)
2895 (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) 2899 (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer)
2896 (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) 2900 (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message)
2897 (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) 2901 (define-key message-mode-map "\C-c\C-w" #'message-insert-signature)
2898 (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) 2902 (define-key message-mode-map "\C-c\M-h" #'message-insert-headers)
2899 (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) 2903 (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body)
2900 (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) 2904 (define-key message-mode-map "\C-c\C-o" #'message-sort-headers)
2901 (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) 2905 (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer)
2902 2906
2903 (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) 2907 (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit)
2904 (define-key message-mode-map "\C-c\C-s" 'message-send) 2908 (define-key message-mode-map "\C-c\C-s" #'message-send)
2905 (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) 2909 (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer)
2906 (define-key message-mode-map "\C-c\C-d" 'message-dont-send) 2910 (define-key message-mode-map "\C-c\C-d" #'message-dont-send)
2907 (define-key message-mode-map "\C-c\n" 'gnus-delay-article) 2911 (define-key message-mode-map "\C-c\n" #'gnus-delay-article)
2908 2912
2909 (define-key message-mode-map "\C-c\M-k" 'message-kill-address) 2913 (define-key message-mode-map "\C-c\M-k" #'message-kill-address)
2910 (define-key message-mode-map "\C-c\C-e" 'message-elide-region) 2914 (define-key message-mode-map "\C-c\C-e" #'message-elide-region)
2911 (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) 2915 (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region)
2912 (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) 2916 (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature)
2913 (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) 2917 (define-key message-mode-map "\M-\r" #'message-newline-and-reformat)
2914 (define-key message-mode-map [remap split-line] 'message-split-line) 2918 (define-key message-mode-map [remap split-line] #'message-split-line)
2915 2919
2916 (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) 2920 (define-key message-mode-map "\C-c\C-a" #'mml-attach-file)
2917 (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot) 2921 (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot)
2918 2922
2919 (define-key message-mode-map "\C-a" 'message-beginning-of-line) 2923 (define-key message-mode-map "\C-a" #'message-beginning-of-line)
2920 (define-key message-mode-map "\t" 'message-tab) 2924 (define-key message-mode-map "\t" #'message-tab)
2921 2925
2922 (define-key message-mode-map "\M-n" 'message-display-abbrev)) 2926 (define-key message-mode-map "\M-n" #'message-display-abbrev))
2923 2927
2924(easy-menu-define 2928(easy-menu-define
2925 message-mode-menu message-mode-map "Message Menu." 2929 message-mode-menu message-mode-map "Message Menu."
@@ -3169,14 +3173,13 @@ Like `text-mode', but with these additional commands:
3169 ;; `electric-pair-mode', and C-M-* navigation by syntactically 3173 ;; `electric-pair-mode', and C-M-* navigation by syntactically
3170 ;; excluding citations and other artifacts. 3174 ;; excluding citations and other artifacts.
3171 ;; 3175 ;;
3172 (setq-local syntax-propertize-function 'message--syntax-propertize) 3176 (setq-local syntax-propertize-function #'message--syntax-propertize)
3173 (setq-local parse-sexp-ignore-comments t) 3177 (setq-local parse-sexp-ignore-comments t)
3174 (setq-local message-encoded-mail-cache nil)) 3178 (setq-local message-encoded-mail-cache nil))
3175 3179
3176(defun message-setup-fill-variables () 3180(defun message-setup-fill-variables ()
3177 "Setup message fill variables." 3181 "Setup message fill variables."
3178 (setq-local fill-paragraph-function #'message-fill-paragraph) 3182 (setq-local fill-paragraph-function #'message-fill-paragraph)
3179 (make-local-variable 'adaptive-fill-first-line-regexp)
3180 (let ((quote-prefix-regexp 3183 (let ((quote-prefix-regexp
3181 ;; User should change message-cite-prefix-regexp if 3184 ;; User should change message-cite-prefix-regexp if
3182 ;; message-yank-prefix is set to an abnormal value. 3185 ;; message-yank-prefix is set to an abnormal value.
@@ -3287,7 +3290,7 @@ Like `text-mode', but with these additional commands:
3287 (push-mark) 3290 (push-mark)
3288 (message-position-on-field "Summary" "Subject")) 3291 (message-position-on-field "Summary" "Subject"))
3289 3292
3290(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1") 3293(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1")
3291(defun message-goto-body (&optional interactive) 3294(defun message-goto-body (&optional interactive)
3292 "Move point to the beginning of the message body. 3295 "Move point to the beginning of the message body.
3293Returns point." 3296Returns point."
@@ -6662,9 +6665,8 @@ moved to the beginning "
6662 (not (buffer-modified-p buffer))) 6665 (not (buffer-modified-p buffer)))
6663 (kill-buffer buffer)))) 6666 (kill-buffer buffer))))
6664 ;; Rename the buffer. 6667 ;; Rename the buffer.
6665 (if message-send-rename-function 6668 (funcall (or message-send-rename-function
6666 (funcall message-send-rename-function) 6669 #'message-default-send-rename-function))
6667 (message-default-send-rename-function))
6668 ;; Push the current buffer onto the list. 6670 ;; Push the current buffer onto the list.
6669 (when message-max-buffers 6671 (when message-max-buffers
6670 (setq message-buffer-list 6672 (setq message-buffer-list
@@ -6763,8 +6765,9 @@ are not included."
6763(defun message-setup-1 (headers &optional yank-action actions return-action) 6765(defun message-setup-1 (headers &optional yank-action actions return-action)
6764 (dolist (action actions) 6766 (dolist (action actions)
6765 (condition-case nil 6767 (condition-case nil
6768 ;; FIXME: Use functions rather than expressions!
6766 (add-to-list 'message-send-actions 6769 (add-to-list 'message-send-actions
6767 `(apply ',(car action) ',(cdr action))))) 6770 `(apply #',(car action) ',(cdr action)))))
6768 (setq message-return-action return-action) 6771 (setq message-return-action return-action)
6769 (setq message-reply-buffer 6772 (setq message-reply-buffer
6770 (if (and (consp yank-action) 6773 (if (and (consp yank-action)
@@ -6903,7 +6906,7 @@ are not included."
6903;;;###autoload 6906;;;###autoload
6904(defun message-mail (&optional to subject other-headers continue 6907(defun message-mail (&optional to subject other-headers continue
6905 switch-function yank-action send-actions 6908 switch-function yank-action send-actions
6906 return-action &rest ignored) 6909 return-action &rest _)
6907 "Start editing a mail message to be sent. 6910 "Start editing a mail message to be sent.
6908OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether 6911OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
6909to continue editing a message already being composed. SWITCH-FUNCTION 6912to continue editing a message already being composed. SWITCH-FUNCTION
@@ -7127,15 +7130,12 @@ want to get rid of this query permanently.")))
7127 ;; specific, and just Cc-in the rest. 7130 ;; specific, and just Cc-in the rest.
7128 (setq follow-to (list 7131 (setq follow-to (list
7129 (cons 'To 7132 (cons 'To
7130 (mapconcat 7133 (mapconcat #'cdr recipients ", "))))
7131 (lambda (addr)
7132 (cdr addr)) recipients ", "))))
7133 ;; Put the first recipient in the To header. 7134 ;; Put the first recipient in the To header.
7134 (setq follow-to (list (cons 'To (cdr (pop recipients))))) 7135 (setq follow-to (list (cons 'To (cdr (pop recipients)))))
7135 ;; Put the rest of the recipients in Cc. 7136 ;; Put the rest of the recipients in Cc.
7136 (when recipients 7137 (when recipients
7137 (setq recipients (mapconcat 7138 (setq recipients (mapconcat #'cdr recipients ", "))
7138 (lambda (addr) (cdr addr)) recipients ", "))
7139 (if (string-match "^ +" recipients) 7139 (if (string-match "^ +" recipients)
7140 (setq recipients (substring recipients (match-end 0)))) 7140 (setq recipients (substring recipients (match-end 0))))
7141 (push (cons 'Cc recipients) follow-to))))) 7141 (push (cons 'Cc recipients) follow-to)))))
@@ -7862,7 +7862,7 @@ is for the internal use."
7862 (interactive) 7862 (interactive)
7863 (setq rmail-enable-mime-composing t) 7863 (setq rmail-enable-mime-composing t)
7864 (setq rmail-insert-mime-forwarded-message-function 7864 (setq rmail-insert-mime-forwarded-message-function
7865 'message-forward-rmail-make-body)) 7865 #'message-forward-rmail-make-body))
7866 7866
7867;;;###autoload 7867;;;###autoload
7868(defun message-resend (address) 7868(defun message-resend (address)
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 56ca2e14b6f..76a7e21567a 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,4 +1,3 @@
1
2;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*- 1;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*-
3 2
4;; Copyright (C) 1997-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 4d020232939..cbb69b206d4 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -1,4 +1,4 @@
1;;; hippie-exp.el --- expand text trying various ways to find its expansion 1;;; hippie-exp.el --- expand text trying various ways to find its expansion -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -58,7 +58,7 @@
58;; The variable `hippie-expand-dabbrev-as-symbol' controls whether 58;; The variable `hippie-expand-dabbrev-as-symbol' controls whether
59;; characters of syntax '_' is considered part of the words to expand 59;; characters of syntax '_' is considered part of the words to expand
60;; dynamically. 60;; dynamically.
61;; See also the macro `make-hippie-expand-function' below. 61;; See also the function `make-hippie-expand-function' below.
62;; 62;;
63;; A short description of the current try-functions in this file: 63;; A short description of the current try-functions in this file:
64;; `try-complete-file-name' : very convenient to have in any buffer, 64;; `try-complete-file-name' : very convenient to have in any buffer,
@@ -215,50 +215,42 @@
215 "The list of expansion functions tried in order by `hippie-expand'. 215 "The list of expansion functions tried in order by `hippie-expand'.
216To change the behavior of `hippie-expand', remove, change the order of, 216To change the behavior of `hippie-expand', remove, change the order of,
217or insert functions in this list." 217or insert functions in this list."
218 :type '(repeat function) 218 :type '(repeat function))
219 :group 'hippie-expand)
220 219
221(defcustom hippie-expand-verbose t 220(defcustom hippie-expand-verbose t
222 "Non-nil makes `hippie-expand' output which function it is trying." 221 "Non-nil makes `hippie-expand' output which function it is trying."
223 :type 'boolean 222 :type 'boolean)
224 :group 'hippie-expand)
225 223
226(defcustom hippie-expand-dabbrev-skip-space nil 224(defcustom hippie-expand-dabbrev-skip-space nil
227 "Non-nil means tolerate trailing spaces in the abbreviation to expand." 225 "Non-nil means tolerate trailing spaces in the abbreviation to expand."
228 :group 'hippie-expand
229 :type 'boolean) 226 :type 'boolean)
230 227
231(defcustom hippie-expand-dabbrev-as-symbol t 228(defcustom hippie-expand-dabbrev-as-symbol t
232 "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter." 229 "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
233 :group 'hippie-expand
234 :type 'boolean) 230 :type 'boolean)
235 231
236(defcustom hippie-expand-no-restriction t 232(defcustom hippie-expand-no-restriction t
237 "Non-nil means that narrowed buffers are widened during search." 233 "Non-nil means that narrowed buffers are widened during search."
238 :group 'hippie-expand
239 :type 'boolean) 234 :type 'boolean)
240 235
241(defcustom hippie-expand-max-buffers () 236(defcustom hippie-expand-max-buffers ()
242 "The maximum number of buffers (apart from the current) searched. 237 "The maximum number of buffers (apart from the current) searched.
243If nil, all buffers are searched." 238If nil, all buffers are searched."
244 :type '(choice (const :tag "All" nil) 239 :type '(choice (const :tag "All" nil)
245 integer) 240 integer))
246 :group 'hippie-expand)
247 241
248(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) 242(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
249 "A list specifying which buffers not to search (if not current). 243 "A list specifying which buffers not to search (if not current).
250Can contain both regexps matching buffer names (as strings) and major modes 244Can contain both regexps matching buffer names (as strings) and major modes
251\(as atoms)." 245\(as atoms)."
252 :type '(repeat (choice regexp (symbol :tag "Major Mode"))) 246 :type '(repeat (choice regexp (symbol :tag "Major Mode"))))
253 :group 'hippie-expand)
254 247
255(defcustom hippie-expand-only-buffers () 248(defcustom hippie-expand-only-buffers ()
256 "A list specifying the only buffers to search (in addition to current). 249 "A list specifying the only buffers to search (in addition to current).
257Can contain both regexps matching buffer names (as strings) and major modes 250Can contain both regexps matching buffer names (as strings) and major modes
258\(as atoms). If non-nil, this variable overrides the variable 251\(as atoms). If non-nil, this variable overrides the variable
259`hippie-expand-ignore-buffers'." 252`hippie-expand-ignore-buffers'."
260 :type '(repeat (choice regexp (symbol :tag "Major Mode"))) 253 :type '(repeat (choice regexp (symbol :tag "Major Mode"))))
261 :group 'hippie-expand)
262 254
263;;;###autoload 255;;;###autoload
264(defun hippie-expand (arg) 256(defun hippie-expand (arg)
@@ -407,18 +399,19 @@ undoes the expansion."
407;; try-expand-line-all-buffers))) 399;; try-expand-line-all-buffers)))
408;; 400;;
409;;;###autoload 401;;;###autoload
410(defmacro make-hippie-expand-function (try-list &optional verbose) 402(defun make-hippie-expand-function (try-list &optional verbose)
411 "Construct a function similar to `hippie-expand'. 403 "Construct a function similar to `hippie-expand'.
412Make it use the expansion functions in TRY-LIST. An optional second 404Make it use the expansion functions in TRY-LIST. An optional second
413argument VERBOSE non-nil makes the function verbose." 405argument VERBOSE non-nil makes the function verbose."
414 `(lambda (arg) 406 (lambda (arg)
415 ,(concat 407 (:documentation
416 "Try to expand text before point, using the following functions: \n" 408 (concat
417 (mapconcat 'prin1-to-string (eval try-list) ", ")) 409 "Try to expand text before point, using the following functions: \n"
418 (interactive "P") 410 (mapconcat #'prin1-to-string try-list ", ")))
419 (let ((hippie-expand-try-functions-list ,try-list) 411 (interactive "P")
420 (hippie-expand-verbose ,verbose)) 412 (let ((hippie-expand-try-functions-list try-list)
421 (hippie-expand arg)))) 413 (hippie-expand-verbose verbose))
414 (hippie-expand arg))))
422 415
423 416
424;;; Here follows the try-functions and their requisites: 417;;; Here follows the try-functions and their requisites:
@@ -434,7 +427,8 @@ string). It returns t if a new completion is found, nil otherwise."
434 (he-init-string (he-file-name-beg) (point)) 427 (he-init-string (he-file-name-beg) (point))
435 (let ((name-part (file-name-nondirectory he-search-string)) 428 (let ((name-part (file-name-nondirectory he-search-string))
436 (dir-part (expand-file-name (or (file-name-directory 429 (dir-part (expand-file-name (or (file-name-directory
437 he-search-string) "")))) 430 he-search-string)
431 ""))))
438 (if (not (he-string-member name-part he-tried-table)) 432 (if (not (he-string-member name-part he-tried-table))
439 (setq he-tried-table (cons name-part he-tried-table))) 433 (setq he-tried-table (cons name-part he-tried-table)))
440 (if (and (not (equal he-search-string "")) 434 (if (and (not (equal he-search-string ""))
@@ -442,7 +436,7 @@ string). It returns t if a new completion is found, nil otherwise."
442 (setq he-expand-list (sort (file-name-all-completions 436 (setq he-expand-list (sort (file-name-all-completions
443 name-part 437 name-part
444 dir-part) 438 dir-part)
445 'string-lessp)) 439 #'string-lessp))
446 (setq he-expand-list ()))))) 440 (setq he-expand-list ())))))
447 441
448 (while (and he-expand-list 442 (while (and he-expand-list
@@ -538,7 +532,7 @@ string). It returns t if a new completion is found, nil otherwise."
538 (or (boundp sym) 532 (or (boundp sym)
539 (fboundp sym) 533 (fboundp sym)
540 (symbol-plist sym)))) 534 (symbol-plist sym))))
541 'string-lessp))))) 535 #'string-lessp)))))
542 (while (and he-expand-list 536 (while (and he-expand-list
543 (he-string-member (car he-expand-list) he-tried-table)) 537 (he-string-member (car he-expand-list) he-tried-table))
544 (setq he-expand-list (cdr he-expand-list))) 538 (setq he-expand-list (cdr he-expand-list)))
@@ -822,9 +816,10 @@ string). It returns t if a new expansion is found, nil otherwise."
822 (setq he-expand-list 816 (setq he-expand-list
823 (and (not (equal he-search-string "")) 817 (and (not (equal he-search-string ""))
824 (mapcar (lambda (sym) 818 (mapcar (lambda (sym)
825 (if (and (boundp sym) (vectorp (eval sym))) 819 (if (and (boundp sym)
820 (abbrev-table-p (symbol-value sym)))
826 (abbrev-expansion (downcase he-search-string) 821 (abbrev-expansion (downcase he-search-string)
827 (eval sym)))) 822 (symbol-value sym))))
828 (append '(local-abbrev-table 823 (append '(local-abbrev-table
829 global-abbrev-table) 824 global-abbrev-table)
830 abbrev-table-name-list)))))) 825 abbrev-table-name-list))))))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 44574abd46a..1dc8acbe1f3 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -402,7 +402,7 @@ format. See `ibuffer-update-saved-filters-format' and
402;;;###autoload 402;;;###autoload
403(define-minor-mode ibuffer-auto-mode 403(define-minor-mode ibuffer-auto-mode
404 "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)." 404 "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)."
405 nil nil nil 405 :lighter nil
406 (unless (derived-mode-p 'ibuffer-mode) 406 (unless (derived-mode-p 'ibuffer-mode)
407 (error "This buffer is not in Ibuffer mode")) 407 (error "This buffer is not in Ibuffer mode"))
408 (cond (ibuffer-auto-mode 408 (cond (ibuffer-auto-mode
@@ -687,8 +687,8 @@ specifications with the same structure as
687`ibuffer-filtering-qualifiers'." 687`ibuffer-filtering-qualifiers'."
688 (not 688 (not
689 (memq nil ;; a filter will return nil if it failed 689 (memq nil ;; a filter will return nil if it failed
690 (mapcar #'(lambda (filter) 690 (mapcar (lambda (filter)
691 (ibuffer-included-in-filter-p buf filter)) 691 (ibuffer-included-in-filter-p buf filter))
692 filters)))) 692 filters))))
693 693
694(defun ibuffer-unary-operand (filter) 694(defun ibuffer-unary-operand (filter)
@@ -724,8 +724,8 @@ specification, with the same structure as an element of the list
724 ;; (dolist (filter-spec (cdr filter) nil) 724 ;; (dolist (filter-spec (cdr filter) nil)
725 ;; (when (ibuffer-included-in-filter-p buf filter-spec) 725 ;; (when (ibuffer-included-in-filter-p buf filter-spec)
726 ;; (throw 'has-match t)))) 726 ;; (throw 'has-match t))))
727 (memq t (mapcar #'(lambda (x) 727 (memq t (mapcar (lambda (x)
728 (ibuffer-included-in-filter-p buf x)) 728 (ibuffer-included-in-filter-p buf x))
729 (cdr filter)))) 729 (cdr filter))))
730 ('and 730 ('and
731 (catch 'no-match 731 (catch 'no-match
@@ -1589,8 +1589,8 @@ to move by. The default is `ibuffer-marked-char'."
1589 (message "No buffers marked; use `m' to mark a buffer") 1589 (message "No buffers marked; use `m' to mark a buffer")
1590 (let ((count 1590 (let ((count
1591 (ibuffer-map-marked-lines 1591 (ibuffer-map-marked-lines
1592 #'(lambda (_buf _mark) 1592 (lambda (_buf _mark)
1593 'kill)))) 1593 'kill))))
1594 (message "Killed %s lines" count)))) 1594 (message "Killed %s lines" count))))
1595 1595
1596;;;###autoload 1596;;;###autoload
@@ -1609,8 +1609,8 @@ a prefix argument reverses the meaning of that variable."
1609 (when current-prefix-arg 1609 (when current-prefix-arg
1610 (setq only-visible (not only-visible))) 1610 (setq only-visible (not only-visible)))
1611 (if only-visible 1611 (if only-visible
1612 (let ((table (mapcar #'(lambda (x) 1612 (let ((table (mapcar (lambda (x)
1613 (buffer-name (car x))) 1613 (buffer-name (car x)))
1614 (ibuffer-current-state-list)))) 1614 (ibuffer-current-state-list))))
1615 (when (null table) 1615 (when (null table)
1616 (error "No buffers!")) 1616 (error "No buffers!"))
@@ -1621,10 +1621,10 @@ a prefix argument reverses the meaning of that variable."
1621 (let (buf-point) 1621 (let (buf-point)
1622 ;; Blindly search for our buffer: it is very likely that it is 1622 ;; Blindly search for our buffer: it is very likely that it is
1623 ;; not in a hidden filter group. 1623 ;; not in a hidden filter group.
1624 (ibuffer-map-lines #'(lambda (buf _marks) 1624 (ibuffer-map-lines (lambda (buf _marks)
1625 (when (string= (buffer-name buf) name) 1625 (when (string= (buffer-name buf) name)
1626 (setq buf-point (point)) 1626 (setq buf-point (point))
1627 nil)) 1627 nil))
1628 t nil) 1628 t nil)
1629 (when (and 1629 (when (and
1630 (null buf-point) 1630 (null buf-point)
@@ -1635,10 +1635,10 @@ a prefix argument reverses the meaning of that variable."
1635 (dolist (group ibuffer-hidden-filter-groups) 1635 (dolist (group ibuffer-hidden-filter-groups)
1636 (ibuffer-jump-to-filter-group group) 1636 (ibuffer-jump-to-filter-group group)
1637 (ibuffer-toggle-filter-group) 1637 (ibuffer-toggle-filter-group)
1638 (ibuffer-map-lines #'(lambda (buf _marks) 1638 (ibuffer-map-lines (lambda (buf _marks)
1639 (when (string= (buffer-name buf) name) 1639 (when (string= (buffer-name buf) name)
1640 (setq buf-point (point)) 1640 (setq buf-point (point))
1641 nil)) 1641 nil))
1642 t group) 1642 t group)
1643 (if buf-point 1643 (if buf-point
1644 (throw 'found nil) 1644 (throw 'found nil)
@@ -1775,11 +1775,11 @@ You can then feed the file name(s) to other commands with \\[yank]."
1775(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) 1775(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1776 (let ((count 1776 (let ((count
1777 (ibuffer-map-lines 1777 (ibuffer-map-lines
1778 #'(lambda (buf _mark) 1778 (lambda (buf _mark)
1779 (when (funcall func buf) 1779 (when (funcall func buf)
1780 (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark 1780 (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
1781 ibuffer-marked-char)) 1781 ibuffer-marked-char))
1782 t)) 1782 t))
1783 nil 1783 nil
1784 group))) 1784 group)))
1785 (ibuffer-redisplay t) 1785 (ibuffer-redisplay t)
@@ -1791,8 +1791,8 @@ You can then feed the file name(s) to other commands with \\[yank]."
1791 "Mark all buffers whose name matches REGEXP." 1791 "Mark all buffers whose name matches REGEXP."
1792 (interactive "sMark by name (regexp): ") 1792 (interactive "sMark by name (regexp): ")
1793 (ibuffer-mark-on-buffer 1793 (ibuffer-mark-on-buffer
1794 #'(lambda (buf) 1794 (lambda (buf)
1795 (string-match regexp (buffer-name buf))))) 1795 (string-match regexp (buffer-name buf)))))
1796 1796
1797(defun ibuffer-locked-buffer-p (&optional buf) 1797(defun ibuffer-locked-buffer-p (&optional buf)
1798 "Return non-nil if BUF is locked. 1798 "Return non-nil if BUF is locked.
@@ -1816,9 +1816,9 @@ When BUF nil, default to the buffer at current line."
1816 "Mark all buffers whose major mode matches REGEXP." 1816 "Mark all buffers whose major mode matches REGEXP."
1817 (interactive "sMark by major mode (regexp): ") 1817 (interactive "sMark by major mode (regexp): ")
1818 (ibuffer-mark-on-buffer 1818 (ibuffer-mark-on-buffer
1819 #'(lambda (buf) 1819 (lambda (buf)
1820 (with-current-buffer buf 1820 (with-current-buffer buf
1821 (string-match regexp (format-mode-line mode-name nil nil buf)))))) 1821 (string-match regexp (format-mode-line mode-name nil nil buf))))))
1822 1822
1823;;;###autoload 1823;;;###autoload
1824(defun ibuffer-mark-by-file-name-regexp (regexp) 1824(defun ibuffer-mark-by-file-name-regexp (regexp)
@@ -1840,21 +1840,21 @@ Otherwise buffers whose name matches an element of
1840 (interactive (let ((reg (read-string "Mark by content (regexp): "))) 1840 (interactive (let ((reg (read-string "Mark by content (regexp): ")))
1841 (list reg current-prefix-arg))) 1841 (list reg current-prefix-arg)))
1842 (ibuffer-mark-on-buffer 1842 (ibuffer-mark-on-buffer
1843 #'(lambda (buf) 1843 (lambda (buf)
1844 (let ((mode (with-current-buffer buf major-mode)) 1844 (let ((mode (with-current-buffer buf major-mode))
1845 res) 1845 res)
1846 (cond ((and (not all-buffers) 1846 (cond ((and (not all-buffers)
1847 (or 1847 (or
1848 (memq mode ibuffer-never-search-content-mode) 1848 (memq mode ibuffer-never-search-content-mode)
1849 (cl-dolist (x ibuffer-never-search-content-name nil) 1849 (cl-dolist (x ibuffer-never-search-content-name nil)
1850 (when-let ((found (string-match x (buffer-name buf)))) 1850 (when-let ((found (string-match x (buffer-name buf))))
1851 (cl-return found))))) 1851 (cl-return found)))))
1852 (setq res nil)) 1852 (setq res nil))
1853 (t 1853 (t
1854 (with-current-buffer buf 1854 (with-current-buffer buf
1855 (save-mark-and-excursion 1855 (save-mark-and-excursion
1856 (goto-char (point-min)) 1856 (goto-char (point-min))
1857 (setq res (re-search-forward regexp nil t)))))) res)))) 1857 (setq res (re-search-forward regexp nil t)))))) res))))
1858 1858
1859;;;###autoload 1859;;;###autoload
1860(defun ibuffer-mark-by-mode (mode) 1860(defun ibuffer-mark-by-mode (mode)
@@ -1869,92 +1869,92 @@ Otherwise buffers whose name matches an element of
1869 (format-prompt "Mark by major mode" default) 1869 (format-prompt "Mark by major mode" default)
1870 (ibuffer-list-buffer-modes) nil t nil nil default))))) 1870 (ibuffer-list-buffer-modes) nil t nil nil default)))))
1871 (ibuffer-mark-on-buffer 1871 (ibuffer-mark-on-buffer
1872 #'(lambda (buf) 1872 (lambda (buf)
1873 (eq (buffer-local-value 'major-mode buf) mode)))) 1873 (eq (buffer-local-value 'major-mode buf) mode))))
1874 1874
1875;;;###autoload 1875;;;###autoload
1876(defun ibuffer-mark-modified-buffers () 1876(defun ibuffer-mark-modified-buffers ()
1877 "Mark all modified buffers." 1877 "Mark all modified buffers."
1878 (interactive) 1878 (interactive)
1879 (ibuffer-mark-on-buffer 1879 (ibuffer-mark-on-buffer
1880 #'(lambda (buf) (buffer-modified-p buf)))) 1880 (lambda (buf) (buffer-modified-p buf))))
1881 1881
1882;;;###autoload 1882;;;###autoload
1883(defun ibuffer-mark-unsaved-buffers () 1883(defun ibuffer-mark-unsaved-buffers ()
1884 "Mark all modified buffers that have an associated file." 1884 "Mark all modified buffers that have an associated file."
1885 (interactive) 1885 (interactive)
1886 (ibuffer-mark-on-buffer 1886 (ibuffer-mark-on-buffer
1887 #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf) 1887 (lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
1888 (buffer-modified-p buf))))) 1888 (buffer-modified-p buf)))))
1889 1889
1890;;;###autoload 1890;;;###autoload
1891(defun ibuffer-mark-dissociated-buffers () 1891(defun ibuffer-mark-dissociated-buffers ()
1892 "Mark all buffers whose associated file does not exist." 1892 "Mark all buffers whose associated file does not exist."
1893 (interactive) 1893 (interactive)
1894 (ibuffer-mark-on-buffer 1894 (ibuffer-mark-on-buffer
1895 #'(lambda (buf) 1895 (lambda (buf)
1896 (with-current-buffer buf 1896 (with-current-buffer buf
1897 (or 1897 (or
1898 (and buffer-file-name 1898 (and buffer-file-name
1899 (not (file-exists-p buffer-file-name))) 1899 (not (file-exists-p buffer-file-name)))
1900 (and (eq major-mode 'dired-mode) 1900 (and (eq major-mode 'dired-mode)
1901 (boundp 'dired-directory) 1901 (boundp 'dired-directory)
1902 (stringp dired-directory) 1902 (stringp dired-directory)
1903 (not (file-exists-p (file-name-directory dired-directory))))))))) 1903 (not (file-exists-p (file-name-directory dired-directory)))))))))
1904 1904
1905;;;###autoload 1905;;;###autoload
1906(defun ibuffer-mark-help-buffers () 1906(defun ibuffer-mark-help-buffers ()
1907 "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'." 1907 "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
1908 (interactive) 1908 (interactive)
1909 (ibuffer-mark-on-buffer 1909 (ibuffer-mark-on-buffer
1910 #'(lambda (buf) 1910 (lambda (buf)
1911 (with-current-buffer buf 1911 (with-current-buffer buf
1912 (memq major-mode ibuffer-help-buffer-modes))))) 1912 (memq major-mode ibuffer-help-buffer-modes)))))
1913 1913
1914;;;###autoload 1914;;;###autoload
1915(defun ibuffer-mark-compressed-file-buffers () 1915(defun ibuffer-mark-compressed-file-buffers ()
1916 "Mark buffers whose associated file is compressed." 1916 "Mark buffers whose associated file is compressed."
1917 (interactive) 1917 (interactive)
1918 (ibuffer-mark-on-buffer 1918 (ibuffer-mark-on-buffer
1919 #'(lambda (buf) 1919 (lambda (buf)
1920 (with-current-buffer buf 1920 (with-current-buffer buf
1921 (and buffer-file-name 1921 (and buffer-file-name
1922 (string-match ibuffer-compressed-file-name-regexp 1922 (string-match ibuffer-compressed-file-name-regexp
1923 buffer-file-name)))))) 1923 buffer-file-name))))))
1924 1924
1925;;;###autoload 1925;;;###autoload
1926(defun ibuffer-mark-old-buffers () 1926(defun ibuffer-mark-old-buffers ()
1927 "Mark buffers which have not been viewed in `ibuffer-old-time' hours." 1927 "Mark buffers which have not been viewed in `ibuffer-old-time' hours."
1928 (interactive) 1928 (interactive)
1929 (ibuffer-mark-on-buffer 1929 (ibuffer-mark-on-buffer
1930 #'(lambda (buf) 1930 (lambda (buf)
1931 (with-current-buffer buf 1931 (with-current-buffer buf
1932 (when buffer-display-time 1932 (when buffer-display-time
1933 (time-less-p 1933 (time-less-p
1934 (* 60 60 ibuffer-old-time) 1934 (* 60 60 ibuffer-old-time)
1935 (time-since buffer-display-time))))))) 1935 (time-since buffer-display-time)))))))
1936 1936
1937;;;###autoload 1937;;;###autoload
1938(defun ibuffer-mark-special-buffers () 1938(defun ibuffer-mark-special-buffers ()
1939 "Mark all buffers whose name begins and ends with `*'." 1939 "Mark all buffers whose name begins and ends with `*'."
1940 (interactive) 1940 (interactive)
1941 (ibuffer-mark-on-buffer 1941 (ibuffer-mark-on-buffer
1942 #'(lambda (buf) (string-match "^\\*.+\\*$" 1942 (lambda (buf) (string-match "^\\*.+\\*$"
1943 (buffer-name buf))))) 1943 (buffer-name buf)))))
1944 1944
1945;;;###autoload 1945;;;###autoload
1946(defun ibuffer-mark-read-only-buffers () 1946(defun ibuffer-mark-read-only-buffers ()
1947 "Mark all read-only buffers." 1947 "Mark all read-only buffers."
1948 (interactive) 1948 (interactive)
1949 (ibuffer-mark-on-buffer 1949 (ibuffer-mark-on-buffer
1950 #'(lambda (buf) (buffer-local-value 'buffer-read-only buf)))) 1950 (lambda (buf) (buffer-local-value 'buffer-read-only buf))))
1951 1951
1952;;;###autoload 1952;;;###autoload
1953(defun ibuffer-mark-dired-buffers () 1953(defun ibuffer-mark-dired-buffers ()
1954 "Mark all `dired' buffers." 1954 "Mark all `dired' buffers."
1955 (interactive) 1955 (interactive)
1956 (ibuffer-mark-on-buffer 1956 (ibuffer-mark-on-buffer
1957 #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) 1957 (lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
1958 1958
1959;;;###autoload 1959;;;###autoload
1960(defun ibuffer-do-occur (regexp &optional nlines) 1960(defun ibuffer-do-occur (regexp &optional nlines)
@@ -1970,8 +1970,8 @@ defaults to one."
1970 (let ((ibuffer-do-occur-bufs nil)) 1970 (let ((ibuffer-do-occur-bufs nil))
1971 ;; Accumulate a list of marked buffers 1971 ;; Accumulate a list of marked buffers
1972 (ibuffer-map-marked-lines 1972 (ibuffer-map-marked-lines
1973 #'(lambda (buf _mark) 1973 (lambda (buf _mark)
1974 (push buf ibuffer-do-occur-bufs))) 1974 (push buf ibuffer-do-occur-bufs)))
1975 (occur-1 regexp nlines ibuffer-do-occur-bufs))) 1975 (occur-1 regexp nlines ibuffer-do-occur-bufs)))
1976 1976
1977(provide 'ibuf-ext) 1977(provide 'ibuf-ext)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index be09c6582ce..fcc4f9e751c 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -66,8 +66,8 @@ During evaluation of body, bind `it' to the value returned by TEST."
66 (ibuffer-redisplay-engine 66 (ibuffer-redisplay-engine
67 ;; Get rid of dead buffers 67 ;; Get rid of dead buffers
68 (delq nil 68 (delq nil
69 (mapcar #'(lambda (e) (when (buffer-live-p (car e)) 69 (mapcar (lambda (e) (when (buffer-live-p (car e))
70 e)) 70 e))
71 ibuffer-save-marks-tmp-mark-list))) 71 ibuffer-save-marks-tmp-mark-list)))
72 (ibuffer-redisplay t)))))) 72 (ibuffer-redisplay t))))))
73 73
@@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'.
154 (ibuffer-redisplay t) 154 (ibuffer-redisplay t)
155 (setq ibuffer-last-sorting-mode ',name)) 155 (setq ibuffer-last-sorting-mode ',name))
156 (push (list ',name ,description 156 (push (list ',name ,description
157 #'(lambda (a b) 157 (lambda (a b)
158 ,@body)) 158 ,@body))
159 ibuffer-sorting-functions-alist) 159 ibuffer-sorting-functions-alist)
160 :autoload-end)) 160 :autoload-end))
161 161
@@ -259,18 +259,18 @@ buffer object.
259 'ibuffer-map-deletion-lines) 259 'ibuffer-map-deletion-lines)
260 (_ 260 (_
261 'ibuffer-map-marked-lines)) 261 'ibuffer-map-marked-lines))
262 #'(lambda (buf mark) 262 (lambda (buf mark)
263 ;; Silence warning for code that doesn't 263 ;; Silence warning for code that doesn't
264 ;; use `mark'. 264 ;; use `mark'.
265 (ignore mark) 265 (ignore mark)
266 ,(if (eq modifier-p :maybe) 266 ,(if (eq modifier-p :maybe)
267 `(let ((ibuffer-tmp-previous-buffer-modification 267 `(let ((ibuffer-tmp-previous-buffer-modification
268 (buffer-modified-p buf))) 268 (buffer-modified-p buf)))
269 (prog1 ,inner-body 269 (prog1 ,inner-body
270 (when (not (eq ibuffer-tmp-previous-buffer-modification 270 (when (not (eq ibuffer-tmp-previous-buffer-modification
271 (buffer-modified-p buf))) 271 (buffer-modified-p buf)))
272 (setq ibuffer-did-modification t)))) 272 (setq ibuffer-did-modification t))))
273 inner-body))))) 273 inner-body)))))
274 ,finish))) 274 ,finish)))
275 (if dangerous 275 (if dangerous
276 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names) 276 `(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index da589c00649..d5b6f76d7b2 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -562,6 +562,37 @@ Usually run by inclusion in `minibuffer-setup-hook'."
562 (completion--cache-all-sorted-completions beg end (cons comp all)))) 562 (completion--cache-all-sorted-completions beg end (cons comp all))))
563 finally return all))) 563 finally return all)))
564 564
565(defvar icomplete-vertical-mode-minibuffer-map
566 (let ((map (make-sparse-keymap)))
567 (define-key map (kbd "C-n") 'icomplete-forward-completions)
568 (define-key map (kbd "C-p") 'icomplete-backward-completions)
569 map)
570 "Keymap used by `icomplete-vertical-mode' in the minibuffer.")
571
572(defun icomplete--vertical-minibuffer-setup ()
573 "Setup the minibuffer for vertical display of completion candidates."
574 (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map
575 (current-local-map)))
576 (setq-local icomplete-separator "\n"
577 icomplete-hide-common-prefix nil
578 ;; Ask `icomplete-completions' to return enough completions candidates.
579 icomplete-prospects-height 25
580 redisplay-adhoc-scroll-in-resize-mini-windows nil))
581
582;;;###autoload
583(define-minor-mode icomplete-vertical-mode
584 "Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
585
586As many completion candidates as possible are displayed, depending on
587the value of `max-mini-window-height', and the way the mini-window is
588resized depends on `resize-mini-windows'."
589 :global t
590 (remove-hook 'icomplete-minibuffer-setup-hook
591 #'icomplete--vertical-minibuffer-setup)
592 (when icomplete-vertical-mode
593 (add-hook 'icomplete-minibuffer-setup-hook
594 #'icomplete--vertical-minibuffer-setup)))
595
565 596
566 597
567 598
@@ -784,10 +815,13 @@ matches exist."
784 (if last (setcdr last base-size)) 815 (if last (setcdr last base-size))
785 (if prospects 816 (if prospects
786 (concat determ 817 (concat determ
787 "{" 818 (if icomplete-vertical-mode " \n" "{")
788 (mapconcat 'identity prospects icomplete-separator) 819 (mapconcat 'identity prospects (if icomplete-vertical-mode
789 (and limit (concat icomplete-separator ellipsis)) 820 "\n"
790 "}") 821 icomplete-separator))
822 (unless icomplete-vertical-mode
823 (concat (and limit (concat icomplete-separator ellipsis))
824 "}")))
791 (concat determ " [Matched]")))))) 825 (concat determ " [Matched]"))))))
792 826
793;;; Iswitchb compatibility 827;;; Iswitchb compatibility
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index f4ff35f9c41..69ef7015cce 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -713,8 +713,7 @@ Key bindings:
713Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], 713Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
714to switch back to `image-mode' and display an image file as the 714to switch back to `image-mode' and display an image file as the
715actual image." 715actual image."
716 nil (:eval (if image-type (format " Image[%s]" image-type) " Image")) 716 :lighter (:eval (if image-type (format " Image[%s]" image-type) " Image"))
717 image-minor-mode-map
718 :group 'image 717 :group 'image
719 :version "22.1" 718 :version "22.1"
720 (if image-minor-mode 719 (if image-minor-mode
diff --git a/lisp/informat.el b/lisp/informat.el
index 3da23516333..bac09752b70 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,4 +1,4 @@
1;;; informat.el --- info support functions package for Emacs 1;;; informat.el --- info support functions package for Emacs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -140,7 +140,7 @@
140 (or (bolp) 140 (or (bolp)
141 (newline)) 141 (newline))
142 (insert "\^_\f\nTag table:\n") 142 (insert "\^_\f\nTag table:\n")
143 (if (eq major-mode 'info-mode) 143 (if (derived-mode-p 'info-mode)
144 (move-marker Info-tag-table-marker (point))) 144 (move-marker Info-tag-table-marker (point)))
145 (setq tag-list (nreverse tag-list)) 145 (setq tag-list (nreverse tag-list))
146 (while tag-list 146 (while tag-list
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 3be7849df19..793508cae4a 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -323,11 +323,9 @@
323 (insert ")\n\n"))) 323 (insert ")\n\n")))
324 324
325(defun skkdic-convert (filename &optional dirname) 325(defun skkdic-convert (filename &optional dirname)
326 "Generate Emacs Lisp file form Japanese dictionary file FILENAME. 326 "Generate Emacs Lisp file from Japanese dictionary file FILENAME.
327The format of the dictionary file should be the same as SKK dictionaries. 327The format of the dictionary file should be the same as SKK dictionaries.
328Optional argument DIRNAME if specified is the directory name under which 328Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
329the generated Emacs Lisp is saved.
330The name of generated file is specified by the variable `ja-dic-filename'."
331 (interactive "FSKK dictionary file: ") 329 (interactive "FSKK dictionary file: ")
332 (let* ((skkbuf (get-buffer-create " *skkdic-unannotated*")) 330 (let* ((skkbuf (get-buffer-create " *skkdic-unannotated*"))
333 (buf (get-buffer-create "*skkdic-work*"))) 331 (buf (get-buffer-create "*skkdic-work*")))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 943e24aa563..5efac4c78f4 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -172,6 +172,29 @@ This allows you to resume earlier Isearch sessions through the
172command history." 172command history."
173 :type 'boolean) 173 :type 'boolean)
174 174
175(defcustom isearch-wrap-pause t
176 "Define the behavior of wrapping when there are no more matches.
177When `t' (by default), signal an error when no more matches are found.
178Then after repeating the search, wrap with `isearch-wrap-function'.
179When `no', wrap immediately after reaching the last match.
180When `no-ding', wrap immediately without flashing the screen.
181When `nil', never wrap, just stop at the last match."
182 :type '(choice (const :tag "Pause before wrapping" t)
183 (const :tag "No pause before wrapping" no)
184 (const :tag "No pause and no flashing" no-ding)
185 (const :tag "Disable wrapping" nil))
186 :version "28.1")
187
188(defcustom isearch-repeat-on-direction-change nil
189 "Whether a direction change should move to another match.
190When `nil', the default, a direction change moves point to the other
191end of the current search match.
192When `t', a direction change moves to another search match, if there
193is one."
194 :type '(choice (const :tag "Remain on the same match" nil)
195 (const :tag "Move to another match" t))
196 :version "28.1")
197
175(defvar isearch-mode-hook nil 198(defvar isearch-mode-hook nil
176 "Function(s) to call after starting up an incremental search.") 199 "Function(s) to call after starting up an incremental search.")
177 200
@@ -1827,14 +1850,15 @@ Use `isearch-exit' to quit without signaling."
1827 ;; After taking the last element, adjust ring to previous one. 1850 ;; After taking the last element, adjust ring to previous one.
1828 (isearch-ring-adjust1 nil)) 1851 (isearch-ring-adjust1 nil))
1829 ;; If already have what to search for, repeat it. 1852 ;; If already have what to search for, repeat it.
1830 (or isearch-success 1853 (unless (or isearch-success (null isearch-wrap-pause))
1831 (progn 1854 ;; Set isearch-wrapped before calling isearch-wrap-function
1832 ;; Set isearch-wrapped before calling isearch-wrap-function 1855 (setq isearch-wrapped t)
1833 (setq isearch-wrapped t) 1856 (if isearch-wrap-function
1834 (if isearch-wrap-function 1857 (funcall isearch-wrap-function)
1835 (funcall isearch-wrap-function) 1858 (goto-char (if isearch-forward (point-min) (point-max))))))
1836 (goto-char (if isearch-forward (point-min) (point-max)))))))
1837 ;; C-s in reverse or C-r in forward, change direction. 1859 ;; C-s in reverse or C-r in forward, change direction.
1860 (if (and isearch-other-end isearch-repeat-on-direction-change)
1861 (goto-char isearch-other-end))
1838 (setq isearch-forward (not isearch-forward) 1862 (setq isearch-forward (not isearch-forward)
1839 isearch-success t)) 1863 isearch-success t))
1840 1864
@@ -1844,7 +1868,8 @@ Use `isearch-exit' to quit without signaling."
1844 (setq isearch-success t) 1868 (setq isearch-success t)
1845 ;; For the case when count > 1, don't keep intermediate states 1869 ;; For the case when count > 1, don't keep intermediate states
1846 ;; added to isearch-cmds by isearch-push-state in this loop. 1870 ;; added to isearch-cmds by isearch-push-state in this loop.
1847 (let ((isearch-cmds isearch-cmds)) 1871 (let ((isearch-cmds isearch-cmds)
1872 (was-success isearch-success))
1848 (while (<= 0 (setq count (1- (or count 1)))) 1873 (while (<= 0 (setq count (1- (or count 1))))
1849 (if (and isearch-success 1874 (if (and isearch-success
1850 (equal (point) isearch-other-end) 1875 (equal (point) isearch-other-end)
@@ -1859,13 +1884,26 @@ Use `isearch-exit' to quit without signaling."
1859 (forward-char (if isearch-forward 1 -1)) 1884 (forward-char (if isearch-forward 1 -1))
1860 (isearch-search)) 1885 (isearch-search))
1861 (isearch-search)) 1886 (isearch-search))
1862 (when (> count 0) 1887 (when (> count 0)
1863 ;; Update isearch-cmds, so if isearch-search fails later, 1888 ;; Update isearch-cmds, so if isearch-search fails later,
1864 ;; it can restore old successful state from isearch-cmds. 1889 ;; it can restore old successful state from isearch-cmds.
1865 (isearch-push-state)) 1890 (isearch-push-state))
1866 ;; Stop looping on failure. 1891 (cond
1867 (when (or (not isearch-success) isearch-error) 1892 ;; Wrap immediately and repeat the search again
1868 (setq count 0))))) 1893 ((memq isearch-wrap-pause '(no no-ding))
1894 (if isearch-success
1895 (setq was-success isearch-success)
1896 ;; If failed this time after succeeding last time
1897 (when was-success
1898 (setq was-success nil)
1899 (setq count (1+ count)) ;; Increment to force repeat
1900 (setq isearch-wrapped t)
1901 (if isearch-wrap-function
1902 (funcall isearch-wrap-function)
1903 (goto-char (if isearch-forward (point-min) (point-max)))))))
1904 ;; Stop looping on failure
1905 (t (when (or (not isearch-success) isearch-error)
1906 (setq count 0)))))))
1869 1907
1870 (isearch-push-state) 1908 (isearch-push-state)
1871 (isearch-update)) 1909 (isearch-update))
@@ -1884,10 +1922,12 @@ of the buffer, type \\[isearch-beginning-of-buffer] with a numeric argument."
1884 (cond ((< count 0) 1922 (cond ((< count 0)
1885 (isearch-repeat-backward (abs count)) 1923 (isearch-repeat-backward (abs count))
1886 ;; Reverse the direction back 1924 ;; Reverse the direction back
1887 (isearch-repeat 'forward)) 1925 (let ((isearch-repeat-on-direction-change nil))
1926 (isearch-repeat 'forward)))
1888 (t 1927 (t
1889 ;; Take into account one iteration to reverse direction 1928 ;; Take into account one iteration to reverse direction
1890 (when (not isearch-forward) (setq count (1+ count))) 1929 (unless isearch-repeat-on-direction-change
1930 (when (not isearch-forward) (setq count (1+ count))))
1891 (isearch-repeat 'forward count)))) 1931 (isearch-repeat 'forward count))))
1892 (isearch-repeat 'forward))) 1932 (isearch-repeat 'forward)))
1893 1933
@@ -1905,10 +1945,12 @@ of the buffer, type \\[isearch-end-of-buffer] with a numeric argument."
1905 (cond ((< count 0) 1945 (cond ((< count 0)
1906 (isearch-repeat-forward (abs count)) 1946 (isearch-repeat-forward (abs count))
1907 ;; Reverse the direction back 1947 ;; Reverse the direction back
1908 (isearch-repeat 'backward)) 1948 (let ((isearch-repeat-on-direction-change nil))
1949 (isearch-repeat 'backward)))
1909 (t 1950 (t
1910 ;; Take into account one iteration to reverse direction 1951 ;; Take into account one iteration to reverse direction
1911 (when isearch-forward (setq count (1+ count))) 1952 (unless isearch-repeat-on-direction-change
1953 (when isearch-forward (setq count (1+ count))))
1912 (isearch-repeat 'backward count)))) 1954 (isearch-repeat 'backward count))))
1913 (isearch-repeat 'backward))) 1955 (isearch-repeat 'backward)))
1914 1956
@@ -3012,6 +3054,10 @@ See more for options in `search-exit-option'."
3012 (goto-char isearch-pre-move-point)) 3054 (goto-char isearch-pre-move-point))
3013 (isearch-search-and-update))) 3055 (isearch-search-and-update)))
3014 (setq isearch-pre-move-point nil)) 3056 (setq isearch-pre-move-point nil))
3057 ;; Terminate the search if point has moved to another buffer.
3058 (unless (eq isearch--current-buffer (current-buffer))
3059 (when (buffer-live-p isearch--current-buffer)
3060 (with-current-buffer isearch--current-buffer (isearch-exit))))
3015 (force-mode-line-update)) 3061 (force-mode-line-update))
3016 3062
3017(defun isearch-quote-char (&optional count) 3063(defun isearch-quote-char (&optional count)
@@ -3488,10 +3534,10 @@ Optional third argument, if t, means if fail just return nil (no error).
3488 ;; stack overflow in regexp search. 3534 ;; stack overflow in regexp search.
3489 (setq isearch-error (format "%s" lossage)))) 3535 (setq isearch-error (format "%s" lossage))))
3490 3536
3491 (if isearch-success 3537 (unless isearch-success
3492 nil
3493 ;; Ding if failed this time after succeeding last time. 3538 ;; Ding if failed this time after succeeding last time.
3494 (and (isearch--state-success (car isearch-cmds)) 3539 (and (isearch--state-success (car isearch-cmds))
3540 (not (eq isearch-wrap-pause 'no-ding))
3495 (ding)) 3541 (ding))
3496 (if (functionp (isearch--state-pop-fun (car isearch-cmds))) 3542 (if (functionp (isearch--state-pop-fun (car isearch-cmds)))
3497 (funcall (isearch--state-pop-fun (car isearch-cmds)) 3543 (funcall (isearch--state-pop-fun (car isearch-cmds))
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 8aebcd0ec4d..a6223646c11 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,7 +1,6 @@
1;;; jka-compr.el --- reading/writing/loading compressed files 1;;; jka-compr.el --- reading/writing/loading compressed files -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation, 3;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
4;; Inc.
5 4
6;; Author: Jay K. Adams <jka@ece.cmu.edu> 5;; Author: Jay K. Adams <jka@ece.cmu.edu>
7;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
@@ -120,7 +119,7 @@ data appears to be compressed already.")
120 (widen) (erase-buffer) 119 (widen) (erase-buffer)
121 (insert (format "Error while executing \"%s %s < %s\"\n\n" 120 (insert (format "Error while executing \"%s %s < %s\"\n\n"
122 prog 121 prog
123 (mapconcat 'identity args " ") 122 (mapconcat #'identity args " ")
124 infile)) 123 infile))
125 124
126 (and errfile 125 (and errfile
@@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning."
170 (format 169 (format
171 "%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s" 170 "%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s"
172 prog 171 prog
173 (mapconcat 'identity args " ") 172 (mapconcat #'identity args " ")
174 err-file 173 err-file
175 jka-compr-dd-program 174 jka-compr-dd-program
176 jka-compr-dd-blocksize 175 jka-compr-dd-blocksize
@@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning."
218 "-c" 217 "-c"
219 (format "%s %s 2> %s %s" 218 (format "%s %s 2> %s %s"
220 prog 219 prog
221 (mapconcat 'identity args " ") 220 (mapconcat #'identity args " ")
222 err-file 221 err-file
223 (if (stringp output) 222 (if (stringp output)
224 (concat "> " output) 223 (concat "> " output)
@@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning."
227 (jka-compr-error prog args infile message err-file)) 226 (jka-compr-error prog args infile message err-file))
228 (delete-file err-file))) 227 (delete-file err-file)))
229 (or (eq 0 228 (or (eq 0
230 (apply 'call-process 229 (apply #'call-process
231 prog infile (if (stringp output) temp output) 230 prog infile (if (stringp output) temp output)
232 nil args)) 231 nil args))
233 (jka-compr-error prog args infile message)) 232 (jka-compr-error prog args infile message))
@@ -622,12 +621,12 @@ There should be no more than seven characters after the final `/'."
622 (substring file 0 (string-match (jka-compr-info-regexp info) file))) 621 (substring file 0 (string-match (jka-compr-info-regexp info) file)))
623 file))) 622 file)))
624 623
625(put 'write-region 'jka-compr 'jka-compr-write-region) 624(put 'write-region 'jka-compr #'jka-compr-write-region)
626(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) 625(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents)
627(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) 626(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy)
628(put 'load 'jka-compr 'jka-compr-load) 627(put 'load 'jka-compr #'jka-compr-load)
629(put 'byte-compiler-base-file-name 'jka-compr 628(put 'byte-compiler-base-file-name 'jka-compr
630 'jka-compr-byte-compiler-base-file-name) 629 #'jka-compr-byte-compiler-base-file-name)
631 630
632;;;###autoload 631;;;###autoload
633(defvar jka-compr-inhibit nil 632(defvar jka-compr-inhibit nil
@@ -649,7 +648,7 @@ It is not recommended to set this variable permanently to anything but nil.")
649;; to prevent the primitive from calling our handler again. 648;; to prevent the primitive from calling our handler again.
650(defun jka-compr-run-real-handler (operation args) 649(defun jka-compr-run-real-handler (operation args)
651 (let ((inhibit-file-name-handlers 650 (let ((inhibit-file-name-handlers
652 (cons 'jka-compr-handler 651 (cons #'jka-compr-handler
653 (and (eq inhibit-file-name-operation operation) 652 (and (eq inhibit-file-name-operation operation)
654 inhibit-file-name-handlers))) 653 inhibit-file-name-handlers)))
655 (inhibit-file-name-operation operation)) 654 (inhibit-file-name-operation operation))
@@ -674,7 +673,7 @@ by `jka-compr-installed'."
674 (last fnha)) 673 (last fnha))
675 674
676 (while (cdr last) 675 (while (cdr last)
677 (if (eq (cdr (car (cdr last))) 'jka-compr-handler) 676 (if (eq (cdr (car (cdr last))) #'jka-compr-handler)
678 (setcdr last (cdr (cdr last))) 677 (setcdr last (cdr (cdr last)))
679 (setq last (cdr last)))) 678 (setq last (cdr last))))
680 679
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 59c002d3078..0b12bdad058 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,4 +1,4 @@
1;;; loadhist.el --- lisp functions for working with feature groups 1;;; loadhist.el --- lisp functions for working with feature groups -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 650288f9f86..c82d08133cf 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,4 +1,4 @@
1;;; loadup.el --- load up standardly loaded Lisp files for Emacs 1;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software 3;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -112,7 +112,7 @@
112 112
113(if (eq t purify-flag) 113(if (eq t purify-flag)
114 ;; Hash consing saved around 11% of pure space in my tests. 114 ;; Hash consing saved around 11% of pure space in my tests.
115 (setq purify-flag (make-hash-table :test 'equal :size 80000))) 115 (setq purify-flag (make-hash-table :test #'equal :size 80000)))
116 116
117(message "Using load-path %s" load-path) 117(message "Using load-path %s" load-path)
118 118
@@ -134,7 +134,7 @@
134 134
135;; Do it after subr, since both after-load-functions and add-hook are 135;; Do it after subr, since both after-load-functions and add-hook are
136;; implemented in subr.el. 136;; implemented in subr.el.
137(add-hook 'after-load-functions (lambda (f) (garbage-collect))) 137(add-hook 'after-load-functions (lambda (_) (garbage-collect)))
138 138
139(load "version") 139(load "version")
140 140
@@ -151,7 +151,7 @@
151;; variable its advertised default value (it starts as nil, see 151;; variable its advertised default value (it starts as nil, see
152;; xdisp.c). 152;; xdisp.c).
153(setq resize-mini-windows 'grow-only) 153(setq resize-mini-windows 'grow-only)
154(setq load-source-file-function 'load-with-code-conversion) 154(setq load-source-file-function #'load-with-code-conversion)
155(load "files") 155(load "files")
156 156
157;; Load-time macro-expansion can only take effect after setting 157;; Load-time macro-expansion can only take effect after setting
@@ -187,7 +187,7 @@
187 ;; In case loaddefs hasn't been generated yet. 187 ;; In case loaddefs hasn't been generated yet.
188 (file-error (load "ldefs-boot.el"))) 188 (file-error (load "ldefs-boot.el")))
189 189
190(let ((new (make-hash-table :test 'equal))) 190(let ((new (make-hash-table :test #'equal)))
191 ;; Now that loaddefs has populated definition-prefixes, purify its contents. 191 ;; Now that loaddefs has populated definition-prefixes, purify its contents.
192 (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) 192 (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
193 definition-prefixes) 193 definition-prefixes)
@@ -400,7 +400,7 @@ lost after dumping")))
400 emacs-repository-branch (ignore-errors (emacs-repository-get-branch))) 400 emacs-repository-branch (ignore-errors (emacs-repository-get-branch)))
401 ;; A constant, so we shouldn't change it with `setq'. 401 ;; A constant, so we shouldn't change it with `setq'.
402 (defconst emacs-build-number 402 (defconst emacs-build-number
403 (if versions (1+ (apply 'max versions)) 1)))) 403 (if versions (1+ (apply #'max versions)) 1))))
404 404
405 405
406(message "Finding pointers to doc strings...") 406(message "Finding pointers to doc strings...")
@@ -430,11 +430,11 @@ lost after dumping")))
430;; We keep the load-history data in PURE space. 430;; We keep the load-history data in PURE space.
431;; Make sure that the spine of the list is not in pure space because it can 431;; Make sure that the spine of the list is not in pure space because it can
432;; be destructively mutated in lread.c:build_load_history. 432;; be destructively mutated in lread.c:build_load_history.
433(setq load-history (mapcar 'purecopy load-history)) 433(setq load-history (mapcar #'purecopy load-history))
434 434
435(set-buffer-modified-p nil) 435(set-buffer-modified-p nil)
436 436
437(remove-hook 'after-load-functions (lambda (f) (garbage-collect))) 437(remove-hook 'after-load-functions (lambda (_) (garbage-collect)))
438 438
439(if (boundp 'load--prefer-newer) 439(if (boundp 'load--prefer-newer)
440 (progn 440 (progn
@@ -584,7 +584,7 @@ lost after dumping")))
584;; (or load-file-name byte-compile-current-file). 584;; (or load-file-name byte-compile-current-file).
585(setq load-true-file-name nil) 585(setq load-true-file-name nil)
586(setq load-file-name nil) 586(setq load-file-name nil)
587(eval top-level) 587(eval top-level t)
588 588
589 589
590;; Local Variables: 590;; Local Variables:
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index cdb994a5c8e..e08500a1898 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1402,7 +1402,7 @@ are handled according to `rmail-mime-media-type-handlers-alist'.
1402By default, this displays text and multipart messages, and offers to 1402By default, this displays text and multipart messages, and offers to
1403download attachments as specified by `rmail-mime-attachment-dirs-alist'. 1403download attachments as specified by `rmail-mime-attachment-dirs-alist'.
1404The arguments ARG and STATE have no effect in this case." 1404The arguments ARG and STATE have no effect in this case."
1405 (interactive (list current-prefix-arg nil)) 1405 (interactive)
1406 (if rmail-enable-mime 1406 (if rmail-enable-mime
1407 (with-current-buffer rmail-buffer 1407 (with-current-buffer rmail-buffer
1408 (if (or (rmail-mime-message-p) 1408 (if (or (rmail-mime-message-p)
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index aece03ef0f3..cb8f8e34558 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -274,23 +274,23 @@ folder containing the index search results."
274 t))) 274 t)))
275 275
276 ;; Copy the search results over. 276 ;; Copy the search results over.
277 (maphash #'(lambda (folder msgs) 277 (maphash (lambda (folder msgs)
278 (let ((cur (car (mh-translate-range folder "cur"))) 278 (let ((cur (car (mh-translate-range folder "cur")))
279 (msgs (sort (cl-loop 279 (msgs (sort (cl-loop
280 for msg being the hash-keys of msgs 280 for msg being the hash-keys of msgs
281 collect msg) 281 collect msg)
282 #'<))) 282 #'<)))
283 (mh-exec-cmd "refile" msgs "-src" folder 283 (mh-exec-cmd "refile" msgs "-src" folder
284 "-link" index-folder) 284 "-link" index-folder)
285 ;; Restore cur to old value, that refile changed 285 ;; Restore cur to old value, that refile changed
286 (when cur 286 (when cur
287 (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" 287 (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
288 "-sequence" 288 "-sequence"
289 "cur" (format "%s" cur))) 289 "cur" (format "%s" cur)))
290 (cl-loop for msg in msgs 290 (cl-loop for msg in msgs
291 do (cl-incf result-count) 291 do (cl-incf result-count)
292 (setf (gethash result-count origin-map) 292 (setf (gethash result-count origin-map)
293 (cons folder msg))))) 293 (cons folder msg)))))
294 folder-results-map) 294 folder-results-map)
295 295
296 ;; Vist the results folder. 296 ;; Vist the results folder.
@@ -1136,10 +1136,10 @@ REGEXP-LIST is an alist of fields and values."
1136 ((atom (cadr expr)) `(or (and ,expr))) 1136 ((atom (cadr expr)) `(or (and ,expr)))
1137 ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr))) 1137 ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
1138 ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop* 1138 ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
1139 `(or ,@(mapcar #'(lambda (x) `(not ,x)) 1139 `(or ,@(mapcar (lambda (x) `(not ,x))
1140 (cdadr expr))))) 1140 (cdadr expr)))))
1141 ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop* 1141 ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
1142 `(and ,@(mapcar #'(lambda (x) `(not ,x)) 1142 `(and ,@(mapcar (lambda (x) `(not ,x))
1143 (cdadr expr))))) 1143 (cdadr expr)))))
1144 (t (error "Unreachable: %s" expr)))) 1144 (t (error "Unreachable: %s" expr))))
1145 1145
@@ -1620,7 +1620,7 @@ garbled."
1620 (cl-loop for seq in seq-list 1620 (cl-loop for seq in seq-list
1621 do (apply #'mh-exec-cmd "mark" mh-current-folder 1621 do (apply #'mh-exec-cmd "mark" mh-current-folder
1622 "-sequence" (symbol-name (car seq)) "-add" 1622 "-sequence" (symbol-name (car seq)) "-add"
1623 (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) 1623 (mapcar (lambda (x) (format "%s" x)) (cdr seq))))))
1624 1624
1625;;;###mh-autoload 1625;;;###mh-autoload
1626(defun mh-create-sequence-map (seq-list) 1626(defun mh-create-sequence-map (seq-list)
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index a7878aaae9b..01b6863038b 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -233,7 +233,7 @@ sibling."
233 (push index msg-list))) 233 (push index msg-list)))
234 (forward-line)) 234 (forward-line))
235 (mh-scan-folder mh-current-folder 235 (mh-scan-folder mh-current-folder
236 (mapcar #'(lambda (x) (format "%s" x)) 236 (mapcar (lambda (x) (format "%s" x))
237 (mh-coalesce-msg-list msg-list)) 237 (mh-coalesce-msg-list msg-list))
238 t)) 238 t))
239 (when mh-index-data 239 (when mh-index-data
@@ -591,7 +591,7 @@ Only information about messages in MSG-LIST are added to the tree."
591 #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil 591 #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
592 "-width" "10000" "-format" 592 "-width" "10000" "-format"
593 "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n" 593 "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
594 folder (mapcar #'(lambda (x) (format "%s" x)) msg-list))) 594 folder (mapcar (lambda (x) (format "%s" x)) msg-list)))
595 (goto-char (point-min)) 595 (goto-char (point-min))
596 (let ((roots ()) 596 (let ((roots ())
597 (case-fold-search t)) 597 (case-fold-search t))
@@ -635,9 +635,9 @@ Only information about messages in MSG-LIST are added to the tree."
635 (mh-thread-remove-parent-link id) 635 (mh-thread-remove-parent-link id)
636 (mh-thread-add-link (car ancestors) id))) 636 (mh-thread-add-link (car ancestors) id)))
637 (mh-thread-add-link (car ancestors) (cadr ancestors))))))) 637 (mh-thread-add-link (car ancestors) (cadr ancestors)))))))
638 (maphash #'(lambda (_k v) 638 (maphash (lambda (_k v)
639 (when (null (mh-container-parent v)) 639 (when (null (mh-container-parent v))
640 (push v roots))) 640 (push v roots)))
641 mh-thread-id-table) 641 mh-thread-id-table)
642 (setq roots (mh-thread-prune-containers roots)) 642 (setq roots (mh-thread-prune-containers roots))
643 (prog1 (setq roots (mh-thread-group-by-subject roots)) 643 (prog1 (setq roots (mh-thread-group-by-subject roots))
@@ -720,25 +720,25 @@ For now it will take the last string inside angles."
720 mh-thread-history) 720 mh-thread-history)
721 (mh-thread-remove-parent-link node))))) 721 (mh-thread-remove-parent-link node)))))
722 (let ((results ())) 722 (let ((results ()))
723 (maphash #'(lambda (_k v) 723 (maphash (lambda (_k v)
724 (when (and (null (mh-container-parent v)) 724 (when (and (null (mh-container-parent v))
725 (gethash (mh-message-id (mh-container-message v)) 725 (gethash (mh-message-id (mh-container-message v))
726 mh-thread-id-index-map)) 726 mh-thread-id-index-map))
727 (push v results))) 727 (push v results)))
728 mh-thread-id-table) 728 mh-thread-id-table)
729 (mh-thread-sort-containers results)))) 729 (mh-thread-sort-containers results))))
730 730
731(defun mh-thread-sort-containers (containers) 731(defun mh-thread-sort-containers (containers)
732 "Sort a list of message CONTAINERS to be in ascending order wrt index." 732 "Sort a list of message CONTAINERS to be in ascending order wrt index."
733 (sort containers 733 (sort containers
734 #'(lambda (x y) 734 (lambda (x y)
735 (when (and (mh-container-message x) (mh-container-message y)) 735 (when (and (mh-container-message x) (mh-container-message y))
736 (let* ((id-x (mh-message-id (mh-container-message x))) 736 (let* ((id-x (mh-message-id (mh-container-message x)))
737 (id-y (mh-message-id (mh-container-message y))) 737 (id-y (mh-message-id (mh-container-message y)))
738 (index-x (gethash id-x mh-thread-id-index-map)) 738 (index-x (gethash id-x mh-thread-id-index-map))
739 (index-y (gethash id-y mh-thread-id-index-map))) 739 (index-y (gethash id-y mh-thread-id-index-map)))
740 (and (integerp index-x) (integerp index-y) 740 (and (integerp index-x) (integerp index-y)
741 (< index-x index-y))))))) 741 (< index-x index-y)))))))
742 742
743(defvar mh-thread-last-ancestor) 743(defvar mh-thread-last-ancestor)
744 744
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index be66e62a1d7..e73c1db9e45 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -544,8 +544,8 @@ nested folders within them."
544 (mh-sub-folders-actual folder))) 544 (mh-sub-folders-actual folder)))
545 (t match)))) 545 (t match))))
546 (if add-trailing-slash-flag 546 (if add-trailing-slash-flag
547 (mapcar #'(lambda (x) 547 (mapcar (lambda (x)
548 (if (cdr x) (cons (concat (car x) "/") (cdr x)) x)) 548 (if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
549 sub-folders) 549 sub-folders)
550 sub-folders))) 550 sub-folders)))
551 551
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5f594679ca3..c900b0d7ce6 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -488,8 +488,17 @@ for use at QPOS."
488 (qsuffix (cdr action)) 488 (qsuffix (cdr action))
489 (ufull (if (zerop (length qsuffix)) ustring 489 (ufull (if (zerop (length qsuffix)) ustring
490 (funcall unquote (concat string qsuffix)))) 490 (funcall unquote (concat string qsuffix))))
491 (_ (cl-assert (string-prefix-p ustring ufull))) 491 ;; If (not (string-prefix-p ustring ufull)) we have a problem:
492 (usuffix (substring ufull (length ustring))) 492 ;; the unquoting the qfull gives something "unrelated" to ustring.
493 ;; E.g. "~/" and "/" where "~//" gets unquoted to just "/" (see
494 ;; bug#47678).
495 ;; In that case we can't even tell if we're right before the
496 ;; "/" or right after it (aka if this "/" is from qstring or
497 ;; from qsuffix), which which usuffix to use is very unclear.
498 (usuffix (if (string-prefix-p ustring ufull)
499 (substring ufull (length ustring))
500 ;; FIXME: Maybe "" is preferable/safer?
501 qsuffix))
493 (boundaries (completion-boundaries ustring table pred usuffix)) 502 (boundaries (completion-boundaries ustring table pred usuffix))
494 (qlboundary (car (funcall requote (car boundaries) string))) 503 (qlboundary (car (funcall requote (car boundaries) string)))
495 (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case. 504 (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 668c711922a..1f0dd315508 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -1,4 +1,4 @@
1;;; misearch.el --- isearch extensions for multi-buffer search 1;;; misearch.el --- isearch extensions for multi-buffer search -*- 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
@@ -28,6 +28,8 @@
28 28
29;;; Code: 29;;; Code:
30 30
31(require 'cl-lib)
32
31;;; Search multiple buffers 33;;; Search multiple buffers
32 34
33;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup) 35;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup)
@@ -40,8 +42,7 @@
40(defcustom multi-isearch-search t 42(defcustom multi-isearch-search t
41 "Non-nil enables searching multiple related buffers, in certain modes." 43 "Non-nil enables searching multiple related buffers, in certain modes."
42 :type 'boolean 44 :type 'boolean
43 :version "23.1" 45 :version "23.1")
44 :group 'multi-isearch)
45 46
46(defcustom multi-isearch-pause t 47(defcustom multi-isearch-pause t
47 "A choice defining where to pause the search. 48 "A choice defining where to pause the search.
@@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string."
53 (const :tag "Don't pause" nil) 54 (const :tag "Don't pause" nil)
54 (const :tag "Only in initial buffer" initial) 55 (const :tag "Only in initial buffer" initial)
55 (const :tag "All buffers" t)) 56 (const :tag "All buffers" t))
56 :version "23.1" 57 :version "23.1")
57 :group 'multi-isearch)
58 58
59;;;###autoload 59;;;###autoload
60(defvar multi-isearch-next-buffer-function nil 60(defvar multi-isearch-next-buffer-function nil
@@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'."
119 (default-value 'isearch-wrap-function) 119 (default-value 'isearch-wrap-function)
120 multi-isearch-orig-push-state 120 multi-isearch-orig-push-state
121 (default-value 'isearch-push-state-function)) 121 (default-value 'isearch-push-state-function))
122 (setq-default isearch-search-fun-function 'multi-isearch-search-fun 122 (setq-default isearch-search-fun-function #'multi-isearch-search-fun
123 isearch-wrap-function 'multi-isearch-wrap 123 isearch-wrap-function #'multi-isearch-wrap
124 isearch-push-state-function 'multi-isearch-push-state) 124 isearch-push-state-function #'multi-isearch-push-state)
125 (add-hook 'isearch-mode-end-hook 'multi-isearch-end))) 125 (add-hook 'isearch-mode-end-hook #'multi-isearch-end)))
126 126
127(defun multi-isearch-end () 127(defun multi-isearch-end ()
128 "Clean up the multi-buffer search after terminating isearch." 128 "Clean up the multi-buffer search after terminating isearch."
@@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'."
133 (setq-default isearch-search-fun-function multi-isearch-orig-search-fun 133 (setq-default isearch-search-fun-function multi-isearch-orig-search-fun
134 isearch-wrap-function multi-isearch-orig-wrap 134 isearch-wrap-function multi-isearch-orig-wrap
135 isearch-push-state-function multi-isearch-orig-push-state) 135 isearch-push-state-function multi-isearch-orig-push-state)
136 (remove-hook 'isearch-mode-end-hook 'multi-isearch-end)) 136 (remove-hook 'isearch-mode-end-hook #'multi-isearch-end))
137 137
138(defun multi-isearch-search-fun () 138(defun multi-isearch-search-fun ()
139 "Return the proper search function, for isearch in multiple buffers." 139 "Return the proper search function, for isearch in multiple buffers."
@@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
238 (while (not (string-equal 238 (while (not (string-equal
239 (setq buf (read-buffer (multi-occur--prompt) nil t)) 239 (setq buf (read-buffer (multi-occur--prompt) nil t))
240 "")) 240 ""))
241 (add-to-list 'bufs buf) 241 (cl-pushnew buf bufs :test #'equal)
242 (setq ido-ignore-item-temp-list bufs)) 242 (setq ido-ignore-item-temp-list bufs))
243 (nreverse bufs))) 243 (nreverse bufs)))
244 244
@@ -322,7 +322,7 @@ Every next/previous file in the defined sequence is visited by
322 default-directory 322 default-directory
323 default-directory)) 323 default-directory))
324 default-directory)) 324 default-directory))
325 (add-to-list 'files file)) 325 (cl-pushnew file files :test #'equal))
326 (nreverse files))) 326 (nreverse files)))
327 327
328;; A regexp is not the same thing as a file glob - does this matter? 328;; A regexp is not the same thing as a file glob - does this matter?
@@ -381,7 +381,7 @@ whose file names match the specified wildcard."
381(defun multi-isearch-unload-function () 381(defun multi-isearch-unload-function ()
382 "Remove autoloaded variables from `unload-function-defs-list'. 382 "Remove autoloaded variables from `unload-function-defs-list'.
383Also prevent the feature from being reloaded via `isearch-mode-hook'." 383Also prevent the feature from being reloaded via `isearch-mode-hook'."
384 (remove-hook 'isearch-mode-hook 'multi-isearch-setup) 384 (remove-hook 'isearch-mode-hook #'multi-isearch-setup)
385 (let ((defs (list (car unload-function-defs-list))) 385 (let ((defs (list (car unload-function-defs-list)))
386 (auto '(multi-isearch-next-buffer-function 386 (auto '(multi-isearch-next-buffer-function
387 multi-isearch-next-buffer-current-function 387 multi-isearch-next-buffer-current-function
@@ -395,7 +395,7 @@ Also prevent the feature from being reloaded via `isearch-mode-hook'."
395 ;; . 395 ;; .
396 nil)) 396 nil))
397 397
398(defalias 'misearch-unload-function 'multi-isearch-unload-function) 398(defalias 'misearch-unload-function #'multi-isearch-unload-function)
399 399
400 400
401(provide 'multi-isearch) 401(provide 'multi-isearch)
diff --git a/lisp/msb.el b/lisp/msb.el
index 14209d9956d..1064f940905 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,4 +1,4 @@
1;;; msb.el --- customizable buffer-selection with multiple menus 1;;; msb.el --- customizable buffer-selection with multiple menus -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc.
4 4
@@ -252,14 +252,12 @@ error every time you do \\[msb]."
252 :type `(choice (const :tag "long" :value ,msb--very-many-menus) 252 :type `(choice (const :tag "long" :value ,msb--very-many-menus)
253 (const :tag "short" :value ,msb--few-menus) 253 (const :tag "short" :value ,msb--few-menus)
254 (sexp :tag "user")) 254 (sexp :tag "user"))
255 :set 'msb-custom-set 255 :set #'msb-custom-set)
256 :group 'msb)
257 256
258(defcustom msb-modes-key 4000 257(defcustom msb-modes-key 4000
259 "The sort key for files sorted by mode." 258 "The sort key for files sorted by mode."
260 :type 'integer 259 :type 'integer
261 :set 'msb-custom-set 260 :set #'msb-custom-set
262 :group 'msb
263 :version "20.3") 261 :version "20.3")
264 262
265(defcustom msb-separator-diff 100 263(defcustom msb-separator-diff 100
@@ -267,8 +265,7 @@ error every time you do \\[msb]."
267The separators will appear between all menus that have a sorting key 265The separators will appear between all menus that have a sorting key
268that differs by this value or more." 266that differs by this value or more."
269 :type '(choice integer (const nil)) 267 :type '(choice integer (const nil))
270 :set 'msb-custom-set 268 :set #'msb-custom-set)
271 :group 'msb)
272 269
273(defvar msb-files-by-directory-sort-key 0 270(defvar msb-files-by-directory-sort-key 0
274 "The sort key for files sorted by directory.") 271 "The sort key for files sorted by directory.")
@@ -278,8 +275,7 @@ that differs by this value or more."
278If this variable is set to 15 for instance, then the submenu will be 275If this variable is set to 15 for instance, then the submenu will be
279split up in minor parts, 15 items each. A value of nil means no limit." 276split up in minor parts, 15 items each. A value of nil means no limit."
280 :type '(choice integer (const nil)) 277 :type '(choice integer (const nil))
281 :set 'msb-custom-set 278 :set #'msb-custom-set)
282 :group 'msb)
283 279
284(defcustom msb-max-file-menu-items 10 280(defcustom msb-max-file-menu-items 10
285 "The maximum number of items from different directories. 281 "The maximum number of items from different directories.
@@ -293,27 +289,23 @@ them together.
293 289
294If the value is not a number, then the value 10 is used." 290If the value is not a number, then the value 10 is used."
295 :type 'integer 291 :type 'integer
296 :set 'msb-custom-set 292 :set #'msb-custom-set)
297 :group 'msb)
298 293
299(defcustom msb-most-recently-used-sort-key -1010 294(defcustom msb-most-recently-used-sort-key -1010
300 "Where should the menu with the most recently used buffers be placed?" 295 "Where should the menu with the most recently used buffers be placed?"
301 :type 'integer 296 :type 'integer
302 :set 'msb-custom-set 297 :set #'msb-custom-set)
303 :group 'msb)
304 298
305(defcustom msb-display-most-recently-used 15 299(defcustom msb-display-most-recently-used 15
306 "How many buffers should be in the most-recently-used menu. 300 "How many buffers should be in the most-recently-used menu.
307No buffers at all if less than 1 or nil (or any non-number)." 301No buffers at all if less than 1 or nil (or any non-number)."
308 :type 'integer 302 :type 'integer
309 :set 'msb-custom-set 303 :set #'msb-custom-set)
310 :group 'msb)
311 304
312(defcustom msb-most-recently-used-title "Most recently used (%d)" 305(defcustom msb-most-recently-used-title "Most recently used (%d)"
313 "The title for the most-recently-used menu." 306 "The title for the most-recently-used menu."
314 :type 'string 307 :type 'string
315 :set 'msb-custom-set 308 :set #'msb-custom-set)
316 :group 'msb)
317 309
318(defvar msb-horizontal-shift-function (lambda () 0) 310(defvar msb-horizontal-shift-function (lambda () 0)
319 "Function that specifies how many pixels to shift the top menu leftwards.") 311 "Function that specifies how many pixels to shift the top menu leftwards.")
@@ -323,8 +315,7 @@ No buffers at all if less than 1 or nil (or any non-number)."
323Non-nil means that the buffer menu should include buffers that have 315Non-nil means that the buffer menu should include buffers that have
324names that starts with a space character." 316names that starts with a space character."
325 :type 'boolean 317 :type 'boolean
326 :set 'msb-custom-set 318 :set #'msb-custom-set)
327 :group 'msb)
328 319
329(defvar msb-item-handling-function 'msb-item-handler 320(defvar msb-item-handling-function 'msb-item-handler
330 "The appearance of a buffer menu. 321 "The appearance of a buffer menu.
@@ -354,15 +345,13 @@ Set this to nil or t if you don't want any sorting (faster)."
354 :type '(choice (const msb-sort-by-name) 345 :type '(choice (const msb-sort-by-name)
355 (const :tag "Newest first" t) 346 (const :tag "Newest first" t)
356 (const :tag "Oldest first" nil)) 347 (const :tag "Oldest first" nil))
357 :set 'msb-custom-set 348 :set #'msb-custom-set)
358 :group 'msb)
359 349
360(defcustom msb-files-by-directory nil 350(defcustom msb-files-by-directory nil
361 "Non-nil means that files should be sorted by directory. 351 "Non-nil means that files should be sorted by directory.
362This is instead of the groups in `msb-menu-cond'." 352This is instead of the groups in `msb-menu-cond'."
363 :type 'boolean 353 :type 'boolean
364 :set 'msb-custom-set 354 :set #'msb-custom-set)
365 :group 'msb)
366 355
367(define-obsolete-variable-alias 'msb-after-load-hooks 356(define-obsolete-variable-alias 'msb-after-load-hooks
368 'msb-after-load-hook "24.1") 357 'msb-after-load-hook "24.1")
@@ -370,8 +359,7 @@ This is instead of the groups in `msb-menu-cond'."
370(defcustom msb-after-load-hook nil 359(defcustom msb-after-load-hook nil
371 "Hook run after the msb package has been loaded." 360 "Hook run after the msb package has been loaded."
372 :type 'hook 361 :type 'hook
373 :set 'msb-custom-set 362 :set #'msb-custom-set)
374 :group 'msb)
375(make-obsolete-variable 'msb-after-load-hook 363(make-obsolete-variable 'msb-after-load-hook
376 "use `with-eval-after-load' instead." "28.1") 364 "use `with-eval-after-load' instead." "28.1")
377 365
@@ -458,10 +446,10 @@ An item look like (NAME . BUFFER)."
458 446
459;;; 447;;;
460;;; msb 448;;; msb
461;;; 449;;
462;;; This function can be used instead of (mouse-buffer-menu EVENT) 450;; This function can be used instead of (mouse-buffer-menu EVENT)
463;;; function in "mouse.el". 451;; function in "mouse.el".
464;;; 452;;
465(defun msb (event) 453(defun msb (event)
466 "Pop up several menus of buffers for selection with the mouse. 454 "Pop up several menus of buffers for selection with the mouse.
467This command switches buffers in the window that you clicked on, and 455This command switches buffers in the window that you clicked on, and
@@ -707,7 +695,7 @@ See `msb-menu-cond' for a description of its elements."
707 (cl-loop for fi 695 (cl-loop for fi
708 across function-info-vector 696 across function-info-vector
709 if (and (setq result 697 if (and (setq result
710 (eval (aref fi 1))) ;Test CONDITION 698 (eval (aref fi 1) t)) ;Test CONDITION
711 (not (and (eq result 'no-multi) 699 (not (and (eq result 'no-multi)
712 multi-flag)) 700 multi-flag))
713 (progn (when (eq result 'multi) 701 (progn (when (eq result 'multi)
@@ -727,12 +715,11 @@ All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
727to the buffer-list variable in FUNCTION-INFO." 715to the buffer-list variable in FUNCTION-INFO."
728 (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE 716 (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
729 ;; Here comes the hairy side-effect! 717 ;; Here comes the hairy side-effect!
730 (set list-symbol 718 (push (cons (funcall (aref function-info 4) ;ITEM-HANDLER
731 (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER 719 buffer
732 buffer 720 max-buffer-name-length)
733 max-buffer-name-length) 721 buffer)
734 buffer) 722 (symbol-value list-symbol))))
735 (eval list-symbol)))))
736 723
737(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) 724(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
738 "Select the appropriate menu for BUFFER." 725 "Select the appropriate menu for BUFFER."
@@ -754,7 +741,7 @@ to the buffer-list variable in FUNCTION-INFO."
754 741
755(defun msb--create-sort-item (function-info) 742(defun msb--create-sort-item (function-info)
756 "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty." 743 "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
757 (let ((buffer-list (eval (aref function-info 0)))) 744 (let ((buffer-list (symbol-value (aref function-info 0))))
758 (when buffer-list 745 (when buffer-list
759 (let ((sorter (aref function-info 5)) ;SORTER 746 (let ((sorter (aref function-info 5)) ;SORTER
760 (sort-key (aref function-info 2))) ;MENU-SORT-KEY 747 (sort-key (aref function-info 2))) ;MENU-SORT-KEY
@@ -925,7 +912,7 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
925 for value = (msb--create-sort-item elt) 912 for value = (msb--create-sort-item elt)
926 if value collect value)))) 913 if value collect value))))
927 (setq menu 914 (setq menu
928 (mapcar 'cdr ;Remove the SORT-KEY 915 (mapcar #'cdr ;Remove the SORT-KEY
929 ;; Sort the menus - not the items. 916 ;; Sort the menus - not the items.
930 (msb--add-separators 917 (msb--add-separators
931 (sort 918 (sort
@@ -1113,8 +1100,8 @@ variable `msb-menu-cond'."
1113 (nconc 1100 (nconc
1114 (list (frame-parameter frame 'name) 1101 (list (frame-parameter frame 'name)
1115 (frame-parameter frame 'name)) 1102 (frame-parameter frame 'name))
1116 `(lambda () 1103 (lambda ()
1117 (interactive) (menu-bar-select-frame ,frame)))) 1104 (interactive) (menu-bar-select-frame frame))))
1118 frames))))) 1105 frames)))))
1119 (setcdr global-buffers-menu-map 1106 (setcdr global-buffers-menu-map
1120 (if (and buffers-menu frames-menu) 1107 (if (and buffers-menu frames-menu)
@@ -1128,7 +1115,7 @@ variable `msb-menu-cond'."
1128;; C-down-mouse-1). 1115;; C-down-mouse-1).
1129(defvar msb-mode-map 1116(defvar msb-mode-map
1130 (let ((map (make-sparse-keymap "Msb"))) 1117 (let ((map (make-sparse-keymap "Msb")))
1131 (define-key map [remap mouse-buffer-menu] 'msb) 1118 (define-key map [remap mouse-buffer-menu] #'msb)
1132 map)) 1119 map))
1133 1120
1134;;;###autoload 1121;;;###autoload
@@ -1137,14 +1124,14 @@ variable `msb-menu-cond'."
1137 1124
1138This mode overrides the binding(s) of `mouse-buffer-menu' to provide a 1125This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
1139different buffer menu using the function `msb'." 1126different buffer menu using the function `msb'."
1140 :global t :group 'msb 1127 :global t
1141 (if msb-mode 1128 (if msb-mode
1142 (progn 1129 (progn
1143 (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) 1130 (add-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
1144 (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers) 1131 (remove-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
1145 (msb-menu-bar-update-buffers t)) 1132 (msb-menu-bar-update-buffers t))
1146 (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) 1133 (remove-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
1147 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) 1134 (add-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
1148 (menu-bar-update-buffers t))) 1135 (menu-bar-update-buffers t)))
1149 1136
1150(defun msb-unload-function () 1137(defun msb-unload-function ()
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 32fe857e65c..eec3ec7ba8b 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -987,6 +987,7 @@ the like."
987 (define-key map "F" 'eww-toggle-fonts) 987 (define-key map "F" 'eww-toggle-fonts)
988 (define-key map "D" 'eww-toggle-paragraph-direction) 988 (define-key map "D" 'eww-toggle-paragraph-direction)
989 (define-key map [(meta C)] 'eww-toggle-colors) 989 (define-key map [(meta C)] 'eww-toggle-colors)
990 (define-key map [(meta I)] 'eww-toggle-images)
990 991
991 (define-key map "b" 'eww-add-bookmark) 992 (define-key map "b" 'eww-add-bookmark)
992 (define-key map "B" 'eww-list-bookmarks) 993 (define-key map "B" 'eww-list-bookmarks)
@@ -1015,6 +1016,7 @@ the like."
1015 ["List cookies" url-cookie-list t] 1016 ["List cookies" url-cookie-list t]
1016 ["Toggle fonts" eww-toggle-fonts t] 1017 ["Toggle fonts" eww-toggle-fonts t]
1017 ["Toggle colors" eww-toggle-colors t] 1018 ["Toggle colors" eww-toggle-colors t]
1019 ["Toggle images" eww-toggle-images t]
1018 ["Character Encoding" eww-set-character-encoding] 1020 ["Character Encoding" eww-set-character-encoding]
1019 ["Toggle Paragraph Direction" eww-toggle-paragraph-direction])) 1021 ["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
1020 map)) 1022 map))
@@ -1893,6 +1895,14 @@ If CHARSET is nil then use UTF-8."
1893 "off")) 1895 "off"))
1894 (eww-reload)) 1896 (eww-reload))
1895 1897
1898(defun eww-toggle-images ()
1899 "Toggle whether or not to display images."
1900 (interactive nil eww-mode)
1901 (setq shr-inhibit-images (not shr-inhibit-images))
1902 (eww-reload)
1903 (message "Images are now %s"
1904 (if shr-inhibit-images "off" "on")))
1905
1896;;; Bookmarks code 1906;;; Bookmarks code
1897 1907
1898(defvar eww-bookmarks nil) 1908(defvar eww-bookmarks nil)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index af12f6970a6..8992ef736a6 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -263,9 +263,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
263;;;###autoload 263;;;###autoload
264(define-minor-mode goto-address-mode 264(define-minor-mode goto-address-mode
265 "Minor mode to buttonize URLs and e-mail addresses in the current buffer." 265 "Minor mode to buttonize URLs and e-mail addresses in the current buffer."
266 nil 266 :lighter ""
267 ""
268 nil
269 (if goto-address-mode 267 (if goto-address-mode
270 (jit-lock-register #'goto-address-fontify-region) 268 (jit-lock-register #'goto-address-fontify-region)
271 (jit-lock-unregister #'goto-address-fontify-region) 269 (jit-lock-unregister #'goto-address-fontify-region)
@@ -285,9 +283,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
285;;;###autoload 283;;;###autoload
286(define-minor-mode goto-address-prog-mode 284(define-minor-mode goto-address-prog-mode
287 "Like `goto-address-mode', but only for comments and strings." 285 "Like `goto-address-mode', but only for comments and strings."
288 nil 286 :lighter ""
289 ""
290 nil
291 (if goto-address-prog-mode 287 (if goto-address-prog-mode
292 (jit-lock-register #'goto-address-fontify-region) 288 (jit-lock-register #'goto-address-fontify-region)
293 (jit-lock-unregister #'goto-address-fontify-region) 289 (jit-lock-unregister #'goto-address-fontify-region)
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 3a561a0ea51..24f2aba8b86 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -857,9 +857,14 @@ and `network-connection-service-alist', which see."
857;; FIXME: modern whois clients include a much better tld <-> whois server 857;; FIXME: modern whois clients include a much better tld <-> whois server
858;; list, Emacs should probably avoid specifying the server as the client 858;; list, Emacs should probably avoid specifying the server as the client
859;; will DTRT anyway... -rfr 859;; will DTRT anyway... -rfr
860;; I'm not sure about the above FIXME. It seems to me that we should
861;; just check the Root Zone Database maintained at:
862;; https://www.iana.org/domains/root/db
863;; For example: whois -h whois.iana.org .se | grep whois
860(defcustom whois-server-tld 864(defcustom whois-server-tld
861 '(("rs.internic.net" . "com") 865 '(("whois.verisign-grs.com" . "com")
862 ("whois.publicinterestregistry.net" . "org") 866 ("whois.verisign-grs.com" . "net")
867 ("whois.pir.org" . "org")
863 ("whois.ripe.net" . "be") 868 ("whois.ripe.net" . "be")
864 ("whois.ripe.net" . "de") 869 ("whois.ripe.net" . "de")
865 ("whois.ripe.net" . "dk") 870 ("whois.ripe.net" . "dk")
@@ -867,10 +872,13 @@ and `network-connection-service-alist', which see."
867 ("whois.ripe.net" . "fi") 872 ("whois.ripe.net" . "fi")
868 ("whois.ripe.net" . "fr") 873 ("whois.ripe.net" . "fr")
869 ("whois.ripe.net" . "uk") 874 ("whois.ripe.net" . "uk")
875 ("whois.iis.se" . "se")
876 ("whois.iis.nu" . "nu")
870 ("whois.apnic.net" . "au") 877 ("whois.apnic.net" . "au")
871 ("whois.apnic.net" . "ch") 878 ("whois.apnic.net" . "ch")
872 ("whois.apnic.net" . "hk") 879 ("whois.apnic.net" . "hk")
873 ("whois.apnic.net" . "jp") 880 ("whois.apnic.net" . "jp")
881 ("whois.eu" . "eu")
874 ("whois.nic.gov" . "gov") 882 ("whois.nic.gov" . "gov")
875 ("whois.nic.mil" . "mil")) 883 ("whois.nic.mil" . "mil"))
876 "Alist to map top level domains to whois servers." 884 "Alist to map top level domains to whois servers."
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 938fadfed74..7bb8ca671cf 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -196,7 +196,7 @@ If nil, no maximum is applied."
196 196
197Uninteresting lines are those whose responses are listed in 197Uninteresting lines are those whose responses are listed in
198`rcirc-omit-responses'." 198`rcirc-omit-responses'."
199 nil " Omit" nil 199 :lighter " Omit"
200 (if rcirc-omit-mode 200 (if rcirc-omit-mode
201 (progn 201 (progn
202 (add-to-invisibility-spec '(rcirc-omit . nil)) 202 (add-to-invisibility-spec '(rcirc-omit . nil))
@@ -1359,9 +1359,7 @@ Create the buffer if it doesn't exist."
1359 1359
1360(define-minor-mode rcirc-multiline-minor-mode 1360(define-minor-mode rcirc-multiline-minor-mode
1361 "Minor mode for editing multiple lines in rcirc." 1361 "Minor mode for editing multiple lines in rcirc."
1362 :init-value nil
1363 :lighter " rcirc-mline" 1362 :lighter " rcirc-mline"
1364 :keymap rcirc-multiline-minor-mode-map
1365 :global nil 1363 :global nil
1366 (setq fill-column rcirc-max-message-length)) 1364 (setq fill-column rcirc-max-message-length))
1367 1365
@@ -1863,9 +1861,6 @@ This function does not alter the INPUT string."
1863;;;###autoload 1861;;;###autoload
1864(define-minor-mode rcirc-track-minor-mode 1862(define-minor-mode rcirc-track-minor-mode
1865 "Global minor mode for tracking activity in rcirc buffers." 1863 "Global minor mode for tracking activity in rcirc buffers."
1866 :init-value nil
1867 :lighter ""
1868 :keymap rcirc-track-minor-mode-map
1869 :global t 1864 :global t
1870 (or global-mode-string (setq global-mode-string '(""))) 1865 (or global-mode-string (setq global-mode-string '("")))
1871 ;; toggle the mode-line channel indicator 1866 ;; toggle the mode-line channel indicator
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index c122a19e90c..cbdeb65ba8b 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -183,8 +183,10 @@ temporarily blinks with this face."
183 "Face for <abbr> elements." 183 "Face for <abbr> elements."
184 :version "27.1") 184 :version "27.1")
185 185
186(defvar shr-inhibit-images nil 186(defcustom shr-inhibit-images nil
187 "If non-nil, inhibit loading images.") 187 "If non-nil, inhibit loading images."
188 :version "28.1"
189 :type 'boolean)
188 190
189(defvar shr-external-rendering-functions nil 191(defvar shr-external-rendering-functions nil
190 "Alist of tag/function pairs used to alter how shr renders certain tags. 192 "Alist of tag/function pairs used to alter how shr renders certain tags.
@@ -313,6 +315,12 @@ DOM should be a parse tree as generated by
313 (* (frame-char-width) 2)) 315 (* (frame-char-width) 2))
314 1)))) 316 1))))
315 (max-specpdl-size max-specpdl-size) 317 (max-specpdl-size max-specpdl-size)
318 ;; `bidi-display-reordering' is supposed to be only used for
319 ;; debugging purposes, but Shr's naïve filling algorithm
320 ;; cannot cope with the complexity of RTL text in an LTR
321 ;; paragraph, when a long line has been continued, and for
322 ;; most scripts the character metrics don't change when they
323 ;; are reordered, so... this is the best we could do :-(
316 bidi-display-reordering) 324 bidi-display-reordering)
317 ;; Adjust for max width specification. 325 ;; Adjust for max width specification.
318 (when (and shr-max-width 326 (when (and shr-max-width
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 499bf8abe41..0e6a2bb04af 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -169,7 +169,8 @@ The string is used in `tramp-methods'.")
169 (tramp-login-program "ssh") 169 (tramp-login-program "ssh")
170 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 170 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
171 ("-e" "none") ("-t" "-t") 171 ("-e" "none") ("-t" "-t")
172 ("-o" "RemoteCommand='%l'") ("%h"))) 172 ("-o" "RemoteCommand=\"%l\"")
173 ("%h")))
173 (tramp-async-args (("-q"))) 174 (tramp-async-args (("-q")))
174 (tramp-remote-shell ,tramp-default-remote-shell) 175 (tramp-remote-shell ,tramp-default-remote-shell)
175 (tramp-remote-shell-login ("-l")) 176 (tramp-remote-shell-login ("-l"))
@@ -225,7 +226,8 @@ The string is used in `tramp-methods'.")
225 (tramp-login-program "ssh") 226 (tramp-login-program "ssh")
226 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 227 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
227 ("-e" "none") ("-t" "-t") 228 ("-e" "none") ("-t" "-t")
228 ("-o" "RemoteCommand='%l'") ("%h"))) 229 ("-o" "RemoteCommand=\"%l\"")
230 ("%h")))
229 (tramp-async-args (("-q"))) 231 (tramp-async-args (("-q")))
230 (tramp-remote-shell ,tramp-default-remote-shell) 232 (tramp-remote-shell ,tramp-default-remote-shell)
231 (tramp-remote-shell-login ("-l")) 233 (tramp-remote-shell-login ("-l"))
@@ -389,14 +391,7 @@ The string is used in `tramp-methods'.")
389 (regexp-opt 391 (regexp-opt
390 '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")) 392 '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
391 "\\'") 393 "\\'")
392 nil ,(user-login-name))) 394 nil ,(user-login-name))))
393
394 ;; MS Windows Openssh client does not cooperate well with cmdproxy.
395 (when-let ((encoding-shell
396 (and (eq system-type 'windows-nt) (executable-find "powershell"))))
397 (add-to-list 'tramp-connection-properties
398 `(,(regexp-opt '("/sshx:" "/scpx:"))
399 "encoding-shell" ,encoding-shell))))
400 395
401;;;###tramp-autoload 396;;;###tramp-autoload
402(defconst tramp-completion-function-alist-rsh 397(defconst tramp-completion-function-alist-rsh
@@ -406,16 +401,34 @@ The string is used in `tramp-methods'.")
406 401
407;;;###tramp-autoload 402;;;###tramp-autoload
408(defconst tramp-completion-function-alist-ssh 403(defconst tramp-completion-function-alist-ssh
409 '((tramp-parse-rhosts "/etc/hosts.equiv") 404 `((tramp-parse-rhosts "/etc/hosts.equiv")
410 (tramp-parse-rhosts "/etc/shosts.equiv") 405 (tramp-parse-rhosts "/etc/shosts.equiv")
411 (tramp-parse-shosts "/etc/ssh_known_hosts") 406 ;; On W32 systems, the ssh directory is located somewhere else.
412 (tramp-parse-sconfig "/etc/ssh_config") 407 (tramp-parse-shosts ,(expand-file-name
408 "ssh/ssh_known_hosts"
409 (or (and (eq system-type 'windows-nt)
410 (getenv "ProgramData"))
411 "/etc/")))
412 (tramp-parse-sconfig ,(expand-file-name
413 "ssh/ssh_config"
414 (or (and (eq system-type 'windows-nt)
415 (getenv "ProgramData"))
416 "/etc/")))
413 (tramp-parse-shostkeys "/etc/ssh2/hostkeys") 417 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
414 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") 418 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
415 (tramp-parse-rhosts "~/.rhosts") 419 (tramp-parse-rhosts "~/.rhosts")
416 (tramp-parse-rhosts "~/.shosts") 420 (tramp-parse-rhosts "~/.shosts")
417 (tramp-parse-shosts "~/.ssh/known_hosts") 421 ;; On W32 systems, the .ssh directory is located somewhere else.
418 (tramp-parse-sconfig "~/.ssh/config") 422 (tramp-parse-shosts ,(expand-file-name
423 ".ssh/known_hosts"
424 (or (and (eq system-type 'windows-nt)
425 (getenv "USERPROFILE"))
426 "~/")))
427 (tramp-parse-sconfig ,(expand-file-name
428 ".ssh/config"
429 (or (and (eq system-type 'windows-nt)
430 (getenv "USERPROFILE"))
431 "~/")))
419 (tramp-parse-shostkeys "~/.ssh2/hostkeys") 432 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
420 (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) 433 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
421 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") 434 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
@@ -438,7 +451,7 @@ The string is used in `tramp-methods'.")
438;;;###tramp-autoload 451;;;###tramp-autoload
439(defconst tramp-completion-function-alist-putty 452(defconst tramp-completion-function-alist-putty
440 `((tramp-parse-putty 453 `((tramp-parse-putty
441 ,(if (memq system-type '(windows-nt)) 454 ,(if (eq system-type 'windows-nt)
442 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" 455 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
443 "~/.putty/sessions"))) 456 "~/.putty/sessions")))
444 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") 457 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.")
@@ -491,7 +504,6 @@ shell from reading its init file."
491 '((tramp-login-prompt-regexp tramp-action-login) 504 '((tramp-login-prompt-regexp tramp-action-login)
492 (tramp-password-prompt-regexp tramp-action-password) 505 (tramp-password-prompt-regexp tramp-action-password)
493 (tramp-wrong-passwd-regexp tramp-action-permission-denied) 506 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
494 (tramp-no-job-control-regexp tramp-action-permission-denied)
495 (shell-prompt-pattern tramp-action-succeed) 507 (shell-prompt-pattern tramp-action-succeed)
496 (tramp-shell-prompt-pattern tramp-action-succeed) 508 (tramp-shell-prompt-pattern tramp-action-succeed)
497 (tramp-yesno-prompt-regexp tramp-action-yesno) 509 (tramp-yesno-prompt-regexp tramp-action-yesno)
@@ -949,7 +961,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
949 (file-name-directory . tramp-handle-file-name-directory) 961 (file-name-directory . tramp-handle-file-name-directory)
950 (file-name-nondirectory . tramp-handle-file-name-nondirectory) 962 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
951 ;; `file-name-sans-versions' performed by default handler. 963 ;; `file-name-sans-versions' performed by default handler.
952 (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p) 964 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
953 (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) 965 (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
954 (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) 966 (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
955 (file-notify-valid-p . tramp-handle-file-notify-valid-p) 967 (file-notify-valid-p . tramp-handle-file-notify-valid-p)
@@ -1557,49 +1569,6 @@ ID-FORMAT valid values are `string' and `integer'."
1557 (or (tramp-check-cached-permissions v ?r) 1569 (or (tramp-check-cached-permissions v ?r)
1558 (tramp-run-test "-r" filename))))) 1570 (tramp-run-test "-r" filename)))))
1559 1571
1560;; When the remote shell is started, it looks for a shell which groks
1561;; tilde expansion. Here, we assume that all shells which grok tilde
1562;; expansion will also provide a `test' command which groks `-nt' (for
1563;; newer than). If this breaks, tell me about it and I'll try to do
1564;; something smarter about it.
1565(defun tramp-sh-handle-file-newer-than-file-p (file1 file2)
1566 "Like `file-newer-than-file-p' for Tramp files."
1567 (cond ((not (file-exists-p file1)) nil)
1568 ((not (file-exists-p file2)) t)
1569 (t ;; We are sure both files exist at this point. We try to
1570 ;; get the mtime of both files. If they are not equal to
1571 ;; the "dont-know" value, then we subtract the times and
1572 ;; obtain the result.
1573 (let ((fa1 (file-attributes file1))
1574 (fa2 (file-attributes file2)))
1575 (if (and
1576 (not
1577 (tramp-compat-time-equal-p
1578 (tramp-compat-file-attribute-modification-time fa1)
1579 tramp-time-dont-know))
1580 (not
1581 (tramp-compat-time-equal-p
1582 (tramp-compat-file-attribute-modification-time fa2)
1583 tramp-time-dont-know)))
1584 (time-less-p
1585 (tramp-compat-file-attribute-modification-time fa2)
1586 (tramp-compat-file-attribute-modification-time fa1))
1587 ;; If one of them is the dont-know value, then we can
1588 ;; still try to run a shell command on the remote host.
1589 ;; However, this only works if both files are Tramp
1590 ;; files and both have the same method, same user, same
1591 ;; host.
1592 (unless (tramp-equal-remote file1 file2)
1593 (with-parsed-tramp-file-name
1594 (if (tramp-tramp-file-p file1) file1 file2) nil
1595 (tramp-error
1596 v 'file-error
1597 "Files %s and %s must have same method, user, host"
1598 file1 file2)))
1599 (with-parsed-tramp-file-name file1 nil
1600 (tramp-run-test2
1601 (tramp-get-test-nt-command v) file1 file2)))))))
1602
1603;; Functions implemented using the basic functions above. 1572;; Functions implemented using the basic functions above.
1604 1573
1605(defun tramp-sh-handle-file-directory-p (filename) 1574(defun tramp-sh-handle-file-directory-p (filename)
@@ -3959,24 +3928,6 @@ Returns the exit code of the `test' program."
3959 switch 3928 switch
3960 (tramp-shell-quote-argument localname))))) 3929 (tramp-shell-quote-argument localname)))))
3961 3930
3962(defun tramp-run-test2 (format-string file1 file2)
3963 "Run `test'-like program on the remote system, given FILE1, FILE2.
3964FORMAT-STRING contains the program name, switches, and place holders.
3965Returns the exit code of the `test' program. Barfs if the methods,
3966hosts, or files, disagree."
3967 (unless (tramp-equal-remote file1 file2)
3968 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
3969 (tramp-error
3970 v 'file-error
3971 "tramp-run-test2 only implemented for same method, user, host")))
3972 (with-parsed-tramp-file-name file1 v1
3973 (with-parsed-tramp-file-name file1 v2
3974 (tramp-send-command-and-check
3975 v1
3976 (format format-string
3977 (tramp-shell-quote-argument v1-localname)
3978 (tramp-shell-quote-argument v2-localname))))))
3979
3980(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) 3931(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
3981 "Regexp to determine remote SunOS.") 3932 "Regexp to determine remote SunOS.")
3982 3933
@@ -4865,6 +4816,8 @@ connection if a previous connection has died for some reason."
4865 (setenv "HISTSIZE" "0")))) 4816 (setenv "HISTSIZE" "0"))))
4866 (setenv "PROMPT_COMMAND") 4817 (setenv "PROMPT_COMMAND")
4867 (setenv "PS1" tramp-initial-end-of-output) 4818 (setenv "PS1" tramp-initial-end-of-output)
4819 (unless (stringp tramp-encoding-shell)
4820 (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
4868 (let* ((current-host tramp-system-name) 4821 (let* ((current-host tramp-system-name)
4869 (target-alist (tramp-compute-multi-hops vec)) 4822 (target-alist (tramp-compute-multi-hops vec))
4870 ;; We will apply `tramp-ssh-controlmaster-options' 4823 ;; We will apply `tramp-ssh-controlmaster-options'
@@ -4876,23 +4829,17 @@ connection if a previous connection has died for some reason."
4876 ;; W32 systems. 4829 ;; W32 systems.
4877 (process-coding-system-alist nil) 4830 (process-coding-system-alist nil)
4878 (coding-system-for-read nil) 4831 (coding-system-for-read nil)
4879 (encoding-shell 4832 (extra-args (tramp-get-sh-extra-args tramp-encoding-shell))
4880 (tramp-get-connection-property
4881 vec "encoding-shell" tramp-encoding-shell))
4882 (extra-args (tramp-get-sh-extra-args encoding-shell))
4883 ;; This must be done in order to avoid our file 4833 ;; This must be done in order to avoid our file
4884 ;; name handler. 4834 ;; name handler.
4885 (p (let ((default-directory 4835 (p (let ((default-directory
4886 (tramp-compat-temporary-file-directory))) 4836 (tramp-compat-temporary-file-directory)))
4887 (unless (stringp encoding-shell)
4888 (tramp-error
4889 vec 'file-error "`tramp-encoding-shell' not set"))
4890 (apply 4837 (apply
4891 #'start-process 4838 #'start-process
4892 (tramp-get-connection-name vec) 4839 (tramp-get-connection-name vec)
4893 (tramp-get-connection-buffer vec) 4840 (tramp-get-connection-buffer vec)
4894 (append 4841 (append
4895 (list encoding-shell) 4842 (list tramp-encoding-shell)
4896 (and extra-args (split-string extra-args)) 4843 (and extra-args (split-string extra-args))
4897 (and tramp-encoding-command-interactive 4844 (and tramp-encoding-command-interactive
4898 (list tramp-encoding-command-interactive))))))) 4845 (list tramp-encoding-command-interactive)))))))
@@ -4911,7 +4858,8 @@ connection if a previous connection has died for some reason."
4911 4858
4912 ;; Check whether process is alive. 4859 ;; Check whether process is alive.
4913 (tramp-barf-if-no-shell-prompt 4860 (tramp-barf-if-no-shell-prompt
4914 p 10 "Couldn't find local shell prompt for %s" encoding-shell) 4861 p 10
4862 "Couldn't find local shell prompt for %s" tramp-encoding-shell)
4915 4863
4916 ;; Now do all the connections as specified. 4864 ;; Now do all the connections as specified.
4917 (while target-alist 4865 (while target-alist
@@ -4986,7 +4934,7 @@ connection if a previous connection has died for some reason."
4986 ?c (format-spec options (format-spec-make ?t tmpfile)) 4934 ?c (format-spec options (format-spec-make ?t tmpfile))
4987 ?l (concat remote-shell " " extra-args " -i")) 4935 ?l (concat remote-shell " " extra-args " -i"))
4988 ;; A restricted shell does not allow "exec". 4936 ;; A restricted shell does not allow "exec".
4989 (when r-shell '("; exit"))) 4937 (when r-shell '("&&" "exit" "||" "exit")))
4990 " ")) 4938 " "))
4991 4939
4992 ;; Send the command. 4940 ;; Send the command.
@@ -5834,7 +5782,7 @@ function cell is returned to be applied on a buffer."
5834 ;; slashes as directory separators. 5782 ;; slashes as directory separators.
5835 (cond 5783 (cond
5836 ((and (string-match-p "local" prop) 5784 ((and (string-match-p "local" prop)
5837 (memq system-type '(windows-nt))) 5785 (eq system-type 'windows-nt))
5838 "(%s | \"%s\")") 5786 "(%s | \"%s\")")
5839 ((string-match-p "local" prop) "(%s | %s)") 5787 ((string-match-p "local" prop) "(%s | %s)")
5840 (t "(%s | %s >%%s)")) 5788 (t "(%s | %s >%%s)"))
@@ -5845,7 +5793,7 @@ function cell is returned to be applied on a buffer."
5845 ;; the pipe symbol be quoted if they use forward 5793 ;; the pipe symbol be quoted if they use forward
5846 ;; slashes as directory separators. 5794 ;; slashes as directory separators.
5847 (if (and (string-match-p "local" prop) 5795 (if (and (string-match-p "local" prop)
5848 (memq system-type '(windows-nt))) 5796 (eq system-type 'windows-nt))
5849 "(%s <%%s | \"%s\")" 5797 "(%s <%%s | \"%s\")"
5850 "(%s <%%s | %s)") 5798 "(%s <%%s | %s)")
5851 compress coding)) 5799 compress coding))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 99955b54598..8da94ec9d9e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -488,7 +488,7 @@ interpreted as a regular expression which always matches."
488;; either lower case or upper case letters. See 488;; either lower case or upper case letters. See
489;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>. 489;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
490(defcustom tramp-restricted-shell-hosts-alist 490(defcustom tramp-restricted-shell-hosts-alist
491 (when (memq system-type '(windows-nt)) 491 (when (eq system-type 'windows-nt)
492 (list (format "\\`\\(%s\\|%s\\)\\'" 492 (list (format "\\`\\(%s\\|%s\\)\\'"
493 (regexp-quote (downcase tramp-system-name)) 493 (regexp-quote (downcase tramp-system-name))
494 (regexp-quote (upcase tramp-system-name))))) 494 (regexp-quote (upcase tramp-system-name)))))
@@ -558,7 +558,7 @@ usually suffice.")
558the remote shell.") 558the remote shell.")
559 559
560(defcustom tramp-local-end-of-line 560(defcustom tramp-local-end-of-line
561 (if (memq system-type '(windows-nt)) "\r\n" "\n") 561 (if (eq system-type 'windows-nt) "\r\n" "\n")
562 "String used for end of line in local processes." 562 "String used for end of line in local processes."
563 :version "24.1" 563 :version "24.1"
564 :type 'string) 564 :type 'string)
@@ -691,15 +691,6 @@ The regexp should match at end of buffer."
691 :version "27.1" 691 :version "27.1"
692 :type 'regexp) 692 :type 'regexp)
693 693
694;; Powershell requires "ssh -t -t" for terminal emulation. If it
695;; doesn't fit, there is an error.
696(defcustom tramp-no-job-control-regexp
697 (regexp-quote "Thus no job control in this shell.")
698 "Regular expression matching powershell's job control message.
699The regexp should match at end of buffer."
700 :version "28.1"
701 :type 'regexp)
702
703(defcustom tramp-operation-not-permitted-regexp 694(defcustom tramp-operation-not-permitted-regexp
704 (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" 695 (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
705 (regexp-opt '("Operation not permitted") t)) 696 (regexp-opt '("Operation not permitted") t))
@@ -1087,7 +1078,13 @@ initial value is overwritten by the car of `tramp-file-name-structure'.")
1087 1078
1088(defconst tramp-completion-file-name-regexp-default 1079(defconst tramp-completion-file-name-regexp-default
1089 (concat 1080 (concat
1090 "\\`/\\(" 1081 "\\`"
1082 ;; `file-name-completion' uses absolute paths for matching. This
1083 ;; means that on W32 systems, something like "/ssh:host:~/path"
1084 ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'.
1085 (when (eq system-type 'windows-nt)
1086 "\\(?:[[:alpha:]]:\\)?")
1087 "/\\("
1091 ;; Optional multi hop. 1088 ;; Optional multi hop.
1092 "\\([^/|:]+:[^/|:]*|\\)*" 1089 "\\([^/|:]+:[^/|:]*|\\)*"
1093 ;; Last hop. 1090 ;; Last hop.
@@ -1106,7 +1103,13 @@ On W32 systems, the volume letter must be ignored.")
1106 1103
1107(defconst tramp-completion-file-name-regexp-simplified 1104(defconst tramp-completion-file-name-regexp-simplified
1108 (concat 1105 (concat
1109 "\\`/\\(" 1106 "\\`"
1107 ;; Allow the volume letter at the beginning of the path. See the
1108 ;; comment in `tramp-completion-file-name-regexp-default' for more
1109 ;; details.
1110 (when (eq system-type 'windows-nt)
1111 "\\(?:[[:alpha:]]:\\)?")
1112 "/\\("
1110 ;; Optional multi hop. 1113 ;; Optional multi hop.
1111 "\\([^/|:]*|\\)*" 1114 "\\([^/|:]*|\\)*"
1112 ;; Last hop. 1115 ;; Last hop.
@@ -1122,7 +1125,14 @@ See `tramp-file-name-structure' for more explanations.
1122On W32 systems, the volume letter must be ignored.") 1125On W32 systems, the volume letter must be ignored.")
1123 1126
1124(defconst tramp-completion-file-name-regexp-separate 1127(defconst tramp-completion-file-name-regexp-separate
1125 "\\`/\\(\\[[^]]*\\)?\\'" 1128 (concat
1129 "\\`"
1130 ;; Allow the volume letter at the beginning of the path. See the
1131 ;; comment in `tramp-completion-file-name-regexp-default' for more
1132 ;; details.
1133 (when (eq system-type 'windows-nt)
1134 "\\(?:[[:alpha:]]:\\)?")
1135 "/\\(\\[[^]]*\\)?\\'")
1126 "Value for `tramp-completion-file-name-regexp' for separate remoting. 1136 "Value for `tramp-completion-file-name-regexp' for separate remoting.
1127See `tramp-file-name-structure' for more explanations.") 1137See `tramp-file-name-structure' for more explanations.")
1128 1138
@@ -3128,7 +3138,7 @@ User may be nil."
3128(defun tramp-parse-putty (registry-or-dirname) 3138(defun tramp-parse-putty (registry-or-dirname)
3129 "Return a list of (user host) tuples allowed to access. 3139 "Return a list of (user host) tuples allowed to access.
3130User is always nil." 3140User is always nil."
3131 (if (memq system-type '(windows-nt)) 3141 (if (eq system-type 'windows-nt)
3132 (with-tramp-connection-property nil "parse-putty" 3142 (with-tramp-connection-property nil "parse-putty"
3133 (with-temp-buffer 3143 (with-temp-buffer
3134 (when (zerop (tramp-call-process 3144 (when (zerop (tramp-call-process
@@ -4980,7 +4990,7 @@ VEC is used for tracing."
4980 (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) 4990 (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
4981 locale) 4991 locale)
4982 (with-temp-buffer 4992 (with-temp-buffer
4983 (unless (or (memq system-type '(windows-nt)) 4993 (unless (or (eq system-type 'windows-nt)
4984 (not (zerop (tramp-call-process 4994 (not (zerop (tramp-call-process
4985 nil "locale" nil t nil "-a")))) 4995 nil "locale" nil t nil "-a"))))
4986 (while candidates 4996 (while candidates
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 7ffee762eb2..a630baf3543 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1336,7 +1336,7 @@ See the variable `iswitchb-case' for details."
1336 1336
1337Iswitchb mode is a global minor mode that enables switching 1337Iswitchb mode is a global minor mode that enables switching
1338between buffers using substrings. See `iswitchb' for details." 1338between buffers using substrings. See `iswitchb' for details."
1339 nil nil iswitchb-global-map :global t 1339 :keymap iswitchb-global-map :global t
1340 (if iswitchb-mode 1340 (if iswitchb-mode
1341 (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup) 1341 (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)
1342 (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))) 1342 (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 59828759e66..f999f507972 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -314,8 +314,6 @@ but before calling PC Selection mode):
314 C-BACKSPACE backward-kill-word 314 C-BACKSPACE backward-kill-word
315 M-BACKSPACE undo" 315 M-BACKSPACE undo"
316 ;; FIXME: bring pc-bindings-mode here ? 316 ;; FIXME: bring pc-bindings-mode here ?
317 nil nil nil
318
319 :global t 317 :global t
320 318
321 (if pc-selection-mode 319 (if pc-selection-mode
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index f40f2b335ef..7ae8fae3aab 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -521,7 +521,7 @@ for a capture buffer.")
521 "Minor mode for special key bindings in a capture buffer. 521 "Minor mode for special key bindings in a capture buffer.
522 522
523Turning on this mode runs the normal hook `org-capture-mode-hook'." 523Turning on this mode runs the normal hook `org-capture-mode-hook'."
524 nil " Cap" org-capture-mode-map 524 :lighter " Cap"
525 (setq-local 525 (setq-local
526 header-line-format 526 header-line-format
527 (substitute-command-keys 527 (substitute-command-keys
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index c6bf416564e..3475cadc42d 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -167,7 +167,7 @@ properties, after each buffer modification, on the modified zone.
167The process is synchronous. Though, initial indentation of 167The process is synchronous. Though, initial indentation of
168buffer, which can take a few seconds on large buffers, is done 168buffer, which can take a few seconds on large buffers, is done
169during idle time." 169during idle time."
170 nil " Ind" nil 170 :lighter " Ind"
171 (cond 171 (cond
172 (org-indent-mode 172 (org-indent-mode
173 ;; mode was turned on. 173 ;; mode was turned on.
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 39122e7ce41..f97164ee33b 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -2304,7 +2304,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
2304;;;###autoload 2304;;;###autoload
2305(define-minor-mode org-list-checkbox-radio-mode 2305(define-minor-mode org-list-checkbox-radio-mode
2306 "When turned on, use list checkboxes as radio buttons." 2306 "When turned on, use list checkboxes as radio buttons."
2307 nil " CheckBoxRadio" nil 2307 :lighter " CheckBoxRadio"
2308 (unless (eq major-mode 'org-mode) 2308 (unless (eq major-mode 'org-mode)
2309 (user-error "Cannot turn this mode outside org-mode buffers"))) 2309 (user-error "Cannot turn this mode outside org-mode buffers")))
2310 2310
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 20acee4e662..cabedecb689 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -682,7 +682,7 @@ This minor mode is turned on in two situations:
682\\{org-src-mode-map} 682\\{org-src-mode-map}
683 683
684See also `org-src-mode-hook'." 684See also `org-src-mode-hook'."
685 nil " OrgSrc" nil 685 :lighter " OrgSrc"
686 (when org-edit-src-persistent-message 686 (when org-edit-src-persistent-message
687 (setq header-line-format 687 (setq header-line-format
688 (substitute-command-keys 688 (substitute-command-keys
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 1248efabc15..0e93fb271f3 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -495,7 +495,7 @@ This may be useful when columns have been shrunk."
495;;;###autoload 495;;;###autoload
496(define-minor-mode org-table-header-line-mode 496(define-minor-mode org-table-header-line-mode
497 "Display the first row of the table at point in the header line." 497 "Display the first row of the table at point in the header line."
498 nil " TblHeader" nil 498 :lighter " TblHeader"
499 (unless (eq major-mode 'org-mode) 499 (unless (eq major-mode 'org-mode)
500 (user-error "Cannot turn org table header mode outside org-mode buffers")) 500 (user-error "Cannot turn org table header mode outside org-mode buffers"))
501 (if org-table-header-line-mode 501 (if org-table-header-line-mode
@@ -1976,7 +1976,7 @@ lines."
1976When this mode is active, the field editor window will always show the 1976When this mode is active, the field editor window will always show the
1977current field. The mode exits automatically when the cursor leaves the 1977current field. The mode exits automatically when the cursor leaves the
1978table (but see `org-table-exit-follow-field-mode-when-leaving-table')." 1978table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
1979 nil " TblFollow" nil 1979 :lighter " TblFollow"
1980 (if org-table-follow-field-mode 1980 (if org-table-follow-field-mode
1981 (add-hook 'post-command-hook 'org-table-follow-fields-with-editor 1981 (add-hook 'post-command-hook 'org-table-follow-fields-with-editor
1982 'append 'local) 1982 'append 'local)
@@ -5149,7 +5149,7 @@ When LOCAL is non-nil, show references for the table at point."
5149;;;###autoload 5149;;;###autoload
5150(define-minor-mode orgtbl-mode 5150(define-minor-mode orgtbl-mode
5151 "The Org mode table editor as a minor mode for use in other modes." 5151 "The Org mode table editor as a minor mode for use in other modes."
5152 :lighter " OrgTbl" :keymap orgtbl-mode-map 5152 :lighter " OrgTbl"
5153 (org-load-modules-maybe) 5153 (org-load-modules-maybe)
5154 (cond 5154 (cond
5155 ((derived-mode-p 'org-mode) 5155 ((derived-mode-p 'org-mode)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index cebe1735bed..f560c65dc4f 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -15584,7 +15584,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
15584This mode supports entering LaTeX environment and math in LaTeX fragments 15584This mode supports entering LaTeX environment and math in LaTeX fragments
15585in Org mode. 15585in Org mode.
15586\\{org-cdlatex-mode-map}" 15586\\{org-cdlatex-mode-map}"
15587 nil " OCDL" nil 15587 :lighter " OCDL"
15588 (when org-cdlatex-mode 15588 (when org-cdlatex-mode
15589 (require 'cdlatex) 15589 (require 'cdlatex)
15590 (run-hooks 'cdlatex-mode-hook) 15590 (run-hooks 'cdlatex-mode-hook)
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 1a1732b6836..6ed95e84d6b 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -895,14 +895,16 @@ holding export options."
895;;; Minor Mode 895;;; Minor Mode
896 896
897 897
898(defvar org-beamer-mode-map (make-sparse-keymap) 898(defvar org-beamer-mode-map
899 (let ((map (make-sparse-keymap)))
900 (define-key map "\C-c\C-b" 'org-beamer-select-environment)
901 map)
899 "The keymap for `org-beamer-mode'.") 902 "The keymap for `org-beamer-mode'.")
900(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
901 903
902;;;###autoload 904;;;###autoload
903(define-minor-mode org-beamer-mode 905(define-minor-mode org-beamer-mode
904 "Support for editing Beamer oriented Org mode files." 906 "Support for editing Beamer oriented Org mode files."
905 nil " Bm" 'org-beamer-mode-map) 907 :lighter " Bm")
906 908
907(when (fboundp 'font-lock-add-keywords) 909(when (fboundp 'font-lock-add-keywords)
908 (font-lock-add-keywords 910 (font-lock-add-keywords
diff --git a/lisp/outline.el b/lisp/outline.el
index 79029a6e5e7..bce9c6b9e4d 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -374,8 +374,9 @@ faces to major mode's faces."
374 "Toggle Outline minor mode. 374 "Toggle Outline minor mode.
375 375
376See the command `outline-mode' for more information on this mode." 376See the command `outline-mode' for more information on this mode."
377 nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) 377 :lighter " Outl"
378 (cons outline-minor-mode-prefix outline-mode-prefix-map)) 378 :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
379 (cons outline-minor-mode-prefix outline-mode-prefix-map))
379 (if outline-minor-mode 380 (if outline-minor-mode
380 (progn 381 (progn
381 (when (or outline-minor-mode-cycle outline-minor-mode-highlight) 382 (when (or outline-minor-mode-cycle outline-minor-mode-highlight)
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 4d4becf780a..e467d98303e 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -440,9 +440,6 @@ and set it if applicable."
440;;;###autoload 440;;;###autoload
441(define-minor-mode bug-reference-mode 441(define-minor-mode bug-reference-mode
442 "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." 442 "Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
443 nil
444 ""
445 nil
446 :after-hook (bug-reference--run-auto-setup) 443 :after-hook (bug-reference--run-auto-setup)
447 (if bug-reference-mode 444 (if bug-reference-mode
448 (jit-lock-register #'bug-reference-fontify) 445 (jit-lock-register #'bug-reference-fontify)
@@ -454,9 +451,6 @@ and set it if applicable."
454;;;###autoload 451;;;###autoload
455(define-minor-mode bug-reference-prog-mode 452(define-minor-mode bug-reference-prog-mode
456 "Like `bug-reference-mode', but only buttonize in comments and strings." 453 "Like `bug-reference-mode', but only buttonize in comments and strings."
457 nil
458 ""
459 nil
460 :after-hook (bug-reference--run-auto-setup) 454 :after-hook (bug-reference--run-auto-setup)
461 (if bug-reference-prog-mode 455 (if bug-reference-prog-mode
462 (jit-lock-register #'bug-reference-fontify) 456 (jit-lock-register #'bug-reference-fontify)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 51d51deef71..9234d0b19b9 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1,4 +1,4 @@
1;;; cc-align.el --- custom indentation functions for CC Mode 1;;; cc-align.el --- custom indentation functions for CC Mode -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
@@ -44,6 +44,9 @@
44(cc-require 'cc-vars) 44(cc-require 'cc-vars)
45(cc-require 'cc-engine) 45(cc-require 'cc-engine)
46 46
47(defvar c-syntactic-context)
48(defvar c-syntactic-element)
49
47 50
48;; Standard line-up functions 51;; Standard line-up functions
49;; 52;;
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 32289443725..84cc5b115e7 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1,4 +1,4 @@
1;;; cc-awk.el --- AWK specific code within cc-mode. 1;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation, 3;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation,
4;; Inc. 4;; Inc.
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 89ea1dca3b0..29634384dda 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -1,4 +1,4 @@
1;;; cc-bytecomp.el --- compile time setup for proper compilation 1;;; cc-bytecomp.el --- compile time setup for proper compilation -*- 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
@@ -85,8 +85,7 @@
85 85
86(defvar cc-bytecomp-environment-set nil) 86(defvar cc-bytecomp-environment-set nil)
87 87
88(defmacro cc-bytecomp-debug-msg (&rest args) 88(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed.
89 (ignore args)
90 ;;`(message ,@args) 89 ;;`(message ,@args)
91 ) 90 )
92 91
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 1754436d132..bee87b68499 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1,4 +1,4 @@
1;;; cc-cmds.el --- user level commands for CC Mode 1;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
@@ -49,12 +49,11 @@
49 ; which looks at this. 49 ; which looks at this.
50(cc-bytecomp-defun electric-pair-post-self-insert-function) 50(cc-bytecomp-defun electric-pair-post-self-insert-function)
51(cc-bytecomp-defvar c-indent-to-body-directives) 51(cc-bytecomp-defvar c-indent-to-body-directives)
52(defvar c-syntactic-context)
52 53
53;; Indentation / Display syntax functions 54;; Indentation / Display syntax functions
54(defvar c-fix-backslashes t) 55(defvar c-fix-backslashes t)
55 56
56(defvar c-syntactic-context)
57
58(defun c-indent-line (&optional syntax quiet ignore-point-pos) 57(defun c-indent-line (&optional syntax quiet ignore-point-pos)
59 "Indent the current line according to the syntactic context, 58 "Indent the current line according to the syntactic context,
60if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the 59if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the
@@ -1220,9 +1219,9 @@ numeric argument is supplied, or the point is inside a literal."
1220 (self-insert-command (prefix-numeric-value arg))) 1219 (self-insert-command (prefix-numeric-value arg)))
1221 (setq final-pos (point)) 1220 (setq final-pos (point))
1222 1221
1223;;;; 2010-01-31: There used to be code here to put a syntax-table text 1222;;;; 2010-01-31: There used to be code here to put a syntax-table text
1224;;;; property on the new < or > and its mate (if any) when they are template 1223;;;; property on the new < or > and its mate (if any) when they are template
1225;;;; parens. This is now done in an after-change function. 1224;;;; parens. This is now done in an after-change function.
1226 1225
1227 (when (and (not arg) (not literal)) 1226 (when (and (not arg) (not literal))
1228 ;; Have we got a delimiter on a #include directive? 1227 ;; Have we got a delimiter on a #include directive?
@@ -1640,7 +1639,7 @@ No indentation or other \"electric\" behavior is performed."
1640 ;; This function might do hidden buffer changes. 1639 ;; This function might do hidden buffer changes.
1641 (save-excursion 1640 (save-excursion
1642 (let* (knr-start knr-res 1641 (let* (knr-start knr-res
1643 decl-result brace-decl-p 1642 decl-result
1644 (start (point)) 1643 (start (point))
1645 (paren-state (c-parse-state)) 1644 (paren-state (c-parse-state))
1646 (least-enclosing (c-least-enclosing-brace paren-state))) 1645 (least-enclosing (c-least-enclosing-brace paren-state)))
@@ -1670,12 +1669,19 @@ No indentation or other \"electric\" behavior is performed."
1670 (not (looking-at c-defun-type-name-decl-key)))))) 1669 (not (looking-at c-defun-type-name-decl-key))))))
1671 'at-function-end) 1670 'at-function-end)
1672 (t 1671 (t
1672 ;; Kluge so that c-beginning-of-decl-1 won't go back if we're already
1673 ;; at a declaration.
1674 (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>"
1675 (not (c-looking-at-non-alphnumspace)))
1676 (forward-char))
1677
1673 (if (and least-enclosing 1678 (if (and least-enclosing
1674 (eq (char-after least-enclosing) ?\()) 1679 (eq (char-after least-enclosing) ?\())
1675 (c-go-list-forward least-enclosing)) 1680 (c-go-list-forward least-enclosing))
1676 (c-forward-syntactic-ws) 1681 (c-forward-syntactic-ws)
1677 (setq knr-start (point)) 1682 (setq knr-start (point))
1678 (if (c-syntactic-re-search-forward "{" nil t t) 1683 (if (and (c-syntactic-re-search-forward "[;{]" nil t t)
1684 (eq (char-before) ?\{))
1679 (progn 1685 (progn
1680 (backward-char) 1686 (backward-char)
1681 (cond 1687 (cond
@@ -1689,19 +1695,27 @@ No indentation or other \"electric\" behavior is performed."
1689 ((and knr-res 1695 ((and knr-res
1690 (goto-char knr-res) 1696 (goto-char knr-res)
1691 (c-backward-syntactic-ws))) ; Always returns nil. 1697 (c-backward-syntactic-ws))) ; Always returns nil.
1692 ((and (eq (char-before) ?\)) 1698 (t
1693 (c-go-list-backward)) 1699 (when (eq (char-before) ?\))
1694 (c-syntactic-skip-backward "^;" start t) 1700 ;; The `c-go-list-backward' is a precaution against
1695 (if (eq (point) start) 1701 ;; `c-beginning-of-decl-1' spuriously finding a C++ lambda
1696 (if (progn (c-backward-syntactic-ws) 1702 ;; function inside the parentheses.
1697 (memq (char-before) '(?\; ?} nil))) 1703 (c-go-list-backward))
1698 (if (progn (c-forward-syntactic-ws) 1704 (setq decl-result
1699 (eq (point) start)) 1705 (car (c-beginning-of-decl-1
1700 'at-header 1706 (and least-enclosing
1701 'outwith-function) 1707 (c-safe-position
1702 'in-header) 1708 least-enclosing paren-state)))))
1703 'outwith-function)) 1709 (cond
1704 (t 'outwith-function))) 1710 ((> (point) start)
1711 'outwith-function)
1712 ((eq decl-result 'same)
1713 (if (eq (point) start)
1714 'at-header
1715 'in-header))
1716 (t (error
1717 "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s"
1718 decl-result))))))
1705 'outwith-function)))))) 1719 'outwith-function))))))
1706 1720
1707(defun c-backward-to-nth-BOF-{ (n where) 1721(defun c-backward-to-nth-BOF-{ (n where)
@@ -1810,12 +1824,14 @@ No indentation or other \"electric\" behavior is performed."
1810 nil))) 1824 nil)))
1811 1825
1812(eval-and-compile 1826(eval-and-compile
1813 (defmacro c-while-widening-to-decl-block (condition) 1827 (defmacro c-while-widening-to-decl-block (condition &optional no-where)
1814 ;; Repeatedly evaluate CONDITION until it returns nil. After each 1828 ;; Repeatedly evaluate CONDITION until it returns nil. After each
1815 ;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards 1829 ;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards
1816 ;; of the next enclosing declaration block (e.g. namespace, class), or the 1830 ;; of the next enclosing declaration block (e.g. namespace, class), or the
1817 ;; buffer's original restriction. 1831 ;; buffer's original restriction.
1818 ;; 1832 ;;
1833 ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'.
1834 ;;
1819 ;; This is a very special purpose macro, which assumes the existence of 1835 ;; This is a very special purpose macro, which assumes the existence of
1820 ;; several variables. It is for use only in c-beginning-of-defun and 1836 ;; several variables. It is for use only in c-beginning-of-defun and
1821 ;; c-end-of-defun. 1837 ;; c-end-of-defun.
@@ -1826,7 +1842,8 @@ No indentation or other \"electric\" behavior is performed."
1826 (setq paren-state (c-whack-state-after lim paren-state)) 1842 (setq paren-state (c-whack-state-after lim paren-state))
1827 (setq lim (c-widen-to-enclosing-decl-scope 1843 (setq lim (c-widen-to-enclosing-decl-scope
1828 paren-state orig-point-min orig-point-max)) 1844 paren-state orig-point-min orig-point-max))
1829 (setq where 'in-block)))) 1845 ,@(if (not no-where)
1846 `((setq where 'in-block))))))
1830 1847
1831(def-edebug-spec c-while-widening-to-decl-block t) 1848(def-edebug-spec c-while-widening-to-decl-block t)
1832 1849
@@ -2307,11 +2324,11 @@ with a brace block, at the outermost level of nesting."
2307 (c-save-buffer-state ((paren-state (c-parse-state)) 2324 (c-save-buffer-state ((paren-state (c-parse-state))
2308 (orig-point-min (point-min)) 2325 (orig-point-min (point-min))
2309 (orig-point-max (point-max)) 2326 (orig-point-max (point-max))
2310 lim name limits where) 2327 lim name limits)
2311 (setq lim (c-widen-to-enclosing-decl-scope 2328 (setq lim (c-widen-to-enclosing-decl-scope
2312 paren-state orig-point-min orig-point-max)) 2329 paren-state orig-point-min orig-point-max))
2313 (and lim (setq lim (1- lim))) 2330 (and lim (setq lim (1- lim)))
2314 (c-while-widening-to-decl-block (not (setq name (c-defun-name-1)))) 2331 (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t)
2315 (when name 2332 (when name
2316 (setq limits (c-declaration-limits-1 near)) 2333 (setq limits (c-declaration-limits-1 near))
2317 (cons name limits))) 2334 (cons name limits)))
@@ -2927,10 +2944,13 @@ function does not require the declaration to contain a brace block."
2927 (c-looking-at-special-brace-list))) 2944 (c-looking-at-special-brace-list)))
2928 (or allow-early-stop (/= here last)) 2945 (or allow-early-stop (/= here last))
2929 (save-excursion ; Is this a check that we're NOT at top level? 2946 (save-excursion ; Is this a check that we're NOT at top level?
2930;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii) The next enclosing 2947;;;; NO! This seems to check that (i) EITHER we're at the top level;
2931;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense. 2948;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM.
2932;;;; 2003/8/8 This might have something to do with the GCC extension "Statement Expressions", e.g. 2949;;;; Doesn't seem to make sense.
2933;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement Expressions. 2950;;;; 2003/8/8 This might have something to do with the GCC extension
2951;;;; "Statement Expressions", e.g.
2952;;;; while ({stmt1 ; stmt2 ; exp ;}).
2953;;;; This form excludes such Statement Expressions.
2934 (or (not (c-safe (up-list -1) t)) 2954 (or (not (c-safe (up-list -1) t))
2935 (= (char-after) ?{)))) 2955 (= (char-after) ?{))))
2936 (goto-char last) 2956 (goto-char last)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 536e6766261..20dc97db5d7 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1,4 +1,4 @@
1;;; cc-defs.el --- compile time definitions for CC Mode 1;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index cc9833a434e..747a6fd4eda 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,4 +1,4 @@
1;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*- 1;;; cc-engine.el --- core syntax guessing engine for CC mode -*- lexical-binding:t; coding: utf-8 -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
@@ -163,6 +163,8 @@
163(defvar c-doc-line-join-re) 163(defvar c-doc-line-join-re)
164(defvar c-doc-bright-comment-start-re) 164(defvar c-doc-bright-comment-start-re)
165(defvar c-doc-line-join-end-ch) 165(defvar c-doc-line-join-end-ch)
166(defvar c-syntactic-context)
167(defvar c-syntactic-element)
166(cc-bytecomp-defvar c-min-syn-tab-mkr) 168(cc-bytecomp-defvar c-min-syn-tab-mkr)
167(cc-bytecomp-defvar c-max-syn-tab-mkr) 169(cc-bytecomp-defvar c-max-syn-tab-mkr)
168(cc-bytecomp-defun c-clear-syn-tab) 170(cc-bytecomp-defun c-clear-syn-tab)
@@ -2717,9 +2719,9 @@ comment at the start of cc-engine.el for more info."
2717 ;; two char construct (such as a comment opener or an escaped character).) 2719 ;; two char construct (such as a comment opener or an escaped character).)
2718 (if (and (consp elt) (>= (length elt) 3)) 2720 (if (and (consp elt) (>= (length elt) 3))
2719 ;; Inside a string or comment 2721 ;; Inside a string or comment
2720 (let ((depth 0) (containing nil) (last nil) 2722 (let ((depth 0) (containing nil)
2721 in-string in-comment 2723 in-string in-comment
2722 (min-depth 0) com-style com-str-start (intermediate nil) 2724 (min-depth 0) com-style com-str-start
2723 (char-1 (nth 3 elt)) ; first char of poss. 2-char construct 2725 (char-1 (nth 3 elt)) ; first char of poss. 2-char construct
2724 (pos (car elt)) 2726 (pos (car elt))
2725 (type (cadr elt))) 2727 (type (cadr elt)))
@@ -2736,14 +2738,13 @@ comment at the start of cc-engine.el for more info."
2736 (1- pos) 2738 (1- pos)
2737 pos)) 2739 pos))
2738 (if (memq 'pps-extended-state c-emacs-features) 2740 (if (memq 'pps-extended-state c-emacs-features)
2739 (list depth containing last 2741 (list depth containing nil
2740 in-string in-comment nil 2742 in-string in-comment nil
2741 min-depth com-style com-str-start 2743 min-depth com-style com-str-start
2742 intermediate nil) 2744 nil nil)
2743 (list depth containing last 2745 (list depth containing nil
2744 in-string in-comment nil 2746 in-string in-comment nil
2745 min-depth com-style com-str-start 2747 min-depth com-style com-str-start nil)))
2746 intermediate)))
2747 2748
2748 ;; Not in a string or comment. 2749 ;; Not in a string or comment.
2749 (if (memq 'pps-extended-state c-emacs-features) 2750 (if (memq 'pps-extended-state c-emacs-features)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 4e283764ceb..433b4dcf4a8 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,4 +1,4 @@
1;;; cc-fonts.el --- font lock support for CC Mode 1;;; cc-fonts.el --- font lock support for CC Mode -*- 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
@@ -2287,7 +2287,7 @@ need for `c-font-lock-extra-types'.")
2287 ;; font-lock-keyword-face. It always returns NIL to inhibit this and 2287 ;; font-lock-keyword-face. It always returns NIL to inhibit this and
2288 ;; prevent a repeat invocation. See elisp/lispref page "Search-based 2288 ;; prevent a repeat invocation. See elisp/lispref page "Search-based
2289 ;; fontification". 2289 ;; fontification".
2290 (let (pos after-name) 2290 (let (pos)
2291 (while (c-syntactic-re-search-forward c-using-key limit 'end) 2291 (while (c-syntactic-re-search-forward c-using-key limit 'end)
2292 (while ; Do one declarator of a comma separated list, each time around. 2292 (while ; Do one declarator of a comma separated list, each time around.
2293 (progn 2293 (progn
@@ -2295,7 +2295,6 @@ need for `c-font-lock-extra-types'.")
2295 (setq pos (point)) ; token after "using". 2295 (setq pos (point)) ; token after "using".
2296 (when (and (c-on-identifier) 2296 (when (and (c-on-identifier)
2297 (c-forward-name)) 2297 (c-forward-name))
2298 (setq after-name (point))
2299 (cond 2298 (cond
2300 ((eq (char-after) ?=) ; using foo = <type-id>; 2299 ((eq (char-after) ?=) ; using foo = <type-id>;
2301 (goto-char pos) 2300 (goto-char pos)
@@ -2305,7 +2304,8 @@ need for `c-font-lock-extra-types'.")
2305 (c-go-up-list-backward) 2304 (c-go-up-list-backward)
2306 (eq (char-after) ?{) 2305 (eq (char-after) ?{)
2307 (eq (car (c-beginning-of-decl-1 2306 (eq (car (c-beginning-of-decl-1
2308 (c-determine-limit 1000))) 'same) 2307 (c-determine-limit 1000)))
2308 'same)
2309 (looking-at c-colon-type-list-re))) 2309 (looking-at c-colon-type-list-re)))
2310 ;; Inherited protected member: leave unfontified 2310 ;; Inherited protected member: leave unfontified
2311 ) 2311 )
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index 1b852ec4910..0824af66b43 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -1,4 +1,4 @@
1;;; cc-guess.el --- guess indentation values by scanning existing code 1;;; cc-guess.el --- guess indentation values by scanning existing code -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software 3;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 7819617bcf6..4266600f8cf 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1,4 +1,4 @@
1;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*- 1;;; cc-langs.el --- language specific settings for CC Mode -*- lexical-binding: t; coding: utf-8 -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
@@ -580,14 +580,12 @@ don't have EOL terminated statements. "
580(c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn)) 580(c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn))
581 581
582(c-lang-defconst c-vsemi-status-unknown-p-fn 582(c-lang-defconst c-vsemi-status-unknown-p-fn
583 "Contains a predicate regarding the presence of virtual semicolons. 583 "A function \"are we unsure whether there is a virtual semicolon on this line?\".
584More precisely, the function answers the question, \"are we unsure whether a 584The (admittedly kludgy) purpose of such a function is to prevent an infinite
585virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of 585recursion in c-beginning-of-statement-1 when point starts at a `while' token.
586such a function is to prevent an infinite recursion in 586The function MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1',
587`c-beginning-of-statement-1' when point starts at a `while' token. The function 587even indirectly. This variable contains nil for languages which don't have
588MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even 588EOL terminated statements."
589indirectly. This variable contains nil for languages which don't have EOL
590terminated statements."
591 t nil 589 t nil
592 (c c++ objc) 'c-macro-vsemi-status-unknown-p 590 (c c++ objc) 'c-macro-vsemi-status-unknown-p
593 awk 'c-awk-vsemi-status-unknown-p) 591 awk 'c-awk-vsemi-status-unknown-p)
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 0ff6efb7d37..a099ec1de95 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -1,4 +1,4 @@
1;;; cc-menus.el --- imenu support for CC Mode 1;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index cfb23d0d45e..dae0062efb5 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,4 +1,4 @@
1;;; cc-mode.el --- major mode for editing C and similar languages 1;;; cc-mode.el --- major mode for editing C and similar languages -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 29cbe54c3bd..77cad77711a 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -1,4 +1,4 @@
1;;; cc-styles.el --- support for styles in CC Mode 1;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
@@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil."
464 offset)) 464 offset))
465 465
466;;;###autoload 466;;;###autoload
467(defun c-set-offset (symbol offset &optional ignored) 467(defun c-set-offset (symbol offset &optional _ignored)
468 "Change the value of a syntactic element symbol in `c-offsets-alist'. 468 "Change the value of a syntactic element symbol in `c-offsets-alist'.
469SYMBOL is the syntactic element symbol to change and OFFSET is the new 469SYMBOL is the syntactic element symbol to change and OFFSET is the new
470offset for that syntactic element. The optional argument is not used 470offset for that syntactic element. The optional argument is not used
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 88ee092da79..b33fea0b48c 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1,4 +1,4 @@
1;;; cc-vars.el --- user customization variables for CC Mode 1;;; cc-vars.el --- user customization variables for CC Mode -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
4 4
@@ -42,6 +42,9 @@
42 42
43(cc-require 'cc-defs) 43(cc-require 'cc-defs)
44 44
45(defvar c-syntactic-context)
46(defvar c-syntactic-element)
47
45(cc-eval-when-compile 48(cc-eval-when-compile
46 (require 'custom) 49 (require 'custom)
47 (require 'widget)) 50 (require 'widget))
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 820867ab41f..edcd88ce24e 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -1,7 +1,6 @@
1;;; cmacexp.el --- expand C macros in a region 1;;; cmacexp.el --- expand C macros in a region -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation, 3;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
4;; Inc.
5 4
6;; Author: Francesco Potortì <pot@gnu.org> 5;; Author: Francesco Potortì <pot@gnu.org>
7;; Adapted-By: ESR 6;; Adapted-By: ESR
@@ -33,20 +32,20 @@
33 32
34;; USAGE ============================================================= 33;; USAGE =============================================================
35 34
36;; In C mode C-C C-e is bound to c-macro-expand. The result of the 35;; In C mode C-c C-e is bound to `c-macro-expand'. The result of the
37;; expansion is put in a separate buffer. A user option allows the 36;; expansion is put in a separate buffer. A user option allows the
38;; window displaying the buffer to be optimally sized. 37;; window displaying the buffer to be optimally sized.
39;; 38;;
40;; When called with a C-u prefix, c-macro-expand replaces the selected 39;; When called with a C-u prefix, `c-macro-expand' replaces the selected
41;; region with the expansion. Both the preprocessor name and the 40;; region with the expansion. Both the preprocessor name and the
42;; initial flag can be set by the user. If c-macro-prompt-flag is set 41;; initial flag can be set by the user. If `c-macro-prompt-flag' is set
43;; to a non-nil value the user is offered to change the options to the 42;; to a non-nil value the user is offered to change the options to the
44;; preprocessor each time c-macro-expand is invoked. Preprocessor 43;; preprocessor each time `c-macro-expand' is invoked. Preprocessor
45;; arguments default to the last ones entered. If c-macro-prompt-flag 44;; arguments default to the last ones entered. If `c-macro-prompt-flag'
46;; is nil, one must use M-x set-variable to set a different value for 45;; is nil, one must use M-x set-variable to set a different value for
47;; c-macro-cppflags. 46;; `c-macro-cppflags'.
48 47
49;; A c-macro-expansion function is provided for non-interactive use. 48;; A `c-macro-expansion' function is provided for non-interactive use.
50 49
51;; INSTALLATION ====================================================== 50;; INSTALLATION ======================================================
52 51
@@ -54,18 +53,22 @@
54 53
55;; If you want the *Macroexpansion* window to be not higher than 54;; If you want the *Macroexpansion* window to be not higher than
56;; necessary: 55;; necessary:
57;;(setq c-macro-shrink-window-flag t) 56;;
57;; (setq c-macro-shrink-window-flag t)
58;; 58;;
59;; If you use a preprocessor other than /lib/cpp (be careful to set a 59;; If you use a preprocessor other than /lib/cpp (be careful to set a
60;; -C option or equivalent in order to make the preprocessor not to 60;; -C option or equivalent in order to make the preprocessor not to
61;; strip the comments): 61;; strip the comments):
62;;(setq c-macro-preprocessor "gpp -C") 62;;
63;; (setq c-macro-preprocessor "gpp -C")
63;; 64;;
64;; If you often use a particular set of flags: 65;; If you often use a particular set of flags:
65;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG" 66;;
67;; (setq c-macro-cppflags "-I /usr/include/local -DDEBUG"
66;; 68;;
67;; If you want the "Preprocessor arguments: " prompt: 69;; If you want the "Preprocessor arguments: " prompt:
68;;(setq c-macro-prompt-flag t) 70;;
71;; (setq c-macro-prompt-flag t)
69 72
70;; BUG REPORTS ======================================================= 73;; BUG REPORTS =======================================================
71 74
@@ -87,16 +90,12 @@
87 90
88(require 'cc-mode) 91(require 'cc-mode)
89 92
90(provide 'cmacexp)
91
92(defvar msdos-shells) 93(defvar msdos-shells)
93 94
94
95(defgroup c-macro nil 95(defgroup c-macro nil
96 "Expand C macros in a region." 96 "Expand C macros in a region."
97 :group 'c) 97 :group 'c)
98 98
99
100(defcustom c-macro-shrink-window-flag nil 99(defcustom c-macro-shrink-window-flag nil
101 "Non-nil means shrink the *Macroexpansion* window to fit its contents." 100 "Non-nil means shrink the *Macroexpansion* window to fit its contents."
102 :type 'boolean) 101 :type 'boolean)
@@ -392,4 +391,6 @@ Optional arg DISPLAY non-nil means show messages in the echo area."
392 ;; Cleanup. 391 ;; Cleanup.
393 (kill-buffer outbuf)))) 392 (kill-buffer outbuf))))
394 393
394(provide 'cmacexp)
395
395;;; cmacexp.el ends here 396;;; cmacexp.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 411ab558413..a690d4bceb3 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -512,7 +512,7 @@ functions are annotated with \"<f>\" via the
512 (end 512 (end
513 (unless (or (eq beg (point-max)) 513 (unless (or (eq beg (point-max))
514 (member (char-syntax (char-after beg)) 514 (member (char-syntax (char-after beg))
515 '(?\s ?\" ?\( ?\)))) 515 '(?\" ?\()))
516 (condition-case nil 516 (condition-case nil
517 (save-excursion 517 (save-excursion
518 (goto-char beg) 518 (goto-char beg)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 8481a27775f..e10602ab081 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -741,7 +741,10 @@ to handle a report even if TOKEN was not expected. REGION is
741a (BEG . END) pair of buffer positions indicating that this 741a (BEG . END) pair of buffer positions indicating that this
742report applies to that region." 742report applies to that region."
743 (let* ((state (gethash backend flymake--backend-state)) 743 (let* ((state (gethash backend flymake--backend-state))
744 (first-report (not (flymake--backend-state-reported-p state)))) 744 first-report)
745 (unless state
746 (error "Can't find state for %s in `flymake--backend-state'" backend))
747 (setf first-report (not (flymake--backend-state-reported-p state)))
745 (setf (flymake--backend-state-reported-p state) t) 748 (setf (flymake--backend-state-reported-p state) t)
746 (let (expected-token 749 (let (expected-token
747 new-diags) 750 new-diags)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 910f70db03c..a819e7243ca 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1338,28 +1338,36 @@ made from `project-switch-commands'.
1338When called in a program, it will use the project corresponding 1338When called in a program, it will use the project corresponding
1339to directory DIR." 1339to directory DIR."
1340 (interactive (list (project-prompt-project-dir))) 1340 (interactive (list (project-prompt-project-dir)))
1341 (let ((commands-menu 1341 (let* ((commands-menu
1342 (mapcar 1342 (mapcar
1343 (lambda (row) 1343 (lambda (row)
1344 (if (characterp (car row)) 1344 (if (characterp (car row))
1345 ;; Deprecated format. 1345 ;; Deprecated format.
1346 ;; XXX: Add a warning about it? 1346 ;; XXX: Add a warning about it?
1347 (reverse row) 1347 (reverse row)
1348 row)) 1348 row))
1349 project-switch-commands)) 1349 project-switch-commands))
1350 command) 1350 (commands-map
1351 (let ((temp-map (make-sparse-keymap)))
1352 (set-keymap-parent temp-map project-prefix-map)
1353 (dolist (row commands-menu temp-map)
1354 (when-let ((cmd (nth 0 row))
1355 (keychar (nth 2 row)))
1356 (define-key temp-map (vector keychar) cmd)))))
1357 command)
1351 (while (not command) 1358 (while (not command)
1352 (let ((choice (read-event (project--keymap-prompt)))) 1359 (let ((overriding-local-map commands-map)
1353 (when (setq command 1360 (choice (read-key-sequence (project--keymap-prompt))))
1354 (or (car 1361 (when (setq command (lookup-key commands-map choice))
1355 (seq-find (lambda (row) (equal choice (nth 2 row)))
1356 commands-menu))
1357 (lookup-key project-prefix-map (vector choice))))
1358 (unless (or project-switch-use-entire-map 1362 (unless (or project-switch-use-entire-map
1359 (assq command commands-menu)) 1363 (assq command commands-menu))
1360 ;; TODO: Add some hint to the prompt, like "key not 1364 ;; TODO: Add some hint to the prompt, like "key not
1361 ;; recognized" or something. 1365 ;; recognized" or something.
1362 (setq command nil))))) 1366 (setq command nil)))
1367 (let ((global-command (lookup-key (current-global-map) choice)))
1368 (when (memq global-command
1369 '(keyboard-quit keyboard-escape-quit))
1370 (call-interactively global-command)))))
1363 (let ((default-directory dir) 1371 (let ((default-directory dir)
1364 (project-current-inhibit-prompt t)) 1372 (project-current-inhibit-prompt t))
1365 (call-interactively command)))) 1373 (call-interactively command))))
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 598f748f5b3..67c034d0905 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -1,4 +1,4 @@
1;;; ps-mode.el --- PostScript mode for GNU Emacs 1;;; ps-mode.el --- PostScript mode for GNU Emacs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -281,20 +281,20 @@ If nil, use `temporary-file-directory'."
281 281
282(defvar ps-mode-map 282(defvar ps-mode-map
283 (let ((map (make-sparse-keymap))) 283 (let ((map (make-sparse-keymap)))
284 (define-key map "\C-c\C-v" 'ps-run-boundingbox) 284 (define-key map "\C-c\C-v" #'ps-run-boundingbox)
285 (define-key map "\C-c\C-u" 'ps-mode-uncomment-region) 285 (define-key map "\C-c\C-u" #'ps-mode-uncomment-region)
286 (define-key map "\C-c\C-t" 'ps-mode-epsf-rich) 286 (define-key map "\C-c\C-t" #'ps-mode-epsf-rich)
287 (define-key map "\C-c\C-s" 'ps-run-start) 287 (define-key map "\C-c\C-s" #'ps-run-start)
288 (define-key map "\C-c\C-r" 'ps-run-region) 288 (define-key map "\C-c\C-r" #'ps-run-region)
289 (define-key map "\C-c\C-q" 'ps-run-quit) 289 (define-key map "\C-c\C-q" #'ps-run-quit)
290 (define-key map "\C-c\C-p" 'ps-mode-print-buffer) 290 (define-key map "\C-c\C-p" #'ps-mode-print-buffer)
291 (define-key map "\C-c\C-o" 'ps-mode-comment-out-region) 291 (define-key map "\C-c\C-o" #'ps-mode-comment-out-region)
292 (define-key map "\C-c\C-k" 'ps-run-kill) 292 (define-key map "\C-c\C-k" #'ps-run-kill)
293 (define-key map "\C-c\C-j" 'ps-mode-other-newline) 293 (define-key map "\C-c\C-j" #'ps-mode-other-newline)
294 (define-key map "\C-c\C-l" 'ps-run-clear) 294 (define-key map "\C-c\C-l" #'ps-run-clear)
295 (define-key map "\C-c\C-b" 'ps-run-buffer) 295 (define-key map "\C-c\C-b" #'ps-run-buffer)
296 ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead? 296 ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
297 (define-key map "\177" 'ps-mode-backward-delete-char) 297 (define-key map "\177" #'ps-mode-backward-delete-char)
298 map) 298 map)
299 "Local keymap to use in PostScript mode.") 299 "Local keymap to use in PostScript mode.")
300 300
@@ -336,10 +336,10 @@ If nil, use `temporary-file-directory'."
336(defvar ps-run-mode-map 336(defvar ps-run-mode-map
337 (let ((map (make-sparse-keymap))) 337 (let ((map (make-sparse-keymap)))
338 (set-keymap-parent map comint-mode-map) 338 (set-keymap-parent map comint-mode-map)
339 (define-key map "\C-c\C-q" 'ps-run-quit) 339 (define-key map "\C-c\C-q" #'ps-run-quit)
340 (define-key map "\C-c\C-k" 'ps-run-kill) 340 (define-key map "\C-c\C-k" #'ps-run-kill)
341 (define-key map "\C-c\C-e" 'ps-run-goto-error) 341 (define-key map "\C-c\C-e" #'ps-run-goto-error)
342 (define-key map [mouse-2] 'ps-run-mouse-goto-error) 342 (define-key map [mouse-2] #'ps-run-mouse-goto-error)
343 map) 343 map)
344 "Local keymap to use in PostScript run mode.") 344 "Local keymap to use in PostScript run mode.")
345 345
@@ -1092,7 +1092,7 @@ Use line numbers if `ps-run-error-line-numbers' is not nil."
1092 1092
1093 1093
1094;; 1094;;
1095(add-hook 'kill-emacs-hook 'ps-run-cleanup) 1095(add-hook 'kill-emacs-hook #'ps-run-cleanup)
1096 1096
1097(provide 'ps-mode) 1097(provide 'ps-mode)
1098 1098
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index e5c15d148f8..30721c7a577 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3385,7 +3385,8 @@ user-friendly message if there's no process running; defaults to
3385t when called interactively." 3385t when called interactively."
3386 (interactive "p") 3386 (interactive "p")
3387 (pop-to-buffer 3387 (pop-to-buffer
3388 (process-buffer (python-shell-get-process-or-error msg)) nil t)) 3388 (process-buffer (python-shell-get-process-or-error msg))
3389 nil 'mark-for-redisplay))
3389 3390
3390(defun python-shell-send-setup-code () 3391(defun python-shell-send-setup-code ()
3391 "Send all setup code for shell. 3392 "Send all setup code for shell.
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index ba59f9c6616..c6bd32a4a4b 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -2967,7 +2967,7 @@ The document is bounded by `sh-here-document-word'."
2967 2967
2968(define-minor-mode sh-electric-here-document-mode 2968(define-minor-mode sh-electric-here-document-mode
2969 "Make << insert a here document skeleton." 2969 "Make << insert a here document skeleton."
2970 nil nil nil 2970 :lighter nil
2971 (if sh-electric-here-document-mode 2971 (if sh-electric-here-document-mode
2972 (add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t) 2972 (add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t)
2973 (remove-hook 'post-self-insert-hook #'sh--maybe-here-document t))) 2973 (remove-hook 'post-self-insert-hook #'sh--maybe-here-document t)))
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6224b3b5f3f..6e53a04f72d 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1545,9 +1545,7 @@ statement. The format of variable should be a valid
1545;; `sql-font-lock-keywords-builder' function and follow the 1545;; `sql-font-lock-keywords-builder' function and follow the
1546;; implementation pattern used for the other products in this file. 1546;; implementation pattern used for the other products in this file.
1547 1547
1548(eval-when-compile 1548(defvar sql-mode-ansi-font-lock-keywords)
1549 (defvar sql-mode-ansi-font-lock-keywords)
1550 (setq sql-mode-ansi-font-lock-keywords nil))
1551 1549
1552(eval-and-compile 1550(eval-and-compile
1553 (defun sql-font-lock-keywords-builder (face boundaries &rest keywords) 1551 (defun sql-font-lock-keywords-builder (face boundaries &rest keywords)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index a7f72950b10..2b88120eb9c 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
9;; Keywords: languages 9;; Keywords: languages
10;; The "Version" is the date followed by the decimal rendition of the Git 10;; The "Version" is the date followed by the decimal rendition of the Git
11;; commit hex. 11;; commit hex.
12;; Version: 2021.03.30.243771231 12;; Version: 2021.04.12.188864585
13 13
14;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this 14;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
15;; file on 19/3/2008, and the maintainer agreed that when a bug is 15;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
124;; 124;;
125 125
126;; This variable will always hold the version number of the mode 126;; This variable will always hold the version number of the mode
127(defconst verilog-mode-version "2021-03-30-e87a75f-vpo-GNU" 127(defconst verilog-mode-version "2021-04-12-b41d849-vpo-GNU"
128 "Version of this Verilog mode.") 128 "Version of this Verilog mode.")
129(defconst verilog-mode-release-emacs t 129(defconst verilog-mode-release-emacs t
130 "If non-nil, this version of Verilog mode was released with Emacs itself.") 130 "If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -3607,7 +3607,7 @@ inserted using a single call to `verilog-insert'."
3607;; More searching 3607;; More searching
3608 3608
3609(defun verilog-declaration-end () 3609(defun verilog-declaration-end ()
3610 (search-forward ";")) 3610 (search-forward ";" nil t))
3611 3611
3612(defun verilog-single-declaration-end (limit) 3612(defun verilog-single-declaration-end (limit)
3613 "Returns pos where current (single) declaration statement ends. 3613 "Returns pos where current (single) declaration statement ends.
@@ -7555,25 +7555,25 @@ will be completed at runtime and should not be added to this list.")
7555TYPE is `module', `tf' for task or function, or t if unknown." 7555TYPE is `module', `tf' for task or function, or t if unknown."
7556 (if (string= verilog-str "") 7556 (if (string= verilog-str "")
7557 (setq verilog-str "[a-zA-Z_]")) 7557 (setq verilog-str "[a-zA-Z_]"))
7558 (let ((verilog-str (concat (cond 7558 (let ((verilog-str
7559 ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") 7559 (concat (cond
7560 ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") 7560 ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +")
7561 (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) 7561 ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
7562 "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) 7562 (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
7563 "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
7563 match) 7564 match)
7564 7565
7565 (if (not (looking-at verilog-defun-re)) 7566 (save-excursion
7566 (verilog-re-search-backward verilog-defun-re nil t)) 7567 (if (not (looking-at verilog-defun-re))
7567 (forward-char 1) 7568 (verilog-re-search-backward verilog-defun-re nil t))
7569 (forward-char 1)
7568 7570
7569 ;; Search through all reachable functions 7571 ;; Search through all reachable functions
7570 (goto-char (point-min)) 7572 (goto-char (point-min))
7571 (while (verilog-re-search-forward verilog-str (point-max) t) 7573 (while (verilog-re-search-forward verilog-str (point-max) t)
7572 (progn (setq match (buffer-substring (match-beginning 2) 7574 (setq match (buffer-substring (match-beginning 2)
7573 (match-end 2))) 7575 (match-end 2)))
7574 (setq verilog-all (cons match verilog-all)))) 7576 (setq verilog-all (cons match verilog-all))))))
7575 (if (match-beginning 0)
7576 (goto-char (match-beginning 0)))))
7577 7577
7578(defun verilog-get-completion-decl (end) 7578(defun verilog-get-completion-decl (end)
7579 "Macro for searching through current declaration (var, type or const) 7579 "Macro for searching through current declaration (var, type or const)
@@ -11561,6 +11561,7 @@ See the example in `verilog-auto-inout-modport'."
11561 11561
11562(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning 11562(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning
11563(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning 11563(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
11564(defvar vl-memory nil "See `verilog-auto-inst'.") ; Prevent compile warning
11564(defvar vl-modport nil "See `verilog-auto-inst'.") ; Prevent compile warning 11565(defvar vl-modport nil "See `verilog-auto-inst'.") ; Prevent compile warning
11565(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning 11566(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
11566(defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning 11567(defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning
@@ -12063,6 +12064,7 @@ Lisp Templates:
12063 vl-width Width of the input/output port (`3' for [2:0]). 12064 vl-width Width of the input/output port (`3' for [2:0]).
12064 May be a (...) expression if bits isn't a constant. 12065 May be a (...) expression if bits isn't a constant.
12065 vl-dir Direction of the pin input/output/inout/interface. 12066 vl-dir Direction of the pin input/output/inout/interface.
12067 vl-memory The unpacked array part of the I/O port (`[5:0]').
12066 vl-modport The modport, if an interface with a modport. 12068 vl-modport The modport, if an interface with a modport.
12067 vl-cell-type Module name/type of the cell (`InstModule'). 12069 vl-cell-type Module name/type of the cell (`InstModule').
12068 vl-cell-name Instance name of the cell (`instName'). 12070 vl-cell-name Instance name of the cell (`instName').
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 856432ccf10..5eeac8af3b8 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,4 +1,4 @@
1;;; vhdl-mode.el --- major mode for editing VHDL code 1;;; vhdl-mode.el --- major mode for editing VHDL code -*- 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
@@ -12,6 +12,9 @@
12;; file on 18/3/2008, and the maintainer agreed that when a bug is 12;; file on 18/3/2008, and the maintainer agreed that when a bug is
13;; filed in the Emacs bug reporting system against this file, a copy 13;; filed in the Emacs bug reporting system against this file, a copy
14;; of the bug report be sent to the maintainer's email address. 14;; of the bug report be sent to the maintainer's email address.
15;;
16;; Reto also said in Apr 2021 that he preferred to keep the XEmacs
17;; compatibility code.
15 18
16(defconst vhdl-version "3.38.1" 19(defconst vhdl-version "3.38.1"
17 "VHDL Mode version number.") 20 "VHDL Mode version number.")
@@ -77,7 +80,7 @@
77;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 80;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
78;; Installation 81;; Installation
79 82
80;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. 83;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21.
81 84
82;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation 85;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
83;; or into an arbitrary directory that is added to the load path by the 86;; or into an arbitrary directory that is added to the load path by the
@@ -92,7 +95,7 @@
92 95
93;; Add the following lines to the `site-start.el' file in the `site-lisp' 96;; Add the following lines to the `site-start.el' file in the `site-lisp'
94;; directory of your Emacs installation or to your Emacs start-up file `.emacs' 97;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
95;; (not required in Emacs 20 and higher): 98;; (not required in Emacs):
96 99
97;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) 100;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
98;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) 101;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
@@ -136,12 +139,9 @@
136(when (< emacs-major-version 25) 139(when (< emacs-major-version 25)
137 (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) 140 (condition-case nil (require 'cl-lib) (file-missing (require 'cl))))
138 141
139;; Emacs 21+ handling
140(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
141 "Non-nil if GNU Emacs 21, 22, ... is used.")
142;; Emacs 22+ handling 142;; Emacs 22+ handling
143(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) 143(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
144 "Non-nil if GNU Emacs 22, ... is used.") 144 "Non-nil if GNU Emacs >= 22, ... is used.")
145 145
146(defvar compilation-file-regexp-alist) 146(defvar compilation-file-regexp-alist)
147(defvar conf-alist) 147(defvar conf-alist)
@@ -490,7 +490,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting
490 (const :tag "Upcase" upcase) 490 (const :tag "Upcase" upcase)
491 (const :tag "Downcase" downcase)))))) 491 (const :tag "Downcase" downcase))))))
492 :set (lambda (variable value) 492 :set (lambda (variable value)
493 (vhdl-custom-set variable value 'vhdl-update-mode-menu)) 493 (vhdl-custom-set variable value #'vhdl-update-mode-menu))
494 :version "24.4" 494 :version "24.4"
495 :group 'vhdl-compile) 495 :group 'vhdl-compile)
496 496
@@ -668,8 +668,8 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project'
668 :format "%t\n%v\n"))) 668 :format "%t\n%v\n")))
669 :set (lambda (variable value) 669 :set (lambda (variable value)
670 (vhdl-custom-set variable value 670 (vhdl-custom-set variable value
671 'vhdl-update-mode-menu 671 #'vhdl-update-mode-menu
672 'vhdl-speedbar-refresh)) 672 #'vhdl-speedbar-refresh))
673 :group 'vhdl-project) 673 :group 'vhdl-project)
674 674
675(defcustom vhdl-project nil 675(defcustom vhdl-project nil
@@ -713,7 +713,7 @@ All project setup files that match the file names specified in option
713\(alphabetically) last loaded setup of the first `vhdl-project-file-name' 713\(alphabetically) last loaded setup of the first `vhdl-project-file-name'
714entry is activated. 714entry is activated.
715A project setup file can be obtained by exporting a project (see menu). 715A project setup file can be obtained by exporting a project (see menu).
716 At startup: project setup file is loaded at Emacs startup" 716 At startup: project setup file is loaded at Emacs startup."
717 :type '(set (const :tag "At startup" startup)) 717 :type '(set (const :tag "At startup" startup))
718 :group 'vhdl-project) 718 :group 'vhdl-project)
719 719
@@ -751,12 +751,12 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
751 (const :tag "Math packages" math))) 751 (const :tag "Math packages" math)))
752 :set (lambda (variable value) 752 :set (lambda (variable value)
753 (vhdl-custom-set variable value 753 (vhdl-custom-set variable value
754 'vhdl-template-map-init 754 #'vhdl-template-map-init
755 'vhdl-mode-abbrev-table-init 755 #'vhdl-mode-abbrev-table-init
756 'vhdl-template-construct-alist-init 756 #'vhdl-template-construct-alist-init
757 'vhdl-template-package-alist-init 757 #'vhdl-template-package-alist-init
758 'vhdl-update-mode-menu 758 #'vhdl-update-mode-menu
759 'vhdl-words-init 'vhdl-font-lock-init)) 759 #'vhdl-words-init 'vhdl-font-lock-init))
760 :group 'vhdl-style) 760 :group 'vhdl-style)
761 761
762(defcustom vhdl-basic-offset 2 762(defcustom vhdl-basic-offset 2
@@ -770,7 +770,7 @@ This value is used by + and - symbols in `vhdl-offsets-alist'."
770This is done when typed or expanded or by the fix case functions." 770This is done when typed or expanded or by the fix case functions."
771 :type 'boolean 771 :type 'boolean
772 :set (lambda (variable value) 772 :set (lambda (variable value)
773 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 773 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
774 :group 'vhdl-style) 774 :group 'vhdl-style)
775 775
776(defcustom vhdl-upper-case-types nil 776(defcustom vhdl-upper-case-types nil
@@ -778,7 +778,7 @@ This is done when typed or expanded or by the fix case functions."
778This is done when expanded or by the fix case functions." 778This is done when expanded or by the fix case functions."
779 :type 'boolean 779 :type 'boolean
780 :set (lambda (variable value) 780 :set (lambda (variable value)
781 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 781 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
782 :group 'vhdl-style) 782 :group 'vhdl-style)
783 783
784(defcustom vhdl-upper-case-attributes nil 784(defcustom vhdl-upper-case-attributes nil
@@ -786,7 +786,7 @@ This is done when expanded or by the fix case functions."
786This is done when expanded or by the fix case functions." 786This is done when expanded or by the fix case functions."
787 :type 'boolean 787 :type 'boolean
788 :set (lambda (variable value) 788 :set (lambda (variable value)
789 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 789 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
790 :group 'vhdl-style) 790 :group 'vhdl-style)
791 791
792(defcustom vhdl-upper-case-enum-values nil 792(defcustom vhdl-upper-case-enum-values nil
@@ -794,7 +794,7 @@ This is done when expanded or by the fix case functions."
794This is done when expanded or by the fix case functions." 794This is done when expanded or by the fix case functions."
795 :type 'boolean 795 :type 'boolean
796 :set (lambda (variable value) 796 :set (lambda (variable value)
797 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 797 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
798 :group 'vhdl-style) 798 :group 'vhdl-style)
799 799
800(defcustom vhdl-upper-case-constants t 800(defcustom vhdl-upper-case-constants t
@@ -802,7 +802,7 @@ This is done when expanded or by the fix case functions."
802This is done when expanded." 802This is done when expanded."
803 :type 'boolean 803 :type 'boolean
804 :set (lambda (variable value) 804 :set (lambda (variable value)
805 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 805 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
806 :group 'vhdl-style) 806 :group 'vhdl-style)
807 807
808(defcustom vhdl-use-direct-instantiation 'standard 808(defcustom vhdl-use-direct-instantiation 'standard
@@ -909,7 +909,7 @@ follows:
909 :type '(set (const :tag "VHDL keywords" vhdl) 909 :type '(set (const :tag "VHDL keywords" vhdl)
910 (const :tag "User model keywords" user)) 910 (const :tag "User model keywords" user))
911 :set (lambda (variable value) 911 :set (lambda (variable value)
912 (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) 912 (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init))
913 :group 'vhdl-template) 913 :group 'vhdl-template)
914 914
915(defcustom vhdl-optional-labels 'process 915(defcustom vhdl-optional-labels 'process
@@ -1192,10 +1192,10 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1192 (string :tag "Keyword " :format "%t: %v\n"))) 1192 (string :tag "Keyword " :format "%t: %v\n")))
1193 :set (lambda (variable value) 1193 :set (lambda (variable value)
1194 (vhdl-custom-set variable value 1194 (vhdl-custom-set variable value
1195 'vhdl-model-map-init 1195 #'vhdl-model-map-init
1196 'vhdl-model-defun 1196 #'vhdl-model-defun
1197 'vhdl-mode-abbrev-table-init 1197 #'vhdl-mode-abbrev-table-init
1198 'vhdl-update-mode-menu)) 1198 #'vhdl-update-mode-menu))
1199 :group 'vhdl-model) 1199 :group 'vhdl-model)
1200 1200
1201 1201
@@ -1598,7 +1598,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1598 entry \"Fontify Buffer\")." 1598 entry \"Fontify Buffer\")."
1599 :type 'boolean 1599 :type 'boolean
1600 :set (lambda (variable value) 1600 :set (lambda (variable value)
1601 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1601 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1602 :group 'vhdl-highlight) 1602 :group 'vhdl-highlight)
1603 1603
1604(defcustom vhdl-highlight-names t 1604(defcustom vhdl-highlight-names t
@@ -1615,7 +1615,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1615 entry \"Fontify Buffer\")." 1615 entry \"Fontify Buffer\")."
1616 :type 'boolean 1616 :type 'boolean
1617 :set (lambda (variable value) 1617 :set (lambda (variable value)
1618 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1618 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1619 :group 'vhdl-highlight) 1619 :group 'vhdl-highlight)
1620 1620
1621(defcustom vhdl-highlight-special-words nil 1621(defcustom vhdl-highlight-special-words nil
@@ -1628,7 +1628,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1628 entry \"Fontify Buffer\")." 1628 entry \"Fontify Buffer\")."
1629 :type 'boolean 1629 :type 'boolean
1630 :set (lambda (variable value) 1630 :set (lambda (variable value)
1631 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1631 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1632 :group 'vhdl-highlight) 1632 :group 'vhdl-highlight)
1633 1633
1634(defcustom vhdl-highlight-forbidden-words nil 1634(defcustom vhdl-highlight-forbidden-words nil
@@ -1643,7 +1643,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1643 :type 'boolean 1643 :type 'boolean
1644 :set (lambda (variable value) 1644 :set (lambda (variable value)
1645 (vhdl-custom-set variable value 1645 (vhdl-custom-set variable value
1646 'vhdl-words-init 'vhdl-font-lock-init)) 1646 #'vhdl-words-init #'vhdl-font-lock-init))
1647 :group 'vhdl-highlight) 1647 :group 'vhdl-highlight)
1648 1648
1649(defcustom vhdl-highlight-verilog-keywords nil 1649(defcustom vhdl-highlight-verilog-keywords nil
@@ -1656,7 +1656,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1656 :type 'boolean 1656 :type 'boolean
1657 :set (lambda (variable value) 1657 :set (lambda (variable value)
1658 (vhdl-custom-set variable value 1658 (vhdl-custom-set variable value
1659 'vhdl-words-init 'vhdl-font-lock-init)) 1659 #'vhdl-words-init #'vhdl-font-lock-init))
1660 :group 'vhdl-highlight) 1660 :group 'vhdl-highlight)
1661 1661
1662(defcustom vhdl-highlight-translate-off nil 1662(defcustom vhdl-highlight-translate-off nil
@@ -1670,7 +1670,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1670 entry \"Fontify Buffer\")." 1670 entry \"Fontify Buffer\")."
1671 :type 'boolean 1671 :type 'boolean
1672 :set (lambda (variable value) 1672 :set (lambda (variable value)
1673 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1673 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1674 :group 'vhdl-highlight) 1674 :group 'vhdl-highlight)
1675 1675
1676(defcustom vhdl-highlight-case-sensitive nil 1676(defcustom vhdl-highlight-case-sensitive nil
@@ -1724,7 +1724,7 @@ NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1724 (string :tag "Color (dark) ") 1724 (string :tag "Color (dark) ")
1725 (boolean :tag "In comments "))) 1725 (boolean :tag "In comments ")))
1726 :set (lambda (variable value) 1726 :set (lambda (variable value)
1727 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1727 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1728 :group 'vhdl-highlight) 1728 :group 'vhdl-highlight)
1729 1729
1730(defcustom vhdl-forbidden-words '() 1730(defcustom vhdl-forbidden-words '()
@@ -1737,7 +1737,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1737 :type '(repeat (string :format "%v")) 1737 :type '(repeat (string :format "%v"))
1738 :set (lambda (variable value) 1738 :set (lambda (variable value)
1739 (vhdl-custom-set variable value 1739 (vhdl-custom-set variable value
1740 'vhdl-words-init 'vhdl-font-lock-init)) 1740 #'vhdl-words-init #'vhdl-font-lock-init))
1741 :group 'vhdl-highlight) 1741 :group 'vhdl-highlight)
1742 1742
1743(defcustom vhdl-forbidden-syntax "" 1743(defcustom vhdl-forbidden-syntax ""
@@ -1752,7 +1752,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1752 :type 'regexp 1752 :type 'regexp
1753 :set (lambda (variable value) 1753 :set (lambda (variable value)
1754 (vhdl-custom-set variable value 1754 (vhdl-custom-set variable value
1755 'vhdl-words-init 'vhdl-font-lock-init)) 1755 #'vhdl-words-init #'vhdl-font-lock-init))
1756 :group 'vhdl-highlight) 1756 :group 'vhdl-highlight)
1757 1757
1758(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") 1758(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
@@ -1763,7 +1763,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1763 :type '(repeat (string :format "%v")) 1763 :type '(repeat (string :format "%v"))
1764 :set (lambda (variable value) 1764 :set (lambda (variable value)
1765 (vhdl-custom-set variable value 1765 (vhdl-custom-set variable value
1766 'vhdl-words-init 'vhdl-font-lock-init)) 1766 #'vhdl-words-init #'vhdl-font-lock-init))
1767 :group 'vhdl-highlight) 1767 :group 'vhdl-highlight)
1768 1768
1769 1769
@@ -2238,11 +2238,11 @@ Ignore byte-compiler warnings you might see."
2238; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") 2238; (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
2239 (defun regexp-opt (strings &optional paren) 2239 (defun regexp-opt (strings &optional paren)
2240 (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) 2240 (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
2241 (concat open (mapconcat 'regexp-quote strings "\\|") close)))) 2241 (concat open (mapconcat #'regexp-quote strings "\\|") close))))
2242 2242
2243;; `match-string-no-properties' undefined (XEmacs, what else?) 2243;; `match-string-no-properties' undefined (XEmacs, what else?)
2244(unless (fboundp 'match-string-no-properties) 2244(unless (fboundp 'match-string-no-properties)
2245 (defalias 'match-string-no-properties 'match-string)) 2245 (defalias 'match-string-no-properties #'match-string))
2246 2246
2247;; `subst-char-in-string' undefined (XEmacs) 2247;; `subst-char-in-string' undefined (XEmacs)
2248(unless (fboundp 'subst-char-in-string) 2248(unless (fboundp 'subst-char-in-string)
@@ -2269,7 +2269,7 @@ Ignore byte-compiler warnings you might see."
2269 (let* ((nondir (file-name-nondirectory pattern)) 2269 (let* ((nondir (file-name-nondirectory pattern))
2270 (dirpart (file-name-directory pattern)) 2270 (dirpart (file-name-directory pattern))
2271 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) 2271 (dirs (if (and dirpart (string-match "[[*?]" dirpart))
2272 (mapcar 'file-name-as-directory 2272 (mapcar #'file-name-as-directory
2273 (file-expand-wildcards (directory-file-name dirpart))) 2273 (file-expand-wildcards (directory-file-name dirpart)))
2274 (list dirpart))) 2274 (list dirpart)))
2275 contents) 2275 contents)
@@ -2296,7 +2296,7 @@ Ignore byte-compiler warnings you might see."
2296 2296
2297;; `member-ignore-case' undefined (XEmacs) 2297;; `member-ignore-case' undefined (XEmacs)
2298(unless (fboundp 'member-ignore-case) 2298(unless (fboundp 'member-ignore-case)
2299 (defalias 'member-ignore-case 'member)) 2299 (defalias 'member-ignore-case #'member))
2300 2300
2301;; `last-input-char' obsolete in Emacs 24, `last-input-event' different 2301;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
2302;; behavior in XEmacs 2302;; behavior in XEmacs
@@ -2495,6 +2495,7 @@ current buffer if no project is defined."
2495 "Enable case insensitive search and switch to syntax table that includes `_', 2495 "Enable case insensitive search and switch to syntax table that includes `_',
2496then execute BODY, and finally restore the old environment. Used for 2496then execute BODY, and finally restore the old environment. Used for
2497consistent searching." 2497consistent searching."
2498 (declare (debug t))
2498 `(let ((case-fold-search t)) ; case insensitive search 2499 `(let ((case-fold-search t)) ; case insensitive search
2499 ;; use extended syntax table 2500 ;; use extended syntax table
2500 (with-syntax-table vhdl-mode-ext-syntax-table 2501 (with-syntax-table vhdl-mode-ext-syntax-table
@@ -2504,55 +2505,59 @@ consistent searching."
2504 "Enable case insensitive search, switch to syntax table that includes `_', 2505 "Enable case insensitive search, switch to syntax table that includes `_',
2505arrange to ignore `intangible' overlays, then execute BODY, and finally restore 2506arrange to ignore `intangible' overlays, then execute BODY, and finally restore
2506the old environment. Used for consistent searching." 2507the old environment. Used for consistent searching."
2508 (declare (debug t))
2507 `(let ((case-fold-search t) ; case insensitive search 2509 `(let ((case-fold-search t) ; case insensitive search
2508 (current-syntax-table (syntax-table))
2509 (inhibit-point-motion-hooks t)) 2510 (inhibit-point-motion-hooks t))
2510 ;; use extended syntax table 2511 ;; use extended syntax table
2511 (set-syntax-table vhdl-mode-ext-syntax-table) 2512 (with-syntax-table vhdl-mode-ext-syntax-table
2512 ;; execute BODY safely 2513 ;; execute BODY safely
2513 (unwind-protect 2514 (progn ,@body))))
2514 (progn ,@body)
2515 ;; restore syntax table
2516 (set-syntax-table current-syntax-table))))
2517 2515
2518(defmacro vhdl-visit-file (file-name issue-error &rest body) 2516(defmacro vhdl-visit-file (file-name issue-error &rest body)
2519 "Visit file FILE-NAME and execute BODY." 2517 "Visit file FILE-NAME and execute BODY."
2520 `(if (null ,file-name) 2518 (declare (debug t) (indent 2))
2521 (progn ,@body) 2519 `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body)))
2522 (unless (file-directory-p ,file-name) 2520
2523 (let ((source-buffer (current-buffer)) 2521(defun vhdl--visit-file (file-name issue-error body-fun)
2524 (visiting-buffer (find-buffer-visiting ,file-name)) 2522 (if (null file-name)
2525 file-opened) 2523 (funcall body-fun)
2526 (when (or (and visiting-buffer (set-buffer visiting-buffer)) 2524 (unless (file-directory-p file-name)
2527 (condition-case () 2525 (let ((source-buffer (current-buffer))
2528 (progn (set-buffer (create-file-buffer ,file-name)) 2526 (visiting-buffer (find-buffer-visiting file-name))
2529 (setq file-opened t) 2527 file-opened)
2530 (vhdl-insert-file-contents ,file-name) 2528 (when (or (and visiting-buffer (set-buffer visiting-buffer))
2531 ;; FIXME: This modifies a global syntax-table! 2529 (condition-case ()
2532 (modify-syntax-entry ?\- ". 12" (syntax-table)) 2530 (progn (set-buffer (create-file-buffer file-name))
2533 (modify-syntax-entry ?\n ">" (syntax-table)) 2531 (setq file-opened t)
2534 (modify-syntax-entry ?\^M ">" (syntax-table)) 2532 (vhdl-insert-file-contents file-name)
2535 (modify-syntax-entry ?_ "w" (syntax-table)) 2533 (let ((st (copy-syntax-table (syntax-table))))
2536 t) 2534 (modify-syntax-entry ?\- ". 12" st)
2537 (error 2535 (modify-syntax-entry ?\n ">" st)
2538 (if ,issue-error 2536 (modify-syntax-entry ?\^M ">" st)
2539 (progn 2537 (modify-syntax-entry ?_ "w" st)
2540 (when file-opened (kill-buffer (current-buffer))) 2538 ;; FIXME: We should arguably reset the
2541 (set-buffer source-buffer) 2539 ;; syntax-table after running `body-fun'.
2542 (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) 2540 (set-syntax-table st))
2543 (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) 2541 t)
2544 nil)))) 2542 (error
2545 (condition-case info 2543 (if issue-error
2546 (progn ,@body) 2544 (progn
2547 (error 2545 (when file-opened (kill-buffer (current-buffer)))
2548 (if ,issue-error 2546 (set-buffer source-buffer)
2549 (progn 2547 (error "ERROR: File cannot be opened: \"%s\"" file-name))
2550 (when file-opened (kill-buffer (current-buffer))) 2548 (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t)
2551 (set-buffer source-buffer) 2549 nil))))
2552 (error (cadr info))) 2550 (condition-case info
2553 (vhdl-warning (cadr info)))))) 2551 (funcall body-fun)
2554 (when file-opened (kill-buffer (current-buffer))) 2552 (error
2555 (set-buffer source-buffer))))) 2553 (if issue-error
2554 (progn
2555 (when file-opened (kill-buffer (current-buffer)))
2556 (set-buffer source-buffer)
2557 (error (cadr info)))
2558 (vhdl-warning (cadr info))))))
2559 (when file-opened (kill-buffer (current-buffer)))
2560 (set-buffer source-buffer)))))
2556 2561
2557(defun vhdl-insert-file-contents (filename) 2562(defun vhdl-insert-file-contents (filename)
2558 "Nicked from `insert-file-contents-literally', but allow coding system 2563 "Nicked from `insert-file-contents-literally', but allow coding system
@@ -2600,7 +2605,7 @@ conversion."
2600 "Refresh directory or project with name KEY." 2605 "Refresh directory or project with name KEY."
2601 (when (and (boundp 'speedbar-frame) 2606 (when (and (boundp 'speedbar-frame)
2602 (frame-live-p speedbar-frame)) 2607 (frame-live-p speedbar-frame))
2603 (let ((pos (point)) 2608 (let (;; (pos (point))
2604 (last-frame (selected-frame))) 2609 (last-frame (selected-frame)))
2605 (if (null key) 2610 (if (null key)
2606 (speedbar-refresh) 2611 (speedbar-refresh)
@@ -2677,96 +2682,96 @@ elements > `vhdl-menu-max-size'."
2677 "Initialize `vhdl-template-map'." 2682 "Initialize `vhdl-template-map'."
2678 (setq vhdl-template-map (make-sparse-keymap)) 2683 (setq vhdl-template-map (make-sparse-keymap))
2679 ;; key bindings for VHDL templates 2684 ;; key bindings for VHDL templates
2680 (define-key vhdl-template-map "al" 'vhdl-template-alias) 2685 (define-key vhdl-template-map "al" #'vhdl-template-alias)
2681 (define-key vhdl-template-map "ar" 'vhdl-template-architecture) 2686 (define-key vhdl-template-map "ar" #'vhdl-template-architecture)
2682 (define-key vhdl-template-map "at" 'vhdl-template-assert) 2687 (define-key vhdl-template-map "at" #'vhdl-template-assert)
2683 (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) 2688 (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl)
2684 (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) 2689 (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec)
2685 (define-key vhdl-template-map "bl" 'vhdl-template-block) 2690 (define-key vhdl-template-map "bl" #'vhdl-template-block)
2686 (define-key vhdl-template-map "ca" 'vhdl-template-case-is) 2691 (define-key vhdl-template-map "ca" #'vhdl-template-case-is)
2687 (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) 2692 (define-key vhdl-template-map "cd" #'vhdl-template-component-decl)
2688 (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) 2693 (define-key vhdl-template-map "ci" #'vhdl-template-component-inst)
2689 (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) 2694 (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst)
2690 (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) 2695 (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration)
2691 (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) 2696 (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf)
2692 (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) 2697 (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl)
2693 (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) 2698 (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec)
2694 (define-key vhdl-template-map "co" 'vhdl-template-constant) 2699 (define-key vhdl-template-map "co" #'vhdl-template-constant)
2695 (define-key vhdl-template-map "ct" 'vhdl-template-context) 2700 (define-key vhdl-template-map "ct" #'vhdl-template-context)
2696 (define-key vhdl-template-map "di" 'vhdl-template-disconnect) 2701 (define-key vhdl-template-map "di" #'vhdl-template-disconnect)
2697 (define-key vhdl-template-map "el" 'vhdl-template-else) 2702 (define-key vhdl-template-map "el" #'vhdl-template-else)
2698 (define-key vhdl-template-map "ei" 'vhdl-template-elsif) 2703 (define-key vhdl-template-map "ei" #'vhdl-template-elsif)
2699 (define-key vhdl-template-map "en" 'vhdl-template-entity) 2704 (define-key vhdl-template-map "en" #'vhdl-template-entity)
2700 (define-key vhdl-template-map "ex" 'vhdl-template-exit) 2705 (define-key vhdl-template-map "ex" #'vhdl-template-exit)
2701 (define-key vhdl-template-map "fi" 'vhdl-template-file) 2706 (define-key vhdl-template-map "fi" #'vhdl-template-file)
2702 (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) 2707 (define-key vhdl-template-map "fg" #'vhdl-template-for-generate)
2703 (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) 2708 (define-key vhdl-template-map "fl" #'vhdl-template-for-loop)
2704 (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) 2709 (define-key vhdl-template-map "\C-f" #'vhdl-template-footer)
2705 (define-key vhdl-template-map "fb" 'vhdl-template-function-body) 2710 (define-key vhdl-template-map "fb" #'vhdl-template-function-body)
2706 (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) 2711 (define-key vhdl-template-map "fd" #'vhdl-template-function-decl)
2707 (define-key vhdl-template-map "ge" 'vhdl-template-generic) 2712 (define-key vhdl-template-map "ge" #'vhdl-template-generic)
2708 (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) 2713 (define-key vhdl-template-map "gd" #'vhdl-template-group-decl)
2709 (define-key vhdl-template-map "gt" 'vhdl-template-group-template) 2714 (define-key vhdl-template-map "gt" #'vhdl-template-group-template)
2710 (define-key vhdl-template-map "\C-h" 'vhdl-template-header) 2715 (define-key vhdl-template-map "\C-h" #'vhdl-template-header)
2711 (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) 2716 (define-key vhdl-template-map "ig" #'vhdl-template-if-generate)
2712 (define-key vhdl-template-map "it" 'vhdl-template-if-then) 2717 (define-key vhdl-template-map "it" #'vhdl-template-if-then)
2713 (define-key vhdl-template-map "li" 'vhdl-template-library) 2718 (define-key vhdl-template-map "li" #'vhdl-template-library)
2714 (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) 2719 (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop)
2715 (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) 2720 (define-key vhdl-template-map "\C-m" #'vhdl-template-modify)
2716 (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) 2721 (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date)
2717 (define-key vhdl-template-map "ma" 'vhdl-template-map) 2722 (define-key vhdl-template-map "ma" #'vhdl-template-map)
2718 (define-key vhdl-template-map "ne" 'vhdl-template-next) 2723 (define-key vhdl-template-map "ne" #'vhdl-template-next)
2719 (define-key vhdl-template-map "ot" 'vhdl-template-others) 2724 (define-key vhdl-template-map "ot" #'vhdl-template-others)
2720 (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) 2725 (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl)
2721 (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) 2726 (define-key vhdl-template-map "Pb" #'vhdl-template-package-body)
2722 (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) 2727 (define-key vhdl-template-map "(" #'vhdl-template-paired-parens)
2723 (define-key vhdl-template-map "po" 'vhdl-template-port) 2728 (define-key vhdl-template-map "po" #'vhdl-template-port)
2724 (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) 2729 (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body)
2725 (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) 2730 (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl)
2726 (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) 2731 (define-key vhdl-template-map "pc" #'vhdl-template-process-comb)
2727 (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) 2732 (define-key vhdl-template-map "ps" #'vhdl-template-process-seq)
2728 (define-key vhdl-template-map "rp" 'vhdl-template-report) 2733 (define-key vhdl-template-map "rp" #'vhdl-template-report)
2729 (define-key vhdl-template-map "rt" 'vhdl-template-return) 2734 (define-key vhdl-template-map "rt" #'vhdl-template-return)
2730 (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) 2735 (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst)
2731 (define-key vhdl-template-map "si" 'vhdl-template-signal) 2736 (define-key vhdl-template-map "si" #'vhdl-template-signal)
2732 (define-key vhdl-template-map "su" 'vhdl-template-subtype) 2737 (define-key vhdl-template-map "su" #'vhdl-template-subtype)
2733 (define-key vhdl-template-map "ty" 'vhdl-template-type) 2738 (define-key vhdl-template-map "ty" #'vhdl-template-type)
2734 (define-key vhdl-template-map "us" 'vhdl-template-use) 2739 (define-key vhdl-template-map "us" #'vhdl-template-use)
2735 (define-key vhdl-template-map "va" 'vhdl-template-variable) 2740 (define-key vhdl-template-map "va" #'vhdl-template-variable)
2736 (define-key vhdl-template-map "wa" 'vhdl-template-wait) 2741 (define-key vhdl-template-map "wa" #'vhdl-template-wait)
2737 (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) 2742 (define-key vhdl-template-map "wl" #'vhdl-template-while-loop)
2738 (define-key vhdl-template-map "wi" 'vhdl-template-with) 2743 (define-key vhdl-template-map "wi" #'vhdl-template-with)
2739 (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) 2744 (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait)
2740 (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) 2745 (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit)
2741 (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) 2746 (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std)
2742 (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) 2747 (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164)
2743 (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) 2748 (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith)
2744 (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) 2749 (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc)
2745 (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) 2750 (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed)
2746 (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) 2751 (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio)
2747 (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) 2752 (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned)
2748 (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) 2753 (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio)
2749 (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) 2754 (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on)
2750 (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) 2755 (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off)
2751 (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) 2756 (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on)
2752 (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) 2757 (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off)
2753 (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) 2758 (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt)
2754 (when (vhdl-standard-p 'ams) 2759 (when (vhdl-standard-p 'ams)
2755 (define-key vhdl-template-map "br" 'vhdl-template-break) 2760 (define-key vhdl-template-map "br" #'vhdl-template-break)
2756 (define-key vhdl-template-map "cu" 'vhdl-template-case-use) 2761 (define-key vhdl-template-map "cu" #'vhdl-template-case-use)
2757 (define-key vhdl-template-map "iu" 'vhdl-template-if-use) 2762 (define-key vhdl-template-map "iu" #'vhdl-template-if-use)
2758 (define-key vhdl-template-map "lm" 'vhdl-template-limit) 2763 (define-key vhdl-template-map "lm" #'vhdl-template-limit)
2759 (define-key vhdl-template-map "na" 'vhdl-template-nature) 2764 (define-key vhdl-template-map "na" #'vhdl-template-nature)
2760 (define-key vhdl-template-map "pa" 'vhdl-template-procedural) 2765 (define-key vhdl-template-map "pa" #'vhdl-template-procedural)
2761 (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) 2766 (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free)
2762 (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) 2767 (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch)
2763 (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) 2768 (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source)
2764 (define-key vhdl-template-map "sn" 'vhdl-template-subnature) 2769 (define-key vhdl-template-map "sn" #'vhdl-template-subnature)
2765 (define-key vhdl-template-map "te" 'vhdl-template-terminal) 2770 (define-key vhdl-template-map "te" #'vhdl-template-terminal)
2766 ) 2771 )
2767 (when (vhdl-standard-p 'math) 2772 (when (vhdl-standard-p 'math)
2768 (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) 2773 (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex)
2769 (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) 2774 (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real)
2770 )) 2775 ))
2771 2776
2772;; initialize template map for VHDL Mode 2777;; initialize template map for VHDL Mode
@@ -2812,119 +2817,120 @@ STRING are replaced by `-' and substrings are converted to lower case."
2812 ;; model key bindings 2817 ;; model key bindings
2813 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) 2818 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map)
2814 ;; standard key bindings 2819 ;; standard key bindings
2815 (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) 2820 (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement)
2816 (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) 2821 (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement)
2817 (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) 2822 (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp)
2818 (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) 2823 (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp)
2819 (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) 2824 (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list)
2820 (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) 2825 (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent)
2821 (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) 2826 (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent)
2822 (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs 2827 (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
2823 (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) 2828 (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun))
2824 (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) 2829 (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp)
2825 (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) 2830 (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation)
2826 ;; mode specific key bindings 2831 ;; mode specific key bindings
2827 (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) 2832 (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode)
2828 (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) 2833 (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode)
2829 (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) 2834 (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project)
2830 (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) 2835 (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project)
2831 (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) 2836 (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project)
2832 (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) 2837 (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project)
2833 (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) 2838 (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler)
2834 (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) 2839 (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile)
2835 (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) 2840 (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make)
2836 (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) 2841 (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile)
2837 (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) 2842 (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy)
2838 (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) 2843 (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy)
2839 (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) 2844 (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity)
2840 (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) 2845 (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component)
2841 (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) 2846 (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance)
2842 (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) 2847 (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals)
2843 (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) 2848 (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants)
2844 (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs 2849 (define-key vhdl-mode-map
2845 (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) 2850 ;; `... C-g' not allowed in XEmacs.
2846 (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) 2851 (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g")
2847 (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) 2852 #'vhdl-port-paste-generic-map)
2848 (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) 2853 (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations)
2849 (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) 2854 (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench)
2850 (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) 2855 (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten)
2851 (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) 2856 (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction)
2852 (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) 2857 (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy)
2853 (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) 2858 (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy)
2854 (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) 2859 (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration)
2855 (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) 2860 (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body)
2856 (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) 2861 (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call)
2857 (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) 2862 (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten)
2858 (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) 2863 (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component)
2859 (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) 2864 (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component)
2860 (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) 2865 (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components)
2861 (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) 2866 (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration)
2862 (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) 2867 (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package)
2863 (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) 2868 (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region)
2864 (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) 2869 (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline)
2865 (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) 2870 (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line)
2866 (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) 2871 (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode)
2867 (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) 2872 (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group)
2868 (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) 2873 (define-key vhdl-mode-map "\M-\C-\\" #'indent-region)
2869 (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) 2874 (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer)
2870 (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) 2875 (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group)
2871 (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) 2876 (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group)
2872 (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) 2877 (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent)
2873 (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) 2878 (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list)
2874 (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) 2879 (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations)
2875 (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) 2880 (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region)
2876 (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) 2881 (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer)
2877 (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) 2882 (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group)
2878 (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) 2883 (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region)
2879 (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) 2884 (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list)
2880 (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) 2885 (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list)
2881 (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) 2886 (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group)
2882 (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) 2887 (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent)
2883 (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) 2888 (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region)
2884 (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) 2889 (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill)
2885 (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) 2890 (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy)
2886 (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) 2891 (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank)
2887 (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) 2892 (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand)
2888 (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) 2893 (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next)
2889 (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) 2894 (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous)
2890 (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) 2895 (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open)
2891 (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) 2896 (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line)
2892 (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) 2897 (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line)
2893 (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) 2898 (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region)
2894 (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) 2899 (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer)
2895 (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) 2900 (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause)
2896 (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) 2901 (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region)
2897 (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) 2902 (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer)
2898 (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) 2903 (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region)
2899 (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) 2904 (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer)
2900 (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) 2905 (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region)
2901 (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) 2906 (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer)
2902 (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) 2907 (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process)
2903 (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) 2908 (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer)
2904 (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) 2909 (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer)
2905 (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) 2910 (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer)
2906 (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) 2911 (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages)
2907 (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) 2912 (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode)
2908 (define-key vhdl-mode-map "\M-\t" 'insert-tab) 2913 (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version)
2914 (define-key vhdl-mode-map "\M-\t" #'insert-tab)
2909 ;; insert commands bindings 2915 ;; insert commands bindings
2910 (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) 2916 (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct)
2911 (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) 2917 (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package)
2912 (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) 2918 (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive)
2913 (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) 2919 (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert)
2914 ;; electric key bindings 2920 ;; electric key bindings
2915 (define-key vhdl-mode-map " " 'vhdl-electric-space) 2921 (define-key vhdl-mode-map " " #'vhdl-electric-space)
2916 (when vhdl-intelligent-tab 2922 (when vhdl-intelligent-tab
2917 (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) 2923 (define-key vhdl-mode-map "\t" #'vhdl-electric-tab))
2918 (define-key vhdl-mode-map "\r" 'vhdl-electric-return) 2924 (define-key vhdl-mode-map "\r" #'vhdl-electric-return)
2919 (define-key vhdl-mode-map "-" 'vhdl-electric-dash) 2925 (define-key vhdl-mode-map "-" #'vhdl-electric-dash)
2920 (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) 2926 (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket)
2921 (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) 2927 (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket)
2922 (define-key vhdl-mode-map "'" 'vhdl-electric-quote) 2928 (define-key vhdl-mode-map "'" #'vhdl-electric-quote)
2923 (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) 2929 (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon)
2924 (define-key vhdl-mode-map "," 'vhdl-electric-comma) 2930 (define-key vhdl-mode-map "," #'vhdl-electric-comma)
2925 (define-key vhdl-mode-map "." 'vhdl-electric-period) 2931 (define-key vhdl-mode-map "." #'vhdl-electric-period)
2926 (when (vhdl-standard-p 'ams) 2932 (when (vhdl-standard-p 'ams)
2927 (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) 2933 (define-key vhdl-mode-map "=" #'vhdl-electric-equal)))
2928 2934
2929;; initialize mode map for VHDL Mode 2935;; initialize mode map for VHDL Mode
2930(vhdl-mode-map-init) 2936(vhdl-mode-map-init)
@@ -2935,7 +2941,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
2935 (let ((map (make-sparse-keymap))) 2941 (let ((map (make-sparse-keymap)))
2936 (set-keymap-parent map minibuffer-local-map) 2942 (set-keymap-parent map minibuffer-local-map)
2937 (when vhdl-word-completion-in-minibuffer 2943 (when vhdl-word-completion-in-minibuffer
2938 (define-key map "\t" 'vhdl-minibuffer-tab)) 2944 (define-key map "\t" #'vhdl-minibuffer-tab))
2939 map) 2945 map)
2940 "Keymap for minibuffer used in VHDL Mode.") 2946 "Keymap for minibuffer used in VHDL Mode.")
2941 2947
@@ -3168,7 +3174,8 @@ STRING are replaced by `-' and substrings are converted to lower case."
3168 (unless (equal keyword "") 3174 (unless (equal keyword "")
3169 (push (list keyword "" 3175 (push (list keyword ""
3170 (vhdl-function-name 3176 (vhdl-function-name
3171 "vhdl-model" (nth 0 elem) "hook") 0 'system) 3177 "vhdl-model" (nth 0 elem) "hook")
3178 0 'system)
3172 abbrev-list))) 3179 abbrev-list)))
3173 abbrev-list))))) 3180 abbrev-list)))))
3174 3181
@@ -3575,7 +3582,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
3575 ("Indent" 3582 ("Indent"
3576 ["Line" indent-according-to-mode :keys "C-c C-i C-l"] 3583 ["Line" indent-according-to-mode :keys "C-c C-i C-l"]
3577 ["Group" vhdl-indent-group :keys "C-c C-i C-g"] 3584 ["Group" vhdl-indent-group :keys "C-c C-i C-g"]
3578 ["Region" vhdl-indent-region (mark)] 3585 ["Region" indent-region (mark)]
3579 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) 3586 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"])
3580 ("Align" 3587 ("Align"
3581 ["Group" vhdl-align-group t] 3588 ["Group" vhdl-align-group t]
@@ -4885,7 +4892,7 @@ Key bindings:
4885 (set (make-local-variable 'paragraph-separate) paragraph-start) 4892 (set (make-local-variable 'paragraph-separate) paragraph-start)
4886 (set (make-local-variable 'paragraph-ignore-fill-prefix) t) 4893 (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
4887 (set (make-local-variable 'parse-sexp-ignore-comments) t) 4894 (set (make-local-variable 'parse-sexp-ignore-comments) t)
4888 (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) 4895 (set (make-local-variable 'indent-line-function) #'vhdl-indent-line)
4889 (set (make-local-variable 'comment-start) "--") 4896 (set (make-local-variable 'comment-start) "--")
4890 (set (make-local-variable 'comment-end) "") 4897 (set (make-local-variable 'comment-end) "")
4891 (set (make-local-variable 'comment-column) vhdl-inline-comment-column) 4898 (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
@@ -4898,13 +4905,13 @@ Key bindings:
4898 ;; setup the comment indent variable in an Emacs version portable way 4905 ;; setup the comment indent variable in an Emacs version portable way
4899 ;; ignore any byte compiler warnings you might get here 4906 ;; ignore any byte compiler warnings you might get here
4900 (when (boundp 'comment-indent-function) 4907 (when (boundp 'comment-indent-function)
4901 (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) 4908 (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent))
4902 4909
4903 ;; initialize font locking 4910 ;; initialize font locking
4904 (set (make-local-variable 'font-lock-defaults) 4911 (set (make-local-variable 'font-lock-defaults)
4905 (list 4912 (list
4906 '(nil vhdl-font-lock-keywords) nil 4913 '(nil vhdl-font-lock-keywords) nil
4907 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) 4914 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line))
4908 (if (eval-when-compile (fboundp 'syntax-propertize-rules)) 4915 (if (eval-when-compile (fboundp 'syntax-propertize-rules))
4909 (set (make-local-variable 'syntax-propertize-function) 4916 (set (make-local-variable 'syntax-propertize-function)
4910 (syntax-propertize-rules 4917 (syntax-propertize-rules
@@ -4913,7 +4920,7 @@ Key bindings:
4913 ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) 4920 ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
4914 (set (make-local-variable 'font-lock-syntactic-keywords) 4921 (set (make-local-variable 'font-lock-syntactic-keywords)
4915 vhdl-font-lock-syntactic-keywords)) 4922 vhdl-font-lock-syntactic-keywords))
4916 (unless vhdl-emacs-21 4923 (when (featurep 'xemacs)
4917 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) 4924 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4918 (set (make-local-variable 'lazy-lock-defer-contextually) nil) 4925 (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4919 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) 4926 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
@@ -4959,10 +4966,10 @@ Key bindings:
4959(defun vhdl-write-file-hooks-init () 4966(defun vhdl-write-file-hooks-init ()
4960 "Add/remove hooks when buffer is saved." 4967 "Add/remove hooks when buffer is saved."
4961 (if vhdl-modify-date-on-saving 4968 (if vhdl-modify-date-on-saving
4962 (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) 4969 (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t)
4963 (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t)) 4970 (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t))
4964 (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) 4971 (if (featurep 'xemacs) (make-local-hook 'after-save-hook))
4965 (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) 4972 (add-hook 'after-save-hook #'vhdl-add-modified-file nil t))
4966 4973
4967(defun vhdl-process-command-line-option (option) 4974(defun vhdl-process-command-line-option (option)
4968 "Process command line options for VHDL Mode." 4975 "Process command line options for VHDL Mode."
@@ -5745,7 +5752,7 @@ negative, skip forward otherwise."
5745 5752
5746;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ 5753;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5747(unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) 5754(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
5748 (defalias 'vhdl-forward-comment 'forward-comment)) 5755 (defalias 'vhdl-forward-comment #'forward-comment))
5749 5756
5750(defun vhdl-back-to-indentation () 5757(defun vhdl-back-to-indentation ()
5751 "Move point to the first non-whitespace character on this line." 5758 "Move point to the first non-whitespace character on this line."
@@ -5809,7 +5816,7 @@ negative, skip forward otherwise."
5809 state))) 5816 state)))
5810 5817
5811(and (string-match "Win-Emacs" emacs-version) 5818(and (string-match "Win-Emacs" emacs-version)
5812 (fset 'vhdl-in-literal 'vhdl-win-il)) 5819 (fset 'vhdl-in-literal #'vhdl-win-il))
5813 5820
5814;; Skipping of "syntactic whitespace". Syntactic whitespace is 5821;; Skipping of "syntactic whitespace". Syntactic whitespace is
5815;; defined as lexical whitespace or comments. Search no farther back 5822;; defined as lexical whitespace or comments. Search no farther back
@@ -5847,9 +5854,9 @@ negative, skip forward otherwise."
5847 (t (setq stop t)))))) 5854 (t (setq stop t))))))
5848 5855
5849(and (string-match "Win-Emacs" emacs-version) 5856(and (string-match "Win-Emacs" emacs-version)
5850 (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) 5857 (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws))
5851 5858
5852(defun vhdl-beginning-of-macro (&optional lim) 5859(defun vhdl-beginning-of-macro (&optional _lim)
5853 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." 5860 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
5854 (let ((here (point))) 5861 (let ((here (point)))
5855 (beginning-of-line) 5862 (beginning-of-line)
@@ -5862,7 +5869,7 @@ negative, skip forward otherwise."
5862 (goto-char here) 5869 (goto-char here)
5863 nil))) 5870 nil)))
5864 5871
5865(defun vhdl-beginning-of-directive (&optional lim) 5872(defun vhdl-beginning-of-directive (&optional _lim)
5866 "Go to the beginning of a directive (nicked from `cc-engine')." 5873 "Go to the beginning of a directive (nicked from `cc-engine')."
5867 (let ((here (point))) 5874 (let ((here (point)))
5868 (beginning-of-line) 5875 (beginning-of-line)
@@ -5906,7 +5913,7 @@ negative, skip forward otherwise."
5906 (t (setq stop t)))))) 5913 (t (setq stop t))))))
5907 5914
5908(and (string-match "Win-Emacs" emacs-version) 5915(and (string-match "Win-Emacs" emacs-version)
5909 (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) 5916 (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws))
5910 5917
5911;; Functions to help finding the correct indentation column: 5918;; Functions to help finding the correct indentation column:
5912 5919
@@ -6054,7 +6061,7 @@ keyword."
6054 t) 6061 t)
6055 )) 6062 ))
6056 6063
6057(defun vhdl-corresponding-mid (&optional lim) 6064(defun vhdl-corresponding-mid (&optional _lim)
6058 (cond 6065 (cond
6059 ((looking-at "is\\|block\\|generate\\|process\\|procedural") 6066 ((looking-at "is\\|block\\|generate\\|process\\|procedural")
6060 "begin") 6067 "begin")
@@ -6270,7 +6277,7 @@ of an identifier that just happens to contain an \"end\" keyword."
6270 "A regular expression for searching backward that matches all known 6277 "A regular expression for searching backward that matches all known
6271\"statement\" keywords.") 6278\"statement\" keywords.")
6272 6279
6273(defun vhdl-statement-p (&optional lim) 6280(defun vhdl-statement-p (&optional _lim)
6274 "Return t if we are looking at a real \"statement\" keyword. 6281 "Return t if we are looking at a real \"statement\" keyword.
6275Assumes that the caller will make sure that we are looking at 6282Assumes that the caller will make sure that we are looking at
6276vhdl-statement-fwd-re, and are not inside a literal, and that we are not 6283vhdl-statement-fwd-re, and are not inside a literal, and that we are not
@@ -6462,7 +6469,7 @@ searches."
6462 ;; internal-p controls where the statement keyword can 6469 ;; internal-p controls where the statement keyword can
6463 ;; be found. 6470 ;; be found.
6464 (internal-p (aref begin-vec 3)) 6471 (internal-p (aref begin-vec 3))
6465 (last-backward (point)) last-forward 6472 (last-backward (point)) ;; last-forward
6466 foundp literal keyword) 6473 foundp literal keyword)
6467 ;; Look for the statement keyword. 6474 ;; Look for the statement keyword.
6468 (while (and (not foundp) 6475 (while (and (not foundp)
@@ -6497,7 +6504,7 @@ searches."
6497 (setq begin-re 6504 (setq begin-re
6498 (concat "\\b\\(" begin-re "\\)\\b[^_]")) 6505 (concat "\\b\\(" begin-re "\\)\\b[^_]"))
6499 (save-excursion 6506 (save-excursion
6500 (setq last-forward (point)) 6507 ;; (setq last-forward (point))
6501 ;; Look for the supplementary keyword 6508 ;; Look for the supplementary keyword
6502 ;; (bounded by the backward search start 6509 ;; (bounded by the backward search start
6503 ;; point). 6510 ;; point).
@@ -6549,7 +6556,7 @@ With argument, do this that many times."
6549 (setq target (point))) 6556 (setq target (point)))
6550 (goto-char target))) 6557 (goto-char target)))
6551 6558
6552(defun vhdl-end-of-defun (&optional count) 6559(defun vhdl-end-of-defun (&optional _count)
6553 "Move forward to the end of a VHDL defun." 6560 "Move forward to the end of a VHDL defun."
6554 (interactive) 6561 (interactive)
6555 (let ((case-fold-search t)) 6562 (let ((case-fold-search t))
@@ -7321,7 +7328,7 @@ after the containing paren which starts the arglist."
7321 (current-column)))) 7328 (current-column))))
7322 (- ce-curcol cs-curcol -1)))) 7329 (- ce-curcol cs-curcol -1))))
7323 7330
7324(defun vhdl-lineup-comment (langelem) 7331(defun vhdl-lineup-comment (_langelem)
7325 "Support old behavior for comment indentation. We look at 7332 "Support old behavior for comment indentation. We look at
7326vhdl-comment-only-line-offset to decide how to indent comment 7333vhdl-comment-only-line-offset to decide how to indent comment
7327only-lines." 7334only-lines."
@@ -7383,27 +7390,13 @@ only-lines."
7383;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7390;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7384;; Progress reporting 7391;; Progress reporting
7385 7392
7386(defvar vhdl-progress-info nil 7393(defvar vhdl--progress-reporter nil
7387 "Array variable for progress information: 0 begin, 1 end, 2 time.") 7394 "Holds the progress reporter data during long running operations.")
7388
7389(defun vhdl-update-progress-info (string pos)
7390 "Update progress information."
7391 (when (and vhdl-progress-info (not noninteractive)
7392 (time-less-p vhdl-progress-interval
7393 (time-since (aref vhdl-progress-info 2))))
7394 (let ((delta (- (aref vhdl-progress-info 1)
7395 (aref vhdl-progress-info 0))))
7396 (message "%s... (%2d%%)" string
7397 (if (= 0 delta)
7398 100
7399 (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
7400 delta))))
7401 (aset vhdl-progress-info 2 (time-convert nil 'integer))))
7402 7395
7403;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7396;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7404;; Indentation commands 7397;; Indentation commands
7405 7398
7406(defun vhdl-electric-tab (&optional prefix-arg) 7399(defun vhdl-electric-tab (&optional arg)
7407 "If preceding character is part of a word or a paren then hippie-expand, 7400 "If preceding character is part of a word or a paren then hippie-expand,
7408else if right of non whitespace on line then insert tab, 7401else if right of non whitespace on line then insert tab,
7409else if last command was a tab or return then dedent one step or if a comment 7402else if last command was a tab or return then dedent one step or if a comment
@@ -7414,7 +7407,7 @@ else indent `correctly'."
7414 (cond 7407 (cond
7415 ;; indent region if region is active 7408 ;; indent region if region is active
7416 ((and (not (featurep 'xemacs)) (use-region-p)) 7409 ((and (not (featurep 'xemacs)) (use-region-p))
7417 (vhdl-indent-region (region-beginning) (region-end) nil)) 7410 (indent-region (region-beginning) (region-end) nil))
7418 ;; expand word 7411 ;; expand word
7419 ((= (char-syntax (preceding-char)) ?w) 7412 ((= (char-syntax (preceding-char)) ?w)
7420 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7413 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
@@ -7423,12 +7416,12 @@ else indent `correctly'."
7423 (or (and (boundp 'hippie-expand-only-buffers) 7416 (or (and (boundp 'hippie-expand-only-buffers)
7424 hippie-expand-only-buffers) 7417 hippie-expand-only-buffers)
7425 '(vhdl-mode)))) 7418 '(vhdl-mode))))
7426 (vhdl-expand-abbrev prefix-arg))) 7419 (vhdl-expand-abbrev arg)))
7427 ;; expand parenthesis 7420 ;; expand parenthesis
7428 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 7421 ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
7429 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7422 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7430 (case-replace nil)) 7423 (case-replace nil))
7431 (vhdl-expand-paren prefix-arg))) 7424 (vhdl-expand-paren arg)))
7432 ;; insert tab 7425 ;; insert tab
7433 ((> (current-column) (current-indentation)) 7426 ((> (current-column) (current-indentation))
7434 (insert-tab)) 7427 (insert-tab))
@@ -7487,7 +7480,7 @@ indentation change."
7487 (setq syntax (vhdl-get-syntactic-context))))) 7480 (setq syntax (vhdl-get-syntactic-context)))))
7488 (when is-comment 7481 (when is-comment
7489 (push (cons 'comment nil) syntax)) 7482 (push (cons 'comment nil) syntax))
7490 (apply '+ (mapcar 'vhdl-get-offset syntax))) 7483 (apply #'+ (mapcar #'vhdl-get-offset syntax)))
7491 ;; indent like previous nonblank line 7484 ;; indent like previous nonblank line
7492 (save-excursion (beginning-of-line) 7485 (save-excursion (beginning-of-line)
7493 (re-search-backward "^[^\n]" nil t) 7486 (re-search-backward "^[^\n]" nil t)
@@ -7509,25 +7502,17 @@ indentation change."
7509 (when (> (- (point-max) pos) (point)) 7502 (when (> (- (point-max) pos) (point))
7510 (goto-char (- (point-max) pos)))) 7503 (goto-char (- (point-max) pos))))
7511 (run-hooks 'vhdl-special-indent-hook) 7504 (run-hooks 'vhdl-special-indent-hook)
7512 (vhdl-update-progress-info "Indenting" (vhdl-current-line)) 7505 (when vhdl--progress-reporter
7506 (progress-reporter-update vhdl--progress-reporter (point)))
7513 shift-amt)) 7507 shift-amt))
7514 7508
7515(defun vhdl-indent-region (beg end &optional column) 7509(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1")
7516 "Indent region as VHDL code.
7517Adds progress reporting to `indent-region'."
7518 (interactive "r\nP")
7519 (when vhdl-progress-interval
7520 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7521 (count-lines (point-min) end) 0)))
7522 (indent-region beg end column)
7523 (when vhdl-progress-interval (message "Indenting...done"))
7524 (setq vhdl-progress-info nil))
7525 7510
7526(defun vhdl-indent-buffer () 7511(defun vhdl-indent-buffer ()
7527 "Indent whole buffer as VHDL code. 7512 "Indent whole buffer as VHDL code.
7528Calls `indent-region' for whole buffer and adds progress reporting." 7513Calls `indent-region' for whole buffer and adds progress reporting."
7529 (interactive) 7514 (interactive)
7530 (vhdl-indent-region (point-min) (point-max))) 7515 (indent-region (point-min) (point-max)))
7531 7516
7532(defun vhdl-indent-group () 7517(defun vhdl-indent-group ()
7533 "Indent group of lines between empty lines." 7518 "Indent group of lines between empty lines."
@@ -7540,7 +7525,7 @@ Calls `indent-region' for whole buffer and adds progress reporting."
7540 (if (re-search-forward vhdl-align-group-separate nil t) 7525 (if (re-search-forward vhdl-align-group-separate nil t)
7541 (point-marker) 7526 (point-marker)
7542 (point-max-marker))))) 7527 (point-max-marker)))))
7543 (vhdl-indent-region beg end))) 7528 (indent-region beg end)))
7544 7529
7545(defun vhdl-indent-sexp (&optional endpos) 7530(defun vhdl-indent-sexp (&optional endpos)
7546 "Indent each line of the list starting just after point. 7531 "Indent each line of the list starting just after point.
@@ -7699,7 +7684,7 @@ parentheses."
7699 ;; run FUNCTION 7684 ;; run FUNCTION
7700 (funcall function beg end spacing))) 7685 (funcall function beg end spacing)))
7701 7686
7702(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) 7687(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent)
7703 "Attempt to align a range of lines based on the content of the 7688 "Attempt to align a range of lines based on the content of the
7704lines. The definition of `alignment-list' determines the matching 7689lines. The definition of `alignment-list' determines the matching
7705order and the manner in which the lines are aligned. If ALIGNMENT-LIST 7690order and the manner in which the lines are aligned. If ALIGNMENT-LIST
@@ -7709,12 +7694,15 @@ indentation is done before aligning."
7709 (setq alignment-list (or alignment-list vhdl-align-alist)) 7694 (setq alignment-list (or alignment-list vhdl-align-alist))
7710 (setq spacing (or spacing 1)) 7695 (setq spacing (or spacing 1))
7711 (save-excursion 7696 (save-excursion
7712 (let (bol indent) 7697 (let (bol) ;; indent
7713 (goto-char end) 7698 (goto-char end)
7714 (setq end (point-marker)) 7699 (setq end (point-marker))
7715 (goto-char begin) 7700 (goto-char begin)
7716 (setq bol (setq begin (progn (beginning-of-line) (point)))) 7701 (setq bol (setq begin (progn (beginning-of-line) (point))))
7717 (when indent 7702 ;; FIXME: The `indent' arg is not used, and I think it's because
7703 ;; the let binding commented out above `indent' was hiding it, so
7704 ;; the test below should maybe still test `indent'?
7705 (when nil ;; indent
7718 (indent-region bol end nil)))) 7706 (indent-region bol end nil))))
7719 (let ((copy (copy-alist alignment-list))) 7707 (let ((copy (copy-alist alignment-list)))
7720 (vhdl-prepare-search-2 7708 (vhdl-prepare-search-2
@@ -7799,18 +7787,21 @@ the token in MATCH."
7799 "Align region, treat groups of lines separately." 7787 "Align region, treat groups of lines separately."
7800 (interactive "r\nP") 7788 (interactive "r\nP")
7801 (save-excursion 7789 (save-excursion
7802 (let (orig pos) 7790 (goto-char beg)
7803 (goto-char beg) 7791 (beginning-of-line)
7804 (beginning-of-line) 7792 (setq beg (point))
7805 (setq orig (point-marker)) 7793 (goto-char end)
7806 (setq beg (point)) 7794 (setq end (point-marker))
7807 (goto-char end) 7795 (untabify beg end)
7808 (setq end (point-marker)) 7796 (let ((orig (copy-marker beg))
7809 (untabify beg end) 7797 pos
7810 (unless no-message 7798 (vhdl--progress-reporter
7811 (when vhdl-progress-interval 7799 (if no-message
7812 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7800 ;; Preserve a potential progress reporter from
7813 (count-lines (point-min) end) 0)))) 7801 ;; when called from `vhdl-align-region' call.
7802 vhdl--progress-reporter
7803 (when vhdl-progress-interval
7804 (make-progress-reporter "Aligning..." beg (copy-marker end))))))
7814 (when (nth 0 vhdl-beautify-options) 7805 (when (nth 0 vhdl-beautify-options)
7815 (vhdl-fixup-whitespace-region beg end t)) 7806 (vhdl-fixup-whitespace-region beg end t))
7816 (goto-char beg) 7807 (goto-char beg)
@@ -7825,19 +7816,21 @@ the token in MATCH."
7825 (setq pos (point-marker)) 7816 (setq pos (point-marker))
7826 (vhdl-align-region-1 beg pos spacing) 7817 (vhdl-align-region-1 beg pos spacing)
7827 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) 7818 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7828 (vhdl-update-progress-info "Aligning" (vhdl-current-line)) 7819 (when vhdl--progress-reporter
7820 (progress-reporter-update vhdl--progress-reporter (point)))
7829 (setq beg (1+ pos)) 7821 (setq beg (1+ pos))
7830 (goto-char beg)) 7822 (goto-char beg))
7831 ;; align last group 7823 ;; align last group
7832 (when (< beg end) 7824 (when (< beg end)
7833 (vhdl-align-region-1 beg end spacing) 7825 (vhdl-align-region-1 beg end spacing)
7834 (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) 7826 (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7835 (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) 7827 (when vhdl--progress-reporter
7828 (progress-reporter-update vhdl--progress-reporter (point)))))
7836 (when vhdl-indent-tabs-mode 7829 (when vhdl-indent-tabs-mode
7837 (tabify orig end)) 7830 (tabify orig end))
7838 (unless no-message 7831 (unless no-message
7839 (when vhdl-progress-interval (message "Aligning...done")) 7832 (when vhdl--progress-reporter
7840 (setq vhdl-progress-info nil))))) 7833 (progress-reporter-done vhdl--progress-reporter))))))
7841 7834
7842(defun vhdl-align-region (beg end &optional spacing) 7835(defun vhdl-align-region (beg end &optional spacing)
7843 "Align region, treat blocks with same indent and argument lists separately." 7836 "Align region, treat blocks with same indent and argument lists separately."
@@ -7848,10 +7841,10 @@ the token in MATCH."
7848 ;; align blocks with same indent and argument lists 7841 ;; align blocks with same indent and argument lists
7849 (save-excursion 7842 (save-excursion
7850 (let ((cur-beg beg) 7843 (let ((cur-beg beg)
7851 indent cur-end) 7844 indent cur-end
7852 (when vhdl-progress-interval 7845 (vhdl--progress-reporter
7853 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7846 (when vhdl-progress-interval
7854 (count-lines (point-min) end) 0))) 7847 (make-progress-reporter "Aligning..." beg (copy-marker end)))))
7855 (goto-char end) 7848 (goto-char end)
7856 (setq end (point-marker)) 7849 (setq end (point-marker))
7857 (goto-char cur-beg) 7850 (goto-char cur-beg)
@@ -7874,15 +7867,16 @@ the token in MATCH."
7874 (= (current-indentation) indent)) 7867 (= (current-indentation) indent))
7875 (<= (save-excursion 7868 (<= (save-excursion
7876 (nth 0 (parse-partial-sexp 7869 (nth 0 (parse-partial-sexp
7877 (point) (vhdl-point 'eol)))) 0)) 7870 (point) (vhdl-point 'eol))))
7871 0))
7878 (unless (looking-at "^\\s-*$") 7872 (unless (looking-at "^\\s-*$")
7879 (setq cur-end (vhdl-point 'bonl))) 7873 (setq cur-end (vhdl-point 'bonl)))
7880 (beginning-of-line 2))) 7874 (beginning-of-line 2)))
7881 ;; align region 7875 ;; align region
7882 (vhdl-align-region-groups cur-beg cur-end spacing t t)) 7876 (vhdl-align-region-groups cur-beg cur-end spacing t t))
7883 (vhdl-align-inline-comment-region beg end spacing noninteractive) 7877 (vhdl-align-inline-comment-region beg end spacing noninteractive)
7884 (when vhdl-progress-interval (message "Aligning...done")) 7878 (when vhdl--progress-reporter
7885 (setq vhdl-progress-info nil))))) 7879 (progress-reporter-done vhdl--progress-reporter))))))
7886 7880
7887(defun vhdl-align-group (&optional spacing) 7881(defun vhdl-align-group (&optional spacing)
7888 "Align group of lines between empty lines." 7882 "Align group of lines between empty lines."
@@ -8031,7 +8025,7 @@ empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
8031 (tabify orig end)) 8025 (tabify orig end))
8032 (unless no-message (message "Aligning inline comments...done"))))) 8026 (unless no-message (message "Aligning inline comments...done")))))
8033 8027
8034(defun vhdl-align-inline-comment-group (&optional spacing) 8028(defun vhdl-align-inline-comment-group (&optional _spacing)
8035 "Align inline comments within a group of lines between empty lines." 8029 "Align inline comments within a group of lines between empty lines."
8036 (interactive) 8030 (interactive)
8037 (save-excursion 8031 (save-excursion
@@ -8126,7 +8120,8 @@ end of line, do nothing in comments."
8126 "Convert all words matching WORD-REGEXP in region to lower or upper case, 8120 "Convert all words matching WORD-REGEXP in region to lower or upper case,
8127depending on parameter UPPER-CASE." 8121depending on parameter UPPER-CASE."
8128 (let ((case-replace nil) 8122 (let ((case-replace nil)
8129 (last-update 0)) 8123 (pr (when (and count vhdl-progress-interval (not noninteractive))
8124 (make-progress-reporter "Fixing case..." beg (copy-marker end)))))
8130 (vhdl-prepare-search-2 8125 (vhdl-prepare-search-2
8131 (save-excursion 8126 (save-excursion
8132 (goto-char end) 8127 (goto-char end)
@@ -8137,19 +8132,13 @@ depending on parameter UPPER-CASE."
8137 (if upper-case 8132 (if upper-case
8138 (upcase-word -1) 8133 (upcase-word -1)
8139 (downcase-word -1))) 8134 (downcase-word -1)))
8140 (when (and count vhdl-progress-interval (not noninteractive) 8135 (when pr (progress-reporter-update pr (point))))
8141 (time-less-p vhdl-progress-interval 8136 (when pr (progress-reporter-done pr))))))
8142 (time-since last-update))) 8137
8143 (message "Fixing case... (%2d%s)" 8138(defun vhdl-fix-case-region (beg end &optional _arg)
8144 (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
8145 "%")
8146 (setq last-update (time-convert nil 'integer))))
8147 (goto-char end)))))
8148
8149(defun vhdl-fix-case-region (beg end &optional arg)
8150 "Convert all VHDL words in region to lower or upper case, depending on 8139 "Convert all VHDL words in region to lower or upper case, depending on
8151options vhdl-upper-case-{keywords,types,attributes,enum-values}." 8140options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8152 (interactive "r\nP") 8141 (interactive "r")
8153 (vhdl-fix-case-region-1 8142 (vhdl-fix-case-region-1
8154 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) 8143 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
8155 (vhdl-fix-case-region-1 8144 (vhdl-fix-case-region-1
@@ -8195,11 +8184,11 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8195;; - force each statement to be on a separate line except when on same line 8184;; - force each statement to be on a separate line except when on same line
8196;; with 'end' keyword 8185;; with 'end' keyword
8197 8186
8198(defun vhdl-fix-statement-region (beg end &optional arg) 8187(defun vhdl-fix-statement-region (beg end &optional _arg)
8199 "Force statements in region on separate line except when on same line 8188 "Force statements in region on separate line except when on same line
8200with `end' keyword (necessary for correct indentation). 8189with `end' keyword (necessary for correct indentation).
8201Currently supported keywords: `begin', `if'." 8190Currently supported keywords: `begin', `if'."
8202 (interactive "r\nP") 8191 (interactive "r")
8203 (vhdl-prepare-search-2 8192 (vhdl-prepare-search-2
8204 (let (point) 8193 (let (point)
8205 (save-excursion 8194 (save-excursion
@@ -8251,9 +8240,9 @@ with `end' keyword (necessary for correct indentation)."
8251;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8240;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8252;; Trailing spaces 8241;; Trailing spaces
8253 8242
8254(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) 8243(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg)
8255 "Remove trailing spaces in region." 8244 "Remove trailing spaces in region."
8256 (interactive "r\nP") 8245 (interactive "r")
8257 (save-excursion 8246 (save-excursion
8258 (goto-char end) 8247 (goto-char end)
8259 (setq end (point-marker)) 8248 (setq end (point-marker))
@@ -8283,7 +8272,7 @@ case fixing to a region. Calls functions `vhdl-indent-buffer',
8283 (replace-match "" nil t))) 8272 (replace-match "" nil t)))
8284 (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) 8273 (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
8285 (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) 8274 (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
8286 (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) 8275 (when (nth 2 vhdl-beautify-options) (indent-region beg end))
8287 (when (nth 3 vhdl-beautify-options) 8276 (when (nth 3 vhdl-beautify-options)
8288 (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) 8277 (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
8289 (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) 8278 (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
@@ -8516,7 +8505,7 @@ buffer."
8516 (delete-region sens-beg sens-end) 8505 (delete-region sens-beg sens-end)
8517 (when read-list 8506 (when read-list
8518 (insert " ()") (backward-char))) 8507 (insert " ()") (backward-char)))
8519 (setq read-list (sort read-list 'string<)) 8508 (setq read-list (sort read-list #'string<))
8520 (when read-list 8509 (when read-list
8521 (setq margin (current-column)) 8510 (setq margin (current-column))
8522 (insert (car read-list)) 8511 (insert (car read-list))
@@ -8548,7 +8537,7 @@ buffer."
8548 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) 8537 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
8549 "." (file-name-extension (buffer-file-name))))) 8538 "." (file-name-extension (buffer-file-name)))))
8550 (vhdl-visit-file 8539 (vhdl-visit-file
8551 file-name t 8540 file-name t
8552 (vhdl-prepare-search-2 8541 (vhdl-prepare-search-2
8553 (goto-char (point-min)) 8542 (goto-char (point-min))
8554 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) 8543 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
@@ -8556,7 +8545,8 @@ buffer."
8556 (when (setq beg (vhdl-re-search-forward 8545 (when (setq beg (vhdl-re-search-forward
8557 "\\<port[ \t\n\r\f]*(" 8546 "\\<port[ \t\n\r\f]*("
8558 (save-excursion 8547 (save-excursion
8559 (re-search-forward "^end\\>" nil t)) t)) 8548 (re-search-forward "^end\\>" nil t))
8549 t))
8560 (setq end (save-excursion 8550 (setq end (save-excursion
8561 (backward-char) (forward-sexp) (point))) 8551 (backward-char) (forward-sexp) (point)))
8562 (vhdl-forward-syntactic-ws) 8552 (vhdl-forward-syntactic-ws)
@@ -8688,9 +8678,9 @@ buffer."
8688Used for undoing after template abortion.") 8678Used for undoing after template abortion.")
8689 8679
8690;; correct different behavior of function `unread-command-events' in XEmacs 8680;; correct different behavior of function `unread-command-events' in XEmacs
8691(defun vhdl-character-to-event (arg)) 8681(defun vhdl-character-to-event (_arg) nil)
8692(defalias 'vhdl-character-to-event 8682(defalias 'vhdl-character-to-event
8693 (if (fboundp 'character-to-event) 'character-to-event 'identity)) 8683 (if (fboundp 'character-to-event) #'character-to-event #'identity))
8694 8684
8695(defun vhdl-work-library () 8685(defun vhdl-work-library ()
8696 "Return the working library name of the current project or \"work\" if no 8686 "Return the working library name of the current project or \"work\" if no
@@ -9147,7 +9137,8 @@ a configuration declaration if not within a design unit."
9147 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 9137 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9148 (equal "CONFIGURATION" (upcase (match-string 1)))) 9138 (equal "CONFIGURATION" (upcase (match-string 1))))
9149 (if (eq (vhdl-decision-query 9139 (if (eq (vhdl-decision-query
9150 "configuration" "(b)lock or (c)omponent configuration?" t) ?c) 9140 "configuration" "(b)lock or (c)omponent configuration?" t)
9141 ?c)
9151 (vhdl-template-component-conf) 9142 (vhdl-template-component-conf)
9152 (vhdl-template-block-configuration))) 9143 (vhdl-template-block-configuration)))
9153 (t (vhdl-template-configuration-decl))))) ; otherwise 9144 (t (vhdl-template-configuration-decl))))) ; otherwise
@@ -9256,7 +9247,7 @@ a configuration declaration if not within a design unit."
9256 (interactive) 9247 (interactive)
9257 (let ((margin (current-indentation)) 9248 (let ((margin (current-indentation))
9258 (start (point)) 9249 (start (point))
9259 entity-exists string name position) 9250 name position) ;; entity-exists string
9260 (vhdl-insert-keyword "CONTEXT ") 9251 (vhdl-insert-keyword "CONTEXT ")
9261 (when (setq name (vhdl-template-field "name" nil t start (point))) 9252 (when (setq name (vhdl-template-field "name" nil t start (point)))
9262 (vhdl-insert-keyword " IS\n") 9253 (vhdl-insert-keyword " IS\n")
@@ -9412,7 +9403,8 @@ otherwise."
9412 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 9403 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9413 (equal "CONFIGURATION" (upcase (match-string 1)))) 9404 (equal "CONFIGURATION" (upcase (match-string 1))))
9414 (if (eq (vhdl-decision-query 9405 (if (eq (vhdl-decision-query
9415 "for" "(b)lock or (c)omponent configuration?" t) ?c) 9406 "for" "(b)lock or (c)omponent configuration?" t)
9407 ?c)
9416 (vhdl-template-component-conf) 9408 (vhdl-template-component-conf)
9417 (vhdl-template-block-configuration))) 9409 (vhdl-template-block-configuration)))
9418 ((and (save-excursion 9410 ((and (save-excursion
@@ -9527,11 +9519,12 @@ otherwise."
9527(defun vhdl-template-group () 9519(defun vhdl-template-group ()
9528 "Insert group or group template declaration." 9520 "Insert group or group template declaration."
9529 (interactive) 9521 (interactive)
9530 (let ((start (point))) 9522 ;; (let ((start (point)))
9531 (if (eq (vhdl-decision-query 9523 (if (eq (vhdl-decision-query
9532 "group" "(d)eclaration or (t)emplate declaration?" t) ?t) 9524 "group" "(d)eclaration or (t)emplate declaration?" t)
9533 (vhdl-template-group-template) 9525 ?t)
9534 (vhdl-template-group-decl)))) 9526 (vhdl-template-group-template)
9527 (vhdl-template-group-decl))) ;; )
9535 9528
9536(defun vhdl-template-group-decl () 9529(defun vhdl-template-group-decl ()
9537 "Insert group declaration." 9530 "Insert group declaration."
@@ -10472,7 +10465,8 @@ specification, if not already there."
10472 (and (not (bobp)) 10465 (and (not (bobp))
10473 (re-search-backward 10466 (re-search-backward
10474 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" 10467 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
10475 library "\\|end\\)\\>") nil t) 10468 library "\\|end\\)\\>")
10469 nil t)
10476 (match-string 2)))) 10470 (match-string 2))))
10477 (equal (downcase library) "work")) 10471 (equal (downcase library) "work"))
10478 (vhdl-insert-keyword "LIBRARY ") 10472 (vhdl-insert-keyword "LIBRARY ")
@@ -10832,9 +10826,9 @@ If starting after end-comment-column, start a new line."
10832 (vhdl-line-kill-entire))))) 10826 (vhdl-line-kill-entire)))))
10833 (goto-char final-pos)))) 10827 (goto-char final-pos))))
10834 10828
10835(defun vhdl-comment-uncomment-region (beg end &optional arg) 10829(defun vhdl-comment-uncomment-region (beg end &optional _arg)
10836 "Comment out region if not commented out, uncomment otherwise." 10830 "Comment out region if not commented out, uncomment otherwise."
10837 (interactive "r\nP") 10831 (interactive "r")
10838 (save-excursion 10832 (save-excursion
10839 (goto-char (1- end)) 10833 (goto-char (1- end))
10840 (end-of-line) 10834 (end-of-line)
@@ -10911,7 +10905,7 @@ Point is left between them."
10911 "Read from user a procedure or function argument list." 10905 "Read from user a procedure or function argument list."
10912 (insert " (") 10906 (insert " (")
10913 (let ((margin (current-column)) 10907 (let ((margin (current-column))
10914 (start (point)) 10908 ;; (start (point))
10915 (end-pos (point)) 10909 (end-pos (point))
10916 not-empty interface semicolon-pos) 10910 not-empty interface semicolon-pos)
10917 (unless vhdl-argument-list-indent 10911 (unless vhdl-argument-list-indent
@@ -10920,7 +10914,8 @@ Point is left between them."
10920 (indent-to margin)) 10914 (indent-to margin))
10921 (setq interface (vhdl-template-field 10915 (setq interface (vhdl-template-field
10922 (concat "[CONSTANT | SIGNAL" 10916 (concat "[CONSTANT | SIGNAL"
10923 (unless is-function " | VARIABLE") "]") " " t)) 10917 (unless is-function " | VARIABLE") "]")
10918 " " t))
10924 (while (vhdl-template-field "[names]" nil t) 10919 (while (vhdl-template-field "[names]" nil t)
10925 (setq not-empty t) 10920 (setq not-empty t)
10926 (insert " : ") 10921 (insert " : ")
@@ -10937,7 +10932,8 @@ Point is left between them."
10937 (indent-to margin) 10932 (indent-to margin)
10938 (setq interface (vhdl-template-field 10933 (setq interface (vhdl-template-field
10939 (concat "[CONSTANT | SIGNAL" 10934 (concat "[CONSTANT | SIGNAL"
10940 (unless is-function " | VARIABLE") "]") " " t))) 10935 (unless is-function " | VARIABLE") "]")
10936 " " t)))
10941 (delete-region end-pos (point)) 10937 (delete-region end-pos (point))
10942 (when semicolon-pos (goto-char semicolon-pos)) 10938 (when semicolon-pos (goto-char semicolon-pos))
10943 (if not-empty 10939 (if not-empty
@@ -11157,7 +11153,7 @@ with double-quotes is to be inserted. DEFAULT specifies a default string."
11157 "Adjust case of following NUM words." 11153 "Adjust case of following NUM words."
11158 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) 11154 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
11159 11155
11160(defun vhdl-minibuffer-tab (&optional prefix-arg) 11156(defun vhdl-minibuffer-tab (&optional arg)
11161 "If preceding character is part of a word or a paren then hippie-expand, 11157 "If preceding character is part of a word or a paren then hippie-expand,
11162else insert tab (used for word completion in VHDL minibuffer)." 11158else insert tab (used for word completion in VHDL minibuffer)."
11163 (interactive "P") 11159 (interactive "P")
@@ -11170,12 +11166,12 @@ else insert tab (used for word completion in VHDL minibuffer)."
11170 (or (and (boundp 'hippie-expand-only-buffers) 11166 (or (and (boundp 'hippie-expand-only-buffers)
11171 hippie-expand-only-buffers) 11167 hippie-expand-only-buffers)
11172 '(vhdl-mode)))) 11168 '(vhdl-mode))))
11173 (vhdl-expand-abbrev prefix-arg))) 11169 (vhdl-expand-abbrev arg)))
11174 ;; expand parenthesis 11170 ;; expand parenthesis
11175 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 11171 ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
11176 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 11172 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11177 (case-replace nil)) 11173 (case-replace nil))
11178 (vhdl-expand-paren prefix-arg))) 11174 (vhdl-expand-paren arg)))
11179 ;; insert tab 11175 ;; insert tab
11180 (t (insert-tab)))) 11176 (t (insert-tab))))
11181 11177
@@ -11562,7 +11558,8 @@ but not if inside a comment or quote."
11562 (unless (equal model-keyword "") 11558 (unless (equal model-keyword "")
11563 (eval `(defun 11559 (eval `(defun
11564 ,(vhdl-function-name 11560 ,(vhdl-function-name
11565 "vhdl-model" model-name "hook") () 11561 "vhdl-model" model-name "hook")
11562 ()
11566 (vhdl-hooked-abbrev 11563 (vhdl-hooked-abbrev
11567 ',(vhdl-function-name "vhdl-model" model-name))))) 11564 ',(vhdl-function-name "vhdl-model" model-name)))))
11568 (setq model-alist (cdr model-alist))))) 11565 (setq model-alist (cdr model-alist)))))
@@ -11858,7 +11855,7 @@ reflected in a subsequent paste operation."
11858 11855
11859(defun vhdl-port-paste-context-clause (&optional exclude-pack-name) 11856(defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
11860 "Paste a context clause." 11857 "Paste a context clause."
11861 (let ((margin (current-indentation)) 11858 (let (;; (margin (current-indentation))
11862 (clause-list (nth 3 vhdl-port-list)) 11859 (clause-list (nth 3 vhdl-port-list))
11863 clause) 11860 clause)
11864 (while clause-list 11861 (while clause-list
@@ -11868,7 +11865,8 @@ reflected in a subsequent paste operation."
11868 (save-excursion 11865 (save-excursion
11869 (re-search-backward 11866 (re-search-backward
11870 (concat "^\\s-*use\\s-+" (car clause) 11867 (concat "^\\s-*use\\s-+" (car clause)
11871 "." (cdr clause) "\\>") nil t))) 11868 "." (cdr clause) "\\>")
11869 nil t)))
11872 (vhdl-template-standard-package (car clause) (cdr clause)) 11870 (vhdl-template-standard-package (car clause) (cdr clause))
11873 (insert "\n")) 11871 (insert "\n"))
11874 (setq clause-list (cdr clause-list))))) 11872 (setq clause-list (cdr clause-list)))))
@@ -12260,7 +12258,8 @@ reflected in a subsequent paste operation."
12260 (cond ((and vhdl-include-direction-comments (nth 2 port)) 12258 (cond ((and vhdl-include-direction-comments (nth 2 port))
12261 (format "%-6s" (concat "[" (nth 2 port) "] "))) 12259 (format "%-6s" (concat "[" (nth 2 port) "] ")))
12262 (vhdl-include-direction-comments " ")) 12260 (vhdl-include-direction-comments " "))
12263 (when vhdl-include-port-comments (nth 4 port))) t)) 12261 (when vhdl-include-port-comments (nth 4 port)))
12262 t))
12264 (setq port-list (cdr port-list)) 12263 (setq port-list (cdr port-list))
12265 (when port-list (insert "\n") (indent-to margin))) 12264 (when port-list (insert "\n") (indent-to margin)))
12266 ;; align signal list 12265 ;; align signal list
@@ -12314,7 +12313,7 @@ reflected in a subsequent paste operation."
12314 (let ((case-fold-search t) 12313 (let ((case-fold-search t)
12315 (ent-name (vhdl-replace-string vhdl-testbench-entity-name 12314 (ent-name (vhdl-replace-string vhdl-testbench-entity-name
12316 (nth 0 vhdl-port-list))) 12315 (nth 0 vhdl-port-list)))
12317 (source-buffer (current-buffer)) 12316 ;; (source-buffer (current-buffer))
12318 arch-name config-name ent-file-name arch-file-name 12317 arch-name config-name ent-file-name arch-file-name
12319 ent-buffer arch-buffer position) 12318 ent-buffer arch-buffer position)
12320 ;; open entity file 12319 ;; open entity file
@@ -12411,7 +12410,7 @@ reflected in a subsequent paste operation."
12411 (insert "\n") 12410 (insert "\n")
12412 (setq position (point)) 12411 (setq position (point))
12413 (vhdl-insert-string-or-file vhdl-testbench-declarations) 12412 (vhdl-insert-string-or-file vhdl-testbench-declarations)
12414 (vhdl-indent-region position (point))) 12413 (indent-region position (point)))
12415 (setq position (point)) 12414 (setq position (point))
12416 (insert "\n\n") 12415 (insert "\n\n")
12417 (vhdl-comment-display-line) (insert "\n") 12416 (vhdl-comment-display-line) (insert "\n")
@@ -12442,7 +12441,7 @@ reflected in a subsequent paste operation."
12442 (insert "\n") 12441 (insert "\n")
12443 (setq position (point)) 12442 (setq position (point))
12444 (vhdl-insert-string-or-file vhdl-testbench-statements) 12443 (vhdl-insert-string-or-file vhdl-testbench-statements)
12445 (vhdl-indent-region position (point))) 12444 (indent-region position (point)))
12446 (insert "\n") 12445 (insert "\n")
12447 (indent-to vhdl-basic-offset) 12446 (indent-to vhdl-basic-offset)
12448 (unless (eq vhdl-testbench-create-files 'none) 12447 (unless (eq vhdl-testbench-create-files 'none)
@@ -12815,7 +12814,7 @@ expressions (e.g. for index ranges of types and signals)."
12815 12814
12816;; override `he-list-beg' from `hippie-exp' 12815;; override `he-list-beg' from `hippie-exp'
12817(unless (and (boundp 'viper-mode) viper-mode) 12816(unless (and (boundp 'viper-mode) viper-mode)
12818 (defalias 'he-list-beg 'vhdl-he-list-beg)) 12817 (defalias 'he-list-beg #'vhdl-he-list-beg))
12819 12818
12820;; function for expanding abbrevs and dabbrevs 12819;; function for expanding abbrevs and dabbrevs
12821(defalias 'vhdl-expand-abbrev (make-hippie-expand-function 12820(defalias 'vhdl-expand-abbrev (make-hippie-expand-function
@@ -12862,14 +12861,14 @@ expressions (e.g. for index ranges of types and signals)."
12862 (beginning-of-line) 12861 (beginning-of-line)
12863 (yank)) 12862 (yank))
12864 12863
12865(defun vhdl-line-expand (&optional prefix-arg) 12864(defun vhdl-line-expand (&optional arg)
12866 "Hippie-expand current line." 12865 "Hippie-expand current line."
12867 (interactive "P") 12866 (interactive "P")
12868 (require 'hippie-exp) 12867 (require 'hippie-exp)
12869 (let ((case-fold-search t) (case-replace nil) 12868 (let ((case-fold-search t) (case-replace nil)
12870 (hippie-expand-try-functions-list 12869 (hippie-expand-try-functions-list
12871 '(try-expand-line try-expand-line-all-buffers))) 12870 '(try-expand-line try-expand-line-all-buffers)))
12872 (hippie-expand prefix-arg))) 12871 (hippie-expand arg)))
12873 12872
12874(defun vhdl-line-transpose-next (&optional arg) 12873(defun vhdl-line-transpose-next (&optional arg)
12875 "Interchange this line with next line." 12874 "Interchange this line with next line."
@@ -12991,7 +12990,7 @@ File statistics: \"%s\"\n\
12991# total lines : %5d\n" 12990# total lines : %5d\n"
12992 (buffer-file-name) no-stats no-code-lines no-empty-lines 12991 (buffer-file-name) no-stats no-code-lines no-empty-lines
12993 no-comm-lines no-comments no-lines) 12992 no-comm-lines no-comments no-lines)
12994 (unless vhdl-emacs-21 (vhdl-show-messages)))) 12993 (when (featurep 'xemacs) (vhdl-show-messages))))
12995 12994
12996;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12995;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12997;; Help functions 12996;; Help functions
@@ -13040,7 +13039,7 @@ File statistics: \"%s\"\n\
13040 (customize-set-variable 'vhdl-project vhdl-project) 13039 (customize-set-variable 'vhdl-project vhdl-project)
13041 (customize-save-customized)) 13040 (customize-save-customized))
13042 13041
13043(defun vhdl-toggle-project (name token indent) 13042(defun vhdl-toggle-project (name _token _indent)
13044 "Set current project to NAME or unset if NAME is current project." 13043 "Set current project to NAME or unset if NAME is current project."
13045 (vhdl-set-project (if (equal name vhdl-project) "" name))) 13044 (vhdl-set-project (if (equal name vhdl-project) "" name)))
13046 13045
@@ -13244,6 +13243,7 @@ File statistics: \"%s\"\n\
13244 "Toggle hideshow minor mode and update menu bar." 13243 "Toggle hideshow minor mode and update menu bar."
13245 (interactive "P") 13244 (interactive "P")
13246 (require 'hideshow) 13245 (require 'hideshow)
13246 (declare-function hs-hide-all "hideshow" ())
13247 ;; check for hideshow version 5.x 13247 ;; check for hideshow version 5.x
13248 (if (not (boundp 'hs-block-start-mdata-select)) 13248 (if (not (boundp 'hs-block-start-mdata-select))
13249 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") 13249 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
@@ -13255,8 +13255,8 @@ File statistics: \"%s\"\n\
13255 hs-special-modes-alist))) 13255 hs-special-modes-alist)))
13256 (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) 13256 (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
13257 (if vhdl-hide-all-init 13257 (if vhdl-hide-all-init
13258 (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) 13258 (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t)
13259 (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) 13259 (remove-hook 'hs-minor-mode-hook #'hs-hide-all t))
13260 (hs-minor-mode arg) 13260 (hs-minor-mode arg)
13261 (force-mode-line-update))) ; hack to update menu bar 13261 (force-mode-line-update))) ; hack to update menu bar
13262 13262
@@ -13523,6 +13523,8 @@ This does background highlighting of translate-off regions.")
13523 (while syntax-alist 13523 (while syntax-alist
13524 (setq name (vhdl-function-name 13524 (setq name (vhdl-function-name
13525 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) 13525 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
13526 ;; FIXME: This `defvar' shouldn't be needed: just quote the face
13527 ;; name when you use it.
13526 (eval `(defvar ,name ',name 13528 (eval `(defvar ,name ',name
13527 ,(concat "Face name to use for " 13529 ,(concat "Face name to use for "
13528 (nth 0 (car syntax-alist)) "."))) 13530 (nth 0 (car syntax-alist)) ".")))
@@ -13735,7 +13737,7 @@ This does background highlighting of translate-off regions.")
13735 (when (boundp 'ps-print-color-p) 13737 (when (boundp 'ps-print-color-p)
13736 (vhdl-ps-print-settings)) 13738 (vhdl-ps-print-settings))
13737 (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) 13739 (if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
13738 (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) 13740 (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t)))
13739 13741
13740 13742
13741;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13743;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -13907,7 +13909,7 @@ hierarchy otherwise.")
13907 pack-list pack-body-list inst-list inst-ent-list) 13909 pack-list pack-body-list inst-list inst-ent-list)
13908 ;; scan file 13910 ;; scan file
13909 (vhdl-visit-file 13911 (vhdl-visit-file
13910 file-name nil 13912 file-name nil
13911 (vhdl-prepare-search-2 13913 (vhdl-prepare-search-2
13912 (save-excursion 13914 (save-excursion
13913 ;; scan for design units 13915 ;; scan for design units
@@ -14082,7 +14084,8 @@ hierarchy otherwise.")
14082 "component[ \t\n\r\f]+\\(\\w+\\)\\|" 14084 "component[ \t\n\r\f]+\\(\\w+\\)\\|"
14083 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" 14085 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
14084 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" 14086 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
14085 "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) 14087 "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)")
14088 end-of-unit t)
14086 (or (not limit-hier-inst-no) 14089 (or (not limit-hier-inst-no)
14087 (<= (if (or (match-string 14) 14090 (<= (if (or (match-string 14)
14088 (match-string 16)) 14091 (match-string 16))
@@ -14444,12 +14447,15 @@ of PROJECT."
14444;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker 14447;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
14445;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker 14448;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
14446;; comp-lib-name level) 14449;; comp-lib-name level)
14447(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key 14450(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key
14448 conf-inst-alist level indent 14451 conf-key-arg conf-inst-alist level indent
14449 &optional include-top ent-hier) 14452 &optional include-top ent-hier)
14450 "Get instantiation hierarchy beginning in architecture ARCH-KEY of 14453 "Get instantiation hierarchy beginning in architecture ARCH-KEY of
14451entity ENT-KEY." 14454entity ENT-KEY."
14452 (let* ((ent-entry (vhdl-aget ent-alist ent-key)) 14455 (let* ((ent-alist ent-alist-arg)
14456 (conf-alist conf-alist-arg)
14457 (conf-key conf-key-arg)
14458 (ent-entry (vhdl-aget ent-alist ent-key))
14453 (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) 14459 (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
14454 (cdar (last (nth 3 ent-entry))))) 14460 (cdar (last (nth 3 ent-entry)))))
14455 (inst-alist (nth 3 arch-entry)) 14461 (inst-alist (nth 3 arch-entry))
@@ -14581,6 +14587,8 @@ entity ENT-KEY."
14581 (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") 14587 (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches")
14582 (sit-for 2))))) 14588 (sit-for 2)))))
14583 14589
14590(defvar vhdl-cache-version)
14591
14584(defun vhdl-save-cache (key) 14592(defun vhdl-save-cache (key)
14585 "Save current hierarchy cache to file." 14593 "Save current hierarchy cache to file."
14586 (let* ((orig-buffer (current-buffer)) 14594 (let* ((orig-buffer (current-buffer))
@@ -14667,7 +14675,7 @@ entity ENT-KEY."
14667 (file-dir-name (expand-file-name file-name directory)) 14675 (file-dir-name (expand-file-name file-name directory))
14668 vhdl-cache-version) 14676 vhdl-cache-version)
14669 (unless (memq 'vhdl-save-caches kill-emacs-hook) 14677 (unless (memq 'vhdl-save-caches kill-emacs-hook)
14670 (add-hook 'kill-emacs-hook 'vhdl-save-caches)) 14678 (add-hook 'kill-emacs-hook #'vhdl-save-caches))
14671 (when (file-exists-p file-dir-name) 14679 (when (file-exists-p file-dir-name)
14672 (condition-case () 14680 (condition-case ()
14673 (progn (load-file file-dir-name) 14681 (progn (load-file file-dir-name)
@@ -14707,6 +14715,8 @@ if required."
14707(declare-function speedbar-change-initial-expansion-list "speedbar" 14715(declare-function speedbar-change-initial-expansion-list "speedbar"
14708 (new-default)) 14716 (new-default))
14709(declare-function speedbar-add-expansion-list "speedbar" (new-list)) 14717(declare-function speedbar-add-expansion-list "speedbar" (new-list))
14718(declare-function speedbar-expand-line "speedbar" (&optional arg))
14719(declare-function speedbar-edit-line "speedbar" ())
14710 14720
14711(defun vhdl-speedbar-initialize () 14721(defun vhdl-speedbar-initialize ()
14712 "Initialize speedbar." 14722 "Initialize speedbar."
@@ -14731,19 +14741,19 @@ if required."
14731 ;; keymap 14741 ;; keymap
14732 (unless vhdl-speedbar-mode-map 14742 (unless vhdl-speedbar-mode-map
14733 (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) 14743 (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
14734 (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) 14744 (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line)
14735 (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) 14745 (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line)
14736 (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) 14746 (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line)
14737 (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) 14747 (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line)
14738 (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) 14748 (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level)
14739 (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) 14749 (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all)
14740 (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) 14750 (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy)
14741 (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) 14751 (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component)
14742 (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) 14752 (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration)
14743 (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) 14753 (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra)
14744 (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) 14754 (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design)
14745 (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) 14755 (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy)
14746 (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) 14756 (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches)
14747 (let ((key 0)) 14757 (let ((key 0))
14748 (while (<= key 9) 14758 (while (<= key 9)
14749 (define-key vhdl-speedbar-mode-map (int-to-string key) 14759 (define-key vhdl-speedbar-mode-map (int-to-string key)
@@ -14814,7 +14824,7 @@ if required."
14814 (setq speedbar-initial-expansion-list-name "vhdl directory")) 14824 (setq speedbar-initial-expansion-list-name "vhdl directory"))
14815 (when (eq vhdl-speedbar-display-mode 'project) 14825 (when (eq vhdl-speedbar-display-mode 'project)
14816 (setq speedbar-initial-expansion-list-name "vhdl project")) 14826 (setq speedbar-initial-expansion-list-name "vhdl project"))
14817 (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) 14827 (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy)))
14818 14828
14819(defun vhdl-speedbar (&optional arg) 14829(defun vhdl-speedbar (&optional arg)
14820 "Open/close speedbar." 14830 "Open/close speedbar."
@@ -14832,17 +14842,17 @@ if required."
14832 "Name of last selected project.") 14842 "Name of last selected project.")
14833 14843
14834;; macros must be defined in the file they are used (copied from `speedbar.el') 14844;; macros must be defined in the file they are used (copied from `speedbar.el')
14835;;; (defmacro speedbar-with-writable (&rest forms) 14845;; (defmacro speedbar-with-writable (&rest forms)
14836;;; "Allow the buffer to be writable and evaluate FORMS." 14846;; "Allow the buffer to be writable and evaluate FORMS."
14837;;; (list 'let '((inhibit-read-only t)) 14847;; (declare (indent 0) (debug t))
14838;;; (cons 'progn forms))) 14848;; (list 'let '((inhibit-read-only t))
14839;;; (put 'speedbar-with-writable 'lisp-indent-function 0) 14849;; (cons 'progn forms)))
14840 14850
14841(declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) 14851(declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
14842(declare-function speedbar-directory-buttons "speedbar" (directory _index)) 14852(declare-function speedbar-directory-buttons "speedbar" (directory _index))
14843(declare-function speedbar-file-lists "speedbar" (directory)) 14853(declare-function speedbar-file-lists "speedbar" (directory))
14844 14854
14845(defun vhdl-speedbar-display-directory (directory depth &optional rescan) 14855(defun vhdl-speedbar-display-directory (directory depth &optional _rescan)
14846 "Display directory and hierarchy information in speedbar." 14856 "Display directory and hierarchy information in speedbar."
14847 (setq vhdl-speedbar-show-projects nil) 14857 (setq vhdl-speedbar-show-projects nil)
14848 (setq speedbar-ignored-directory-regexp 14858 (setq speedbar-ignored-directory-regexp
@@ -14863,7 +14873,7 @@ if required."
14863 (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) 14873 (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
14864 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) 14874 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))))
14865 14875
14866(defun vhdl-speedbar-display-projects (project depth &optional rescan) 14876(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan)
14867 "Display projects and hierarchy information in speedbar." 14877 "Display projects and hierarchy information in speedbar."
14868 (setq vhdl-speedbar-show-projects t) 14878 (setq vhdl-speedbar-show-projects t)
14869 (setq speedbar-ignored-directory-regexp ".") 14879 (setq speedbar-ignored-directory-regexp ".")
@@ -14879,6 +14889,8 @@ if required."
14879(declare-function speedbar-make-tag-line "speedbar" 14889(declare-function speedbar-make-tag-line "speedbar"
14880 (type char func data tag tfunc tdata tface depth)) 14890 (type char func data tag tfunc tdata tface depth))
14881 14891
14892(defvar vhdl-speedbar-update-current-unit)
14893
14882(defun vhdl-speedbar-insert-projects () 14894(defun vhdl-speedbar-insert-projects ()
14883 "Insert all projects in speedbar." 14895 "Insert all projects in speedbar."
14884 (vhdl-speedbar-make-title-line "Projects:") 14896 (vhdl-speedbar-make-title-line "Projects:")
@@ -14889,9 +14901,9 @@ if required."
14889 ;; insert projects 14901 ;; insert projects
14890 (while project-alist 14902 (while project-alist
14891 (speedbar-make-tag-line 14903 (speedbar-make-tag-line
14892 'angle ?+ 'vhdl-speedbar-expand-project 14904 'angle ?+ #'vhdl-speedbar-expand-project
14893 (caar project-alist) (caar project-alist) 14905 (caar project-alist) (caar project-alist)
14894 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) 14906 #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
14895 (setq project-alist (cdr project-alist))) 14907 (setq project-alist (cdr project-alist)))
14896 (setq project-alist vhdl-project-alist) 14908 (setq project-alist vhdl-project-alist)
14897 ;; expand projects 14909 ;; expand projects
@@ -14938,12 +14950,14 @@ otherwise use cached data."
14938 (vhdl-speedbar-expand-units directory) 14950 (vhdl-speedbar-expand-units directory)
14939 (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) 14951 (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
14940 14952
14941(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist 14953(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist
14942 ent-inst-list depth) 14954 ent-inst-list depth)
14943 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." 14955 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
14944 (if (not (or ent-alist conf-alist pack-alist)) 14956 (if (not (or ent-alist conf-alist pack-alist))
14945 (vhdl-speedbar-make-title-line "No VHDL design units!" depth) 14957 (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
14946 (let (ent-entry conf-entry pack-entry) 14958 (let ((ent-alist ent-alist-arg)
14959 (conf-alist conf-alist-arg)
14960 ent-entry conf-entry pack-entry)
14947 ;; insert entities 14961 ;; insert entities
14948 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) 14962 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
14949 (while ent-alist 14963 (while ent-alist
@@ -15004,7 +15018,7 @@ otherwise use cached data."
15004 15018
15005(declare-function speedbar-goto-this-file "speedbar" (file)) 15019(declare-function speedbar-goto-this-file "speedbar" (file))
15006 15020
15007(defun vhdl-speedbar-expand-dirs (directory) 15021(defun vhdl-speedbar-expand-dirs (_directory)
15008 "Expand subdirectories in DIRECTORY according to 15022 "Expand subdirectories in DIRECTORY according to
15009 `speedbar-shown-directories'." 15023 `speedbar-shown-directories'."
15010 ;; (nicked from `speedbar-default-directory-list') 15024 ;; (nicked from `speedbar-default-directory-list')
@@ -15043,7 +15057,8 @@ otherwise use cached data."
15043 (goto-char position) 15057 (goto-char position)
15044 (when (re-search-forward 15058 (when (re-search-forward
15045 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" 15059 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
15046 (car arch-alist) "\\>\\)") nil t) 15060 (car arch-alist) "\\>\\)")
15061 nil t)
15047 (beginning-of-line) 15062 (beginning-of-line)
15048 (when (looking-at "^[0-9]+:\\s-*{") 15063 (when (looking-at "^[0-9]+:\\s-*{")
15049 (goto-char (match-end 0)) 15064 (goto-char (match-end 0))
@@ -15412,6 +15427,7 @@ otherwise use cached data."
15412;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15427;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15413;; Display help functions 15428;; Display help functions
15414 15429
15430;; FIXME: This `defvar' should be moved before its first use.
15415(defvar vhdl-speedbar-update-current-unit t 15431(defvar vhdl-speedbar-update-current-unit t
15416 "Non-nil means to run `vhdl-speedbar-update-current-unit'.") 15432 "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
15417 15433
@@ -15847,7 +15863,7 @@ NO-POSITION non-nil means do not re-position cursor."
15847 (abbreviate-file-name 15863 (abbreviate-file-name
15848 (file-name-as-directory (speedbar-line-directory indent))))) 15864 (file-name-as-directory (speedbar-line-directory indent)))))
15849 15865
15850(defun vhdl-speedbar-line-project (&optional indent) 15866(defun vhdl-speedbar-line-project (&optional _indent)
15851 "Get currently displayed project name." 15867 "Get currently displayed project name."
15852 (and vhdl-speedbar-show-projects 15868 (and vhdl-speedbar-show-projects
15853 (save-excursion 15869 (save-excursion
@@ -15917,7 +15933,7 @@ NO-POSITION non-nil means do not re-position cursor."
15917;; speedbar loads dframe at runtime. 15933;; speedbar loads dframe at runtime.
15918(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) 15934(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
15919 15935
15920(defun vhdl-speedbar-find-file (text token indent) 15936(defun vhdl-speedbar-find-file (_text token _indent)
15921 "When user clicks on TEXT, load file with name and position in TOKEN. 15937 "When user clicks on TEXT, load file with name and position in TOKEN.
15922Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file 15938Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
15923is already shown in a buffer." 15939is already shown in a buffer."
@@ -15945,12 +15961,12 @@ is already shown in a buffer."
15945 (let ((token (get-text-property 15961 (let ((token (get-text-property
15946 (match-beginning 3) 'speedbar-token))) 15962 (match-beginning 3) 'speedbar-token)))
15947 (vhdl-visit-file (car token) t 15963 (vhdl-visit-file (car token) t
15948 (progn (goto-char (point-min)) 15964 (goto-char (point-min))
15949 (forward-line (1- (cdr token))) 15965 (forward-line (1- (cdr token)))
15950 (end-of-line) 15966 (end-of-line)
15951 (if is-entity 15967 (if is-entity
15952 (vhdl-port-copy) 15968 (vhdl-port-copy)
15953 (vhdl-subprog-copy))))) 15969 (vhdl-subprog-copy))))
15954 (error (error "ERROR: %s not scanned successfully\n (%s)" 15970 (error (error "ERROR: %s not scanned successfully\n (%s)"
15955 (if is-entity "Port" "Interface") (cadr info)))) 15971 (if is-entity "Port" "Interface") (cadr info))))
15956 (error "ERROR: No entity/component or subprogram on current line"))))) 15972 (error "ERROR: No entity/component or subprogram on current line")))))
@@ -16140,7 +16156,7 @@ expansion function)."
16140 16156
16141;; initialize speedbar 16157;; initialize speedbar
16142(if (not (boundp 'speedbar-frame)) 16158(if (not (boundp 'speedbar-frame))
16143 (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)) 16159 (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize))
16144 (vhdl-speedbar-initialize) 16160 (vhdl-speedbar-initialize)
16145 (when speedbar-frame (vhdl-speedbar-refresh))) 16161 (when speedbar-frame (vhdl-speedbar-refresh)))
16146 16162
@@ -16168,7 +16184,7 @@ expansion function)."
16168 (read-from-minibuffer "architecture name: " 16184 (read-from-minibuffer "architecture name: "
16169 nil vhdl-minibuffer-local-map) 16185 nil vhdl-minibuffer-local-map)
16170 (vhdl-replace-string vhdl-compose-architecture-name ent-name))) 16186 (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
16171 ent-file-name arch-file-name ent-buffer arch-buffer project end-pos) 16187 ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project
16172 (message "Creating component \"%s(%s)\"..." ent-name arch-name) 16188 (message "Creating component \"%s(%s)\"..." ent-name arch-name)
16173 ;; open entity file 16189 ;; open entity file
16174 (unless (eq vhdl-compose-create-files 'none) 16190 (unless (eq vhdl-compose-create-files 'none)
@@ -16368,7 +16384,7 @@ component instantiation."
16368 (if comp-name 16384 (if comp-name
16369 ;; ... from component declaration 16385 ;; ... from component declaration
16370 (vhdl-visit-file 16386 (vhdl-visit-file
16371 (when vhdl-use-components-package pack-file-name) t 16387 (when vhdl-use-components-package pack-file-name) t
16372 (save-excursion 16388 (save-excursion
16373 (goto-char (point-min)) 16389 (goto-char (point-min))
16374 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) 16390 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
@@ -16379,7 +16395,7 @@ component instantiation."
16379 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) 16395 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
16380 "." (file-name-extension (buffer-file-name)))) 16396 "." (file-name-extension (buffer-file-name))))
16381 (vhdl-visit-file 16397 (vhdl-visit-file
16382 comp-ent-file-name t 16398 comp-ent-file-name t
16383 (save-excursion 16399 (save-excursion
16384 (goto-char (point-min)) 16400 (goto-char (point-min))
16385 (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) 16401 (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
@@ -16652,6 +16668,8 @@ component instantiation."
16652 (vhdl-comment-insert-inline (nth 4 entry) t)) 16668 (vhdl-comment-insert-inline (nth 4 entry) t))
16653 (insert "\n")) 16669 (insert "\n"))
16654 16670
16671(defvar lazy-lock-minimum-size)
16672
16655(defun vhdl-compose-components-package () 16673(defun vhdl-compose-components-package ()
16656 "Generate a package containing component declarations for all entities in the 16674 "Generate a package containing component declarations for all entities in the
16657current project/directory." 16675current project/directory."
@@ -16704,10 +16722,10 @@ current project/directory."
16704 ;; insert component declarations 16722 ;; insert component declarations
16705 (while ent-alist 16723 (while ent-alist
16706 (vhdl-visit-file (nth 2 (car ent-alist)) nil 16724 (vhdl-visit-file (nth 2 (car ent-alist)) nil
16707 (progn (goto-char (point-min)) 16725 (goto-char (point-min))
16708 (forward-line (1- (nth 3 (car ent-alist)))) 16726 (forward-line (1- (nth 3 (car ent-alist))))
16709 (end-of-line) 16727 (end-of-line)
16710 (vhdl-port-copy))) 16728 (vhdl-port-copy))
16711 (goto-char component-pos) 16729 (goto-char component-pos)
16712 (vhdl-port-paste-component t) 16730 (vhdl-port-paste-component t)
16713 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) 16731 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
@@ -16721,13 +16739,16 @@ current project/directory."
16721 (message "Generating components package \"%s\"...done\n File created: \"%s\"" 16739 (message "Generating components package \"%s\"...done\n File created: \"%s\""
16722 pack-name pack-file-name))) 16740 pack-name pack-file-name)))
16723 16741
16724(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist 16742(defun vhdl-compose-configuration-architecture ( _ent-name arch-name
16725 conf-alist inst-alist 16743 ent-alist-arg conf-alist-arg
16726 &optional insert-conf) 16744 inst-alist
16745 &optional insert-conf)
16727 "Generate block configuration for architecture." 16746 "Generate block configuration for architecture."
16728 (let ((margin (current-indentation)) 16747 (let ((ent-alist ent-alist-arg)
16748 (conf-alist conf-alist-arg)
16749 (margin (current-indentation))
16729 (beg (point-at-bol)) 16750 (beg (point-at-bol))
16730 ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) 16751 ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key
16731 ;; insert block configuration (for architecture) 16752 ;; insert block configuration (for architecture)
16732 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 16753 (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
16733 (setq margin (+ margin vhdl-basic-offset)) 16754 (setq margin (+ margin vhdl-basic-offset))
@@ -17078,7 +17099,7 @@ do not print any file names."
17078 (file-relative-name (buffer-file-name)))) 17099 (file-relative-name (buffer-file-name))))
17079 (when (and (= 0 (nth 1 (nth 10 compiler))) 17100 (when (and (= 0 (nth 1 (nth 10 compiler)))
17080 (= 0 (nth 1 (nth 11 compiler)))) 17101 (= 0 (nth 1 (nth 11 compiler))))
17081 (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) 17102 (setq compilation-process-setup-function #'vhdl-compile-print-file-name))
17082 ;; run compilation 17103 ;; run compilation
17083 (if options 17104 (if options
17084 (when command 17105 (when command
@@ -17152,7 +17173,7 @@ specified by a target."
17152 vhdl-error-regexp-emacs-alist))) 17173 vhdl-error-regexp-emacs-alist)))
17153 17174
17154(when vhdl-emacs-22 17175(when vhdl-emacs-22
17155 (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) 17176 (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs))
17156 17177
17157;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17178;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17158;; Makefile generation 17179;; Makefile generation
@@ -17431,7 +17452,7 @@ specified by a target."
17431 (setq tmp-list rule-alist) 17452 (setq tmp-list rule-alist)
17432 (while tmp-list ; pre-sort rule targets 17453 (while tmp-list ; pre-sort rule targets
17433 (setq cell (cdar tmp-list)) 17454 (setq cell (cdar tmp-list))
17434 (setcar cell (sort (car cell) 'string<)) 17455 (setcar cell (sort (car cell) #'string<))
17435 (setq tmp-list (cdr tmp-list))) 17456 (setq tmp-list (cdr tmp-list)))
17436 (setq rule-alist ; sort by first rule target 17457 (setq rule-alist ; sort by first rule target
17437 (sort rule-alist 17458 (sort rule-alist
@@ -17521,9 +17542,9 @@ specified by a target."
17521 ;; insert rule for each library unit 17542 ;; insert rule for each library unit
17522 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") 17543 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
17523 (while prim-list 17544 (while prim-list
17524 (setq second-list (sort (nth 1 (car prim-list)) 'string<)) 17545 (setq second-list (sort (nth 1 (car prim-list)) #'string<))
17525 (setq subcomp-list 17546 (setq subcomp-list
17526 (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) 17547 (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<))
17527 (setq unit-key (caar prim-list) 17548 (setq unit-key (caar prim-list)
17528 unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) 17549 unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
17529 (nth 0 (vhdl-aget conf-alist unit-key)) 17550 (nth 0 (vhdl-aget conf-alist unit-key))
@@ -17553,7 +17574,7 @@ specified by a target."
17553 (vhdl-get-compile-options project compiler (nth 0 rule) t)) 17574 (vhdl-get-compile-options project compiler (nth 0 rule) t))
17554 ;; insert rule if file is supposed to be compiled 17575 ;; insert rule if file is supposed to be compiled
17555 (setq target-list (nth 1 rule) 17576 (setq target-list (nth 1 rule)
17556 depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) 17577 depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<))
17557 ;; insert targets 17578 ;; insert targets
17558 (setq tmp-list target-list) 17579 (setq tmp-list target-list)
17559 (while target-list 17580 (while target-list
@@ -17576,7 +17597,8 @@ specified by a target."
17576 (if (eq options 'default) "$(OPTIONS)" options) " " 17597 (if (eq options 'default) "$(OPTIONS)" options) " "
17577 (nth 0 rule) 17598 (nth 0 rule)
17578 (if (equal vhdl-compile-post-command "") "" 17599 (if (equal vhdl-compile-post-command "") ""
17579 " $(POST-COMPILE)") "\n") 17600 " $(POST-COMPILE)")
17601 "\n")
17580 (insert "\n")) 17602 (insert "\n"))
17581 (unless (and options mapping-exist) 17603 (unless (and options mapping-exist)
17582 (setq tmp-list target-list) 17604 (setq tmp-list target-list)
@@ -17616,6 +17638,7 @@ specified by a target."
17616 "Submit via mail a bug report on VHDL Mode." 17638 "Submit via mail a bug report on VHDL Mode."
17617 (interactive) 17639 (interactive)
17618 ;; load in reporter 17640 ;; load in reporter
17641 (defvar reporter-prompt-for-summary-p)
17619 (and 17642 (and
17620 (y-or-n-p "Do you want to submit a report on VHDL Mode? ") 17643 (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
17621 (let ((reporter-prompt-for-summary-p t)) 17644 (let ((reporter-prompt-for-summary-p t))
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 7bf2f71822a..72cbcf8bd68 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -1,4 +1,4 @@
1;;; ps-bdf.el --- BDF font file handler for ps-print 1;;; ps-bdf.el --- BDF font file handler for ps-print -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 4;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
@@ -138,7 +138,7 @@ See the documentation of the function `bdf-read-font-info' for more detail."
138(defun bdf-initialize () 138(defun bdf-initialize ()
139 "Initialize `bdf' library." 139 "Initialize `bdf' library."
140 (and (bdf-read-cache) 140 (and (bdf-read-cache)
141 (add-hook 'kill-emacs-hook 'bdf-write-cache))) 141 (add-hook 'kill-emacs-hook #'bdf-write-cache)))
142 142
143(defun bdf-compact-code (code code-range) 143(defun bdf-compact-code (code code-range)
144 (if (or (< code (aref code-range 4)) 144 (if (or (< code (aref code-range 4))
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index db86f9400e7..a8b5210e965 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,4 +1,4 @@
1;;; ps-mule.el --- provide multi-byte character facility to ps-print 1;;; ps-mule.el --- provide multi-byte character facility to ps-print -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1998-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
4 4
@@ -612,7 +612,7 @@ f2, f3, h0, h1, and H0 respectively."
612 (push (/ code 256) code-list) 612 (push (/ code 256) code-list)
613 (push (% code 256) code-list)))) 613 (push (% code 256) code-list))))
614 (forward-char 1))) 614 (forward-char 1)))
615 (apply 'unibyte-string (nreverse code-list)))) 615 (apply #'unibyte-string (nreverse code-list))))
616 616
617(defun ps-mule-plot-composition (composition font-spec-table) 617(defun ps-mule-plot-composition (composition font-spec-table)
618 "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE." 618 "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE."
@@ -1041,10 +1041,11 @@ Any other value is treated as \"/H0\"."
1041 (list (ps-mule-encode-region (point-min) (point-max) 1041 (list (ps-mule-encode-region (point-min) (point-max)
1042 (aref ps-mule-font-spec-tables 1042 (aref ps-mule-font-spec-tables
1043 (aref ps-mule-font-number-to-type 1043 (aref ps-mule-font-number-to-type
1044 (cond ((string= fonttag "/h0") 4) 1044 (pcase fonttag
1045 ((string= fonttag "/h1") 5) 1045 ("/h0" 4)
1046 ((string= fonttag "/L0") 6) 1046 ("/h1" 5)
1047 (t 0)))))))) 1047 ("/L0" 6)
1048 (_ 0))))))))
1048 1049
1049;;;###autoload 1050;;;###autoload
1050(defun ps-mule-begin-job (from to) 1051(defun ps-mule-begin-job (from to)
@@ -1055,20 +1056,17 @@ It checks if all multi-byte characters in the region are printable or not."
1055 (goto-char from) 1056 (goto-char from)
1056 (= (skip-chars-forward "\x00-\x7F" to) to))) 1057 (= (skip-chars-forward "\x00-\x7F" to) to)))
1057 ;; All characters can be printed by normal PostScript fonts. 1058 ;; All characters can be printed by normal PostScript fonts.
1058 (setq ps-basic-plot-string-function 'ps-basic-plot-string 1059 (setq ps-basic-plot-string-function #'ps-basic-plot-string
1059 ;; FIXME: Doesn't ps-encode-header-string-function take 2 args? 1060 ;; FIXME: Doesn't ps-encode-header-string-function take 2 args?
1060 ps-encode-header-string-function 'identity) 1061 ps-encode-header-string-function #'identity)
1061 (setq ps-basic-plot-string-function 'ps-mule-plot-string 1062 (setq ps-basic-plot-string-function #'ps-mule-plot-string
1062 ps-encode-header-string-function 'ps-mule-encode-header-string 1063 ps-encode-header-string-function #'ps-mule-encode-header-string
1063 ps-mule-font-info-database 1064 ps-mule-font-info-database
1064 (cond ((eq ps-multibyte-buffer 'non-latin-printer) 1065 (pcase ps-multibyte-buffer
1065 ps-mule-font-info-database-ps) 1066 ('non-latin-printer ps-mule-font-info-database-ps)
1066 ((eq ps-multibyte-buffer 'bdf-font) 1067 ('bdf-font ps-mule-font-info-database-bdf)
1067 ps-mule-font-info-database-bdf) 1068 ('bdf-font-except-latin ps-mule-font-info-database-ps-bdf)
1068 ((eq ps-multibyte-buffer 'bdf-font-except-latin) 1069 (_ ps-mule-font-info-database-default)))
1069 ps-mule-font-info-database-ps-bdf)
1070 (t
1071 ps-mule-font-info-database-default)))
1072 1070
1073 ;; Be sure to have font information for Latin-1. 1071 ;; Be sure to have font information for Latin-1.
1074 (or (assq 'iso-8859-1 ps-mule-font-info-database) 1072 (or (assq 'iso-8859-1 ps-mule-font-info-database)
@@ -1112,10 +1110,12 @@ It checks if all multi-byte characters in the region are printable or not."
1112 id-max (1+ id-max)) 1110 id-max (1+ id-max))
1113 (if (ps-mule-check-font font-spec) 1111 (if (ps-mule-check-font font-spec)
1114 (aset font-spec-vec 1112 (aset font-spec-vec
1115 (cond ((eq (car e) 'normal) 0) 1113 (pcase (car e)
1116 ((eq (car e) 'bold) 1) 1114 ('normal 0)
1117 ((eq (car e) 'italic) 2) 1115 ('bold 1)
1118 (t 3)) font-spec))) 1116 ('italic 2)
1117 (_ 3))
1118 font-spec)))
1119 (when (aref font-spec-vec 0) 1119 (when (aref font-spec-vec 0)
1120 (or (aref font-spec-vec 3) 1120 (or (aref font-spec-vec 3)
1121 (aset font-spec-vec 3 (or (aref font-spec-vec 1) 1121 (aset font-spec-vec 3 (or (aref font-spec-vec 1)
@@ -1182,7 +1182,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
1182 (let ((output-head (list t)) 1182 (let ((output-head (list t))
1183 (ps-mule-output-list (list t))) 1183 (ps-mule-output-list (list t)))
1184 (dotimes (i 4) 1184 (dotimes (i 4)
1185 (map-char-table 'ps-mule-prepare-glyph 1185 (map-char-table #'ps-mule-prepare-glyph
1186 (aref ps-mule-font-spec-tables i))) 1186 (aref ps-mule-font-spec-tables i)))
1187 (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head) 1187 (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
1188 (ps-output-prologue (cdr output-head))) 1188 (ps-output-prologue (cdr output-head)))
diff --git a/lisp/rect.el b/lisp/rect.el
index cb941b46009..504be41b673 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -652,7 +652,7 @@ with a prefix argument, prompt for START-AT and FORMAT."
652 "Toggle the region as rectangular. 652 "Toggle the region as rectangular.
653 653
654Activates the region if needed. Only lasts until the region is deactivated." 654Activates the region if needed. Only lasts until the region is deactivated."
655 nil nil nil 655 :lighter nil
656 (rectangle--reset-crutches) 656 (rectangle--reset-crutches)
657 (when rectangle-mark-mode 657 (when rectangle-mark-mode
658 (add-hook 'deactivate-mark-hook 658 (add-hook 'deactivate-mark-hook
diff --git a/lisp/repeat.el b/lisp/repeat.el
index a2b04b81b03..f1b20d369bf 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -342,6 +342,29 @@ For example, you can set it to <return> like `isearch-exit'."
342 :group 'convenience 342 :group 'convenience
343 :version "28.1") 343 :version "28.1")
344 344
345(defcustom repeat-keep-prefix t
346 "Keep the prefix arg of the previous command."
347 :type 'boolean
348 :group 'convenience
349 :version "28.1")
350
351(defcustom repeat-mode-echo #'repeat-mode-message
352 "Function to display a hint about available keys.
353Function is called after every repeatable command with one argument:
354a string with a list of keys."
355 :type '(choice (const :tag "Show hints in the echo area"
356 repeat-mode-message)
357 (const :tag "Don't show hints" ignore)
358 (function :tag "Function"))
359 :group 'convenience
360 :version "28.1")
361
362;;;###autoload
363(defvar repeat-map nil
364 "The value of the repeating map for the next command.
365A command called from the map can set it again to the same map when
366the map can't be set on the command symbol property `repeat-map'.")
367
345;;;###autoload 368;;;###autoload
346(define-minor-mode repeat-mode 369(define-minor-mode repeat-mode
347 "Toggle Repeat mode. 370 "Toggle Repeat mode.
@@ -364,41 +387,50 @@ When Repeat mode is enabled, and the command symbol has the property named
364(defun repeat-post-hook () 387(defun repeat-post-hook ()
365 "Function run after commands to set transient keymap for repeatable keys." 388 "Function run after commands to set transient keymap for repeatable keys."
366 (when repeat-mode 389 (when repeat-mode
367 (let ((repeat-map (and (symbolp this-command) 390 (let ((rep-map (or repeat-map
368 (get this-command 'repeat-map)))) 391 (and (symbolp real-this-command)
369 (when repeat-map 392 (get real-this-command 'repeat-map)))))
370 (when (boundp repeat-map) 393 (when rep-map
371 (setq repeat-map (symbol-value repeat-map))) 394 (when (boundp rep-map)
372 (let ((map (copy-keymap repeat-map)) 395 (setq rep-map (symbol-value rep-map)))
373 keys mess) 396 (let ((map (copy-keymap rep-map))
374 (map-keymap (lambda (key _) (push key keys)) map) 397 keys)
375 398
376 ;; Exit when the last char is not among repeatable keys, 399 ;; Exit when the last char is not among repeatable keys,
377 ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. 400 ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
378 (when (or (memq last-command-event keys) 401 (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
379 (memq this-original-command '(universal-argument 402 (or (lookup-key map (this-command-keys-vector))
380 universal-argument-more 403 prefix-arg))
381 digit-argument 404
382 negative-argument)))
383 ;; Messaging 405 ;; Messaging
384 (setq mess (format-message 406 (unless prefix-arg
385 "Repeat with %s%s" 407 (map-keymap (lambda (key _) (push key keys)) map)
386 (mapconcat (lambda (key) 408 (let ((mess (format-message
387 (key-description (vector key))) 409 "Repeat with %s%s"
388 keys ", ") 410 (mapconcat (lambda (key)
389 (if repeat-exit-key 411 (key-description (vector key)))
390 (format ", or exit with %s" 412 keys ", ")
391 (key-description repeat-exit-key)) 413 (if repeat-exit-key
392 ""))) 414 (format ", or exit with %s"
393 (if (current-message) 415 (key-description repeat-exit-key))
394 (message "%s [%s]" (current-message) mess) 416 ""))))
395 (message mess)) 417 (funcall repeat-mode-echo mess)))
396 418
397 ;; Adding an exit key 419 ;; Adding an exit key
398 (when repeat-exit-key 420 (when repeat-exit-key
399 (define-key map repeat-exit-key 'ignore)) 421 (define-key map repeat-exit-key 'ignore))
400 422
401 (set-transient-map map))))))) 423 (when (and repeat-keep-prefix (not prefix-arg))
424 (setq prefix-arg current-prefix-arg))
425
426 (set-transient-map map))))))
427 (setq repeat-map nil))
428
429(defun repeat-mode-message (mess)
430 "Function that displays available repeating keys in the echo area."
431 (if (current-message)
432 (message "%s [%s]" (current-message) mess)
433 (message mess)))
402 434
403(provide 'repeat) 435(provide 'repeat)
404 436
diff --git a/lisp/replace.el b/lisp/replace.el
index f131d263ec6..71c6e651c74 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1477,15 +1477,22 @@ If the value is nil, don't highlight the buffer names specially."
1477 1477
1478(defcustom list-matching-lines-jump-to-current-line nil 1478(defcustom list-matching-lines-jump-to-current-line nil
1479 "If non-nil, \\[list-matching-lines] shows the current line highlighted. 1479 "If non-nil, \\[list-matching-lines] shows the current line highlighted.
1480Set the point right after such line when there are matches after it." 1480The current line for this purpose is the line of the original buffer
1481which was current when \\[list-matching-lines] was invoked.
1482Point in the `*Occur*' buffer will be set right after such line when
1483there are matches after it."
1481:type 'boolean 1484:type 'boolean
1482:group 'matching 1485:group 'matching
1483:version "26.1") 1486:version "26.1")
1484 1487
1485(defcustom list-matching-lines-prefix-face 'shadow 1488(defcustom list-matching-lines-prefix-face 'shadow
1486 "Face used by \\[list-matching-lines] to show the prefix column. 1489 "Face used by \\[list-matching-lines] to show the prefix column.
1487If the face doesn't differ from the default face, 1490The prefix column is the part of display that precedes the actual
1488don't highlight the prefix with line numbers specially." 1491contents of the line; it normally shows the line number. \(For
1492multiline matches, the prefix column shows the line number for the
1493first line and whitespace for the rest of the lines.\)
1494If this face will display the same as the default face, the prefix
1495column will not be highlighted speciall."
1489 :type 'face 1496 :type 'face
1490 :group 'matching 1497 :group 'matching
1491 :version "24.4") 1498 :version "24.4")
@@ -1565,11 +1572,24 @@ REGION must be a list of (START . END) positions as returned by
1565`region-bounds'. 1572`region-bounds'.
1566 1573
1567The lines are shown in a buffer named `*Occur*'. 1574The lines are shown in a buffer named `*Occur*'.
1568It serves as a menu to find any of the occurrences in this buffer. 1575That buffer can serve as a menu for finding any of the matches for REGEXP
1576in the current buffer.
1569\\<occur-mode-map>\\[describe-mode] in that buffer will explain how. 1577\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
1570If `list-matching-lines-jump-to-current-line' is non-nil, then show 1578
1571the current line highlighted with `list-matching-lines-current-line-face' 1579Matches for REGEXP are shown in the face determined by the
1572and set point at the first match after such line. 1580variable `list-matching-lines-face'.
1581Names of buffers with matched lines are shown in the face determined
1582by the variable `list-matching-lines-buffer-name-face'.
1583The line numbers of the matching lines are shown in the face
1584determined by the variable `list-matching-lines-prefix-face'.
1585
1586If `list-matching-lines-jump-to-current-line' is non-nil, then the
1587line in the current buffer which was current when the command was
1588invoked will be shown in the `*Occur*' buffer highlighted with
1589the `list-matching-lines-current-line-face', with point at the end
1590of that line. (If the current line doesn't match REGEXP, it will
1591nonetheless be inserted into the `*Occur*' buffer between the 2
1592closest lines that do match REGEXP.)
1573 1593
1574If REGEXP contains upper case characters (excluding those preceded by `\\') 1594If REGEXP contains upper case characters (excluding those preceded by `\\')
1575and `search-upper-case' is non-nil, the matching is case-sensitive. 1595and `search-upper-case' is non-nil, the matching is case-sensitive.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 11226fda020..a0d4f6e96c2 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -568,8 +568,6 @@ format first."
568;;;###autoload 568;;;###autoload
569(define-minor-mode ruler-mode 569(define-minor-mode ruler-mode
570 "Toggle display of ruler in header line (Ruler mode)." 570 "Toggle display of ruler in header line (Ruler mode)."
571 nil nil
572 ruler-mode-map
573 :group 'ruler-mode 571 :group 'ruler-mode
574 :variable (ruler-mode 572 :variable (ruler-mode
575 . (lambda (enable) 573 . (lambda (enable)
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index 8ba0cc9e032..415244f9e92 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -108,7 +108,7 @@ ARG is like in `end-of-buffer'."
108 108
109When Scroll-All mode is enabled, scrolling commands invoked in 109When Scroll-All mode is enabled, scrolling commands invoked in
110one window apply to all visible windows in the same frame." 110one window apply to all visible windows in the same frame."
111 nil " *SL*" nil 111 :lighter " *SL*"
112 :global t 112 :global t
113 :group 'windows 113 :group 'windows
114 (if scroll-all-mode 114 (if scroll-all-mode
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index a03965cf6c7..f39f17329f2 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,4 +1,4 @@
1;;; shadowfile.el --- automatic file copying 1;;; shadowfile.el --- automatic file copying -*- 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
@@ -90,27 +90,23 @@
90 "If t, always copy shadow files without asking. 90 "If t, always copy shadow files without asking.
91If nil (the default), always ask. If not nil and not t, ask only if there 91If nil (the default), always ask. If not nil and not t, ask only if there
92is no buffer currently visiting the file." 92is no buffer currently visiting the file."
93 :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)) 93 :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)))
94 :group 'shadow)
95 94
96(defcustom shadow-inhibit-message nil 95(defcustom shadow-inhibit-message nil
97 "If non-nil, do not display a message when a file needs copying." 96 "If non-nil, do not display a message when a file needs copying."
98 :type 'boolean 97 :type 'boolean)
99 :group 'shadow)
100 98
101(defcustom shadow-inhibit-overload nil 99(defcustom shadow-inhibit-overload nil
102 "If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs]. 100 "If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs].
103Normally it overloads the function `save-buffers-kill-emacs' to check for 101Normally it overloads the function `save-buffers-kill-emacs' to check for
104files that have been changed and need to be copied to other systems." 102files that have been changed and need to be copied to other systems."
105 :type 'boolean 103 :type 'boolean)
106 :group 'shadow)
107 104
108(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows") 105(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows")
109 "File to keep shadow information in. 106 "File to keep shadow information in.
110The `shadow-info-file' should be shadowed to all your accounts to 107The `shadow-info-file' should be shadowed to all your accounts to
111ensure consistency. Default: ~/.emacs.d/shadows" 108ensure consistency. Default: ~/.emacs.d/shadows"
112 :type 'file 109 :type 'file
113 :group 'shadow
114 :version "26.2") 110 :version "26.2")
115 111
116(defcustom shadow-todo-file 112(defcustom shadow-todo-file
@@ -122,13 +118,12 @@ remember and ask you again in your next Emacs session.
122This file must NOT be shadowed to any other system, it is host-specific. 118This file must NOT be shadowed to any other system, it is host-specific.
123Default: ~/.emacs.d/shadow_todo" 119Default: ~/.emacs.d/shadow_todo"
124 :type 'file 120 :type 'file
125 :group 'shadow
126 :version "26.2") 121 :version "26.2")
127 122
128 123
129;;; The following two variables should in most cases initialize themselves 124;; The following two variables should in most cases initialize themselves
130;;; correctly. They are provided as variables in case the defaults are wrong 125;; correctly. They are provided as variables in case the defaults are wrong
131;;; on your machine (and for efficiency). 126;; on your machine (and for efficiency).
132 127
133(defvar shadow-system-name (concat "/" (system-name) ":") 128(defvar shadow-system-name (concat "/" (system-name) ":")
134 "The identification for local files on this machine.") 129 "The identification for local files on this machine.")
@@ -160,7 +155,7 @@ created by `shadow-define-regexp-group'.")
160(defvar shadow-files-to-copy nil) ; List of files that need to 155(defvar shadow-files-to-copy nil) ; List of files that need to
161 ; be copied to remote hosts. 156 ; be copied to remote hosts.
162 157
163(defvar shadow-hashtable nil) ; for speed 158(defvar shadow-hashtable (make-hash-table :test #'equal)) ; for speed
164 159
165(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file 160(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
166(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file 161(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
@@ -191,11 +186,11 @@ PREFIX."
191;;; Clusters and sites 186;;; Clusters and sites
192;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 187;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
193 188
194;;; I use the term `site' to refer to a string which may be the 189;; I use the term `site' to refer to a string which may be the
195;;; cluster identification "/name:", a remote identification 190;; cluster identification "/name:", a remote identification
196;;; "/method:user@host:", or "/system-name:" (the value of 191;; "/method:user@host:", or "/system-name:" (the value of
197;;; `shadow-system-name') for the location of local files. All 192;; `shadow-system-name') for the location of local files. All
198;;; user-level commands should accept either. 193;; user-level commands should accept either.
199 194
200(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp) 195(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp)
201 196
@@ -580,7 +575,7 @@ be shadowed), and list of SITES."
580Filename should have clusters expanded, but otherwise can have any format. 575Filename should have clusters expanded, but otherwise can have any format.
581Return value is a list of dotted pairs like (from . to), where from 576Return value is a list of dotted pairs like (from . to), where from
582and to are absolute file names." 577and to are absolute file names."
583 (or (symbol-value (intern-soft file shadow-hashtable)) 578 (or (gethash file shadow-hashtable)
584 (let* ((absolute-file (shadow-expand-file-name 579 (let* ((absolute-file (shadow-expand-file-name
585 (or (shadow-local-file file) file) 580 (or (shadow-local-file file) file)
586 shadow-homedir)) 581 shadow-homedir))
@@ -598,7 +593,7 @@ and to are absolute file names."
598 "shadow-shadows-of: %s %s %s %s %s" 593 "shadow-shadows-of: %s %s %s %s %s"
599 file (shadow-local-file file) shadow-homedir 594 file (shadow-local-file file) shadow-homedir
600 absolute-file canonical-file)) 595 absolute-file canonical-file))
601 (set (intern file shadow-hashtable) shadows)))) 596 (puthash file shadows shadow-hashtable))))
602 597
603(defun shadow-shadows-of-1 (file groups regexp) 598(defun shadow-shadows-of-1 (file groups regexp)
604 "Return list of FILE's shadows in GROUPS. 599 "Return list of FILE's shadows in GROUPS.
@@ -639,7 +634,7 @@ Consider them as regular expressions if third arg REGEXP is true."
639 shadows shadow-files-to-copy (with-output-to-string (backtrace)))) 634 shadows shadow-files-to-copy (with-output-to-string (backtrace))))
640 (when shadows 635 (when shadows
641 (setq shadow-files-to-copy 636 (setq shadow-files-to-copy
642 (cl-union shadows shadow-files-to-copy :test #'equal)) 637 (nreverse (cl-union shadows shadow-files-to-copy :test #'equal)))
643 (when (not shadow-inhibit-message) 638 (when (not shadow-inhibit-message)
644 (message "%s" (substitute-command-keys 639 (message "%s" (substitute-command-keys
645 "Use \\[shadow-copy-files] to update shadows.")) 640 "Use \\[shadow-copy-files] to update shadows."))
@@ -735,7 +730,7 @@ With non-nil argument also saves the buffer."
735 (sit-for 1)))))) 730 (sit-for 1))))))
736 731
737(defun shadow-invalidate-hashtable () 732(defun shadow-invalidate-hashtable ()
738 (setq shadow-hashtable (make-vector 37 0))) 733 (clrhash shadow-hashtable))
739 734
740(defun shadow-insert-var (variable) 735(defun shadow-insert-var (variable)
741 "Build a `setq' to restore VARIABLE. 736 "Build a `setq' to restore VARIABLE.
@@ -744,17 +739,17 @@ will restore VARIABLE to its current setting.
744VARIABLE must be the name of a variable whose value is a list." 739VARIABLE must be the name of a variable whose value is a list."
745 (let ((standard-output (current-buffer))) 740 (let ((standard-output (current-buffer)))
746 (insert (format "(setq %s" variable)) 741 (insert (format "(setq %s" variable))
747 (cond ((consp (eval variable)) 742 (cond ((consp (symbol-value variable))
748 (insert "\n '(") 743 (insert "\n '(")
749 (prin1 (car (eval variable))) 744 (prin1 (car (symbol-value variable)))
750 (let ((rest (cdr (eval variable)))) 745 (let ((rest (cdr (symbol-value variable))))
751 (while rest 746 (while rest
752 (insert "\n ") 747 (insert "\n ")
753 (prin1 (car rest)) 748 (prin1 (car rest))
754 (setq rest (cdr rest))) 749 (setq rest (cdr rest)))
755 (insert "))\n\n"))) 750 (insert "))\n\n")))
756 (t (insert " ") 751 (t (insert " ")
757 (prin1 (eval variable)) 752 (prin1 (symbol-value variable))
758 (insert ")\n\n"))))) 753 (insert ")\n\n")))))
759 754
760(defun shadow-save-buffers-kill-emacs (&optional arg) 755(defun shadow-save-buffers-kill-emacs (&optional arg)
@@ -763,6 +758,11 @@ With prefix arg, silently save all file-visiting buffers, then kill.
763 758
764Extended by shadowfile to automatically save `shadow-todo-file' and 759Extended by shadowfile to automatically save `shadow-todo-file' and
765look for files that have been changed and need to be copied to other systems." 760look for files that have been changed and need to be copied to other systems."
761 (interactive "P")
762 (shadow--save-buffers-kill-emacs arg)
763 (save-buffers-kill-emacs arg))
764
765(defun shadow--save-buffers-kill-emacs (&optional arg &rest _)
766 ;; This function is necessary because we need to get control and save 766 ;; This function is necessary because we need to get control and save
767 ;; the todo file /after/ saving other files, but /before/ the warning 767 ;; the todo file /after/ saving other files, but /before/ the warning
768 ;; message about unsaved buffers (because it can get modified by the 768 ;; message about unsaved buffers (because it can get modified by the
@@ -770,27 +770,10 @@ look for files that have been changed and need to be copied to other systems."
770 ;; because it is not called at the correct time, and also because it is 770 ;; because it is not called at the correct time, and also because it is
771 ;; called when the terminal is disconnected and we cannot ask whether 771 ;; called when the terminal is disconnected and we cannot ask whether
772 ;; to copy files. 772 ;; to copy files.
773 (interactive "P")
774 (shadow-save-todo-file) 773 (shadow-save-todo-file)
775 (save-some-buffers arg t) 774 (save-some-buffers arg t)
776 (shadow-copy-files) 775 (shadow-copy-files)
777 (shadow-save-todo-file) 776 (shadow-save-todo-file))
778 (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf)
779 (buffer-modified-p buf)))
780 (buffer-list))))
781 (yes-or-no-p "Modified buffers exist; exit anyway? "))
782 (or (not (fboundp 'process-list))
783 ;; `process-list' is not defined on MSDOS.
784 (let ((processes (process-list))
785 active)
786 (while processes
787 (and (memq (process-status (car processes)) '(run stop open listen))
788 (process-query-on-exit-flag (car processes))
789 (setq active t))
790 (setq processes (cdr processes)))
791 (or (not active)
792 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
793 (kill-emacs)))
794 777
795;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 778;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
796;;; Hook us up 779;;; Hook us up
@@ -809,19 +792,15 @@ look for files that have been changed and need to be copied to other systems."
809 (message "Shadowfile information files not found - aborting") 792 (message "Shadowfile information files not found - aborting")
810 (beep) 793 (beep)
811 (sit-for 3)) 794 (sit-for 3))
812 (when (and (not shadow-inhibit-overload) 795 (unless shadow-inhibit-overload
813 (not (fboundp 'shadow-orig-save-buffers-kill-emacs))) 796 (advice-add 'save-buffers-kill-emacs :before
814 (defalias 'shadow-orig-save-buffers-kill-emacs 797 #'shadow--save-buffers-kill-emacs))
815 (symbol-function 'save-buffers-kill-emacs)) 798 (add-hook 'write-file-functions #'shadow-add-to-todo)
816 (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs)) 799 (define-key ctl-x-4-map "s" #'shadow-copy-files)))
817 (add-hook 'write-file-functions 'shadow-add-to-todo)
818 (define-key ctl-x-4-map "s" 'shadow-copy-files)))
819 800
820(defun shadowfile-unload-function () 801(defun shadowfile-unload-function ()
821 (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map) 802 (substitute-key-definition #'shadow-copy-files nil ctl-x-4-map)
822 (when (fboundp 'shadow-orig-save-buffers-kill-emacs) 803 (advice-remove 'save-buffers-kill-emacs #'shadow--save-buffers-kill-emacs)
823 (fset 'save-buffers-kill-emacs
824 (symbol-function 'shadow-orig-save-buffers-kill-emacs)))
825 ;; continue standard unloading 804 ;; continue standard unloading
826 nil) 805 nil)
827 806
@@ -832,7 +811,7 @@ look for files that have been changed and need to be copied to other systems."
832(defun shadow-union (a b) 811(defun shadow-union (a b)
833 "Add members of list A to list B if not equal to items already in B." 812 "Add members of list A to list B if not equal to items already in B."
834 (declare (obsolete cl-union "28.1")) 813 (declare (obsolete cl-union "28.1"))
835 (cl-union a b :test #'equal)) 814 (nreverse (cl-union a b :test #'equal)))
836 815
837(define-obsolete-function-alias 'shadow-find #'seq-find "28.1") 816(define-obsolete-function-alias 'shadow-find #'seq-find "28.1")
838 817
diff --git a/lisp/shell.el b/lisp/shell.el
index cd99b008776..3098d3a14da 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -980,7 +980,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
980 980
981The `dirtrack' package provides an alternative implementation of 981The `dirtrack' package provides an alternative implementation of
982this feature; see the function `dirtrack-mode'." 982this feature; see the function `dirtrack-mode'."
983 nil nil nil 983 :lighter nil
984 (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) 984 (setq list-buffers-directory (if shell-dirtrack-mode default-directory))
985 (if shell-dirtrack-mode 985 (if shell-dirtrack-mode
986 (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t) 986 (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t)
diff --git a/lisp/simple.el b/lisp/simple.el
index c48e644345b..999755a642f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2798,7 +2798,6 @@ or to the last history element for a backward search."
2798 (if isearch-forward 2798 (if isearch-forward
2799 (goto-history-element (length (minibuffer-history-value))) 2799 (goto-history-element (length (minibuffer-history-value)))
2800 (goto-history-element 0)) 2800 (goto-history-element 0))
2801 (setq isearch-success t)
2802 (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max)))) 2801 (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
2803 2802
2804(defun minibuffer-history-isearch-push-state () 2803(defun minibuffer-history-isearch-push-state ()
diff --git a/lisp/so-long.el b/lisp/so-long.el
index f44d41dc5eb..f916b61b60f 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -1185,7 +1185,7 @@ current buffer, and buffer-local values are assigned to variables in accordance
1185with `so-long-variable-overrides'. 1185with `so-long-variable-overrides'.
1186 1186
1187This minor mode is a standard `so-long-action' option." 1187This minor mode is a standard `so-long-action' option."
1188 nil nil nil 1188 :lighter nil
1189 (if so-long-minor-mode ;; We are enabling the mode. 1189 (if so-long-minor-mode ;; We are enabling the mode.
1190 (progn 1190 (progn
1191 ;; Housekeeping. `so-long-minor-mode' might be invoked directly rather 1191 ;; Housekeeping. `so-long-minor-mode' might be invoked directly rather
diff --git a/lisp/startup.el b/lisp/startup.el
index 3e39ebc6e22..6e0faf3f68a 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1111,7 +1111,7 @@ please check its value")
1111 ("--no-x-resources") ("--debug-init") 1111 ("--no-x-resources") ("--debug-init")
1112 ("--user") ("--iconic") ("--icon-type") ("--quick") 1112 ("--user") ("--iconic") ("--icon-type") ("--quick")
1113 ("--no-blinking-cursor") ("--basic-display") 1113 ("--no-blinking-cursor") ("--basic-display")
1114 ("--dump-file") ("--temacs"))) 1114 ("--dump-file") ("--temacs") ("--seccomp")))
1115 (argi (pop args)) 1115 (argi (pop args))
1116 (orig-argi argi) 1116 (orig-argi argi)
1117 argval) 1117 argval)
@@ -1163,7 +1163,8 @@ please check its value")
1163 (push '(visibility . icon) initial-frame-alist)) 1163 (push '(visibility . icon) initial-frame-alist))
1164 ((member argi '("-nbc" "-no-blinking-cursor")) 1164 ((member argi '("-nbc" "-no-blinking-cursor"))
1165 (setq no-blinking-cursor t)) 1165 (setq no-blinking-cursor t))
1166 ((member argi '("-dump-file" "-temacs")) ; Handled in C 1166 ((member argi '("-dump-file" "-temacs" "-seccomp"))
1167 ;; Handled in C
1167 (or argval (pop args)) 1168 (or argval (pop args))
1168 (setq argval nil)) 1169 (setq argval nil))
1169 ;; Push the popped arg back on the list of arguments. 1170 ;; Push the popped arg back on the list of arguments.
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 4b682e99feb..575092a71d9 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1393,7 +1393,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
1393\\[strokes-decode-buffer]. 1393\\[strokes-decode-buffer].
1394 1394
1395\\{strokes-mode-map}" 1395\\{strokes-mode-map}"
1396 nil strokes-lighter strokes-mode-map :global t 1396 :lighter strokes-lighter :global t
1397 (cond ((not (display-mouse-p)) 1397 (cond ((not (display-mouse-p))
1398 (error "Can't use Strokes without a mouse")) 1398 (error "Can't use Strokes without a mouse"))
1399 (strokes-mode ; turn on strokes 1399 (strokes-mode ; turn on strokes
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 2e27b293c5e..f3c2fb7ed96 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -2075,6 +2075,28 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
2075(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab) 2075(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab)
2076(define-key tab-prefix-map "t" 'other-tab-prefix) 2076(define-key tab-prefix-map "t" 'other-tab-prefix)
2077 2077
2078(defvar tab-bar-switch-repeat-map
2079 (let ((map (make-sparse-keymap)))
2080 (define-key map "o" 'tab-next)
2081 (define-key map "O" 'tab-previous)
2082 map)
2083 "Keymap to repeat tab switch key sequences `C-x t o o O'.
2084Used in `repeat-mode'.")
2085(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
2086(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
2087
2088(defvar tab-bar-move-repeat-map
2089 (let ((map (make-sparse-keymap)))
2090 (define-key map "m" 'tab-move)
2091 (define-key map "M" (lambda ()
2092 (interactive)
2093 (setq repeat-map 'tab-bar-move-repeat-map)
2094 (tab-move -1)))
2095 map)
2096 "Keymap to repeat tab move key sequences `C-x t m m M'.
2097Used in `repeat-mode'.")
2098(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
2099
2078 2100
2079(provide 'tab-bar) 2101(provide 'tab-bar)
2080 2102
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index fa9b47556f7..3f0cca0ab7a 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -474,6 +474,7 @@ checksum before doing the check."
474 "Construct a `rw-r--r--' string indicating MODE. 474 "Construct a `rw-r--r--' string indicating MODE.
475MODE should be an integer which is a file mode value. 475MODE should be an integer which is a file mode value.
476For instance, if mode is #o700, then it produces `rwx------'." 476For instance, if mode is #o700, then it produces `rwx------'."
477 (declare (obsolete file-modes-number-to-symbolic "28.1"))
477 (substring (file-modes-number-to-symbolic mode) 1)) 478 (substring (file-modes-number-to-symbolic mode) 1))
478 479
479(defun tar-header-block-summarize (tar-hblock &optional mod-p) 480(defun tar-header-block-summarize (tar-hblock &optional mod-p)
@@ -489,25 +490,26 @@ For instance, if mode is #o700, then it produces `rwx------'."
489 ;; (ck (tar-header-checksum tar-hblock)) 490 ;; (ck (tar-header-checksum tar-hblock))
490 (type (tar-header-link-type tar-hblock)) 491 (type (tar-header-link-type tar-hblock))
491 (link-name (tar-header-link-name tar-hblock))) 492 (link-name (tar-header-link-name tar-hblock)))
492 (format "%c%c%s %7s/%-7s %7s%s %s%s" 493 (format "%c%s %7s/%-7s %7s%s %s%s"
493 (if mod-p ?* ? ) 494 (if mod-p ?* ? )
494 (cond ((or (eq type nil) (eq type 0)) ?-) 495 (file-modes-number-to-symbolic
495 ((eq type 1) ?h) ; link 496 mode
496 ((eq type 2) ?l) ; symlink 497 (cond ((or (eq type nil) (eq type 0)) ?-)
497 ((eq type 3) ?c) ; char special 498 ((eq type 1) ?h) ; link
498 ((eq type 4) ?b) ; block special 499 ((eq type 2) ?l) ; symlink
499 ((eq type 5) ?d) ; directory 500 ((eq type 3) ?c) ; char special
500 ((eq type 6) ?p) ; FIFO/pipe 501 ((eq type 4) ?b) ; block special
501 ((eq type 20) ?*) ; directory listing 502 ((eq type 5) ?d) ; directory
502 ((eq type 28) ?L) ; next has longname 503 ((eq type 6) ?p) ; FIFO/pipe
503 ((eq type 29) ?M) ; multivolume continuation 504 ((eq type 20) ?*) ; directory listing
504 ((eq type 35) ?S) ; sparse 505 ((eq type 28) ?L) ; next has longname
505 ((eq type 38) ?V) ; volume header 506 ((eq type 29) ?M) ; multivolume continuation
506 ((eq type 55) ?H) ; pax global extended header 507 ((eq type 35) ?S) ; sparse
507 ((eq type 72) ?X) ; pax extended header 508 ((eq type 38) ?V) ; volume header
508 (t ?\s) 509 ((eq type 55) ?H) ; pax global extended header
509 ) 510 ((eq type 72) ?X) ; pax extended header
510 (tar-grind-file-mode mode) 511 (t ?\s)
512 ))
511 (if (= 0 (length uname)) uid uname) 513 (if (= 0 (length uname)) uid uname)
512 (if (= 0 (length gname)) gid gname) 514 (if (= 0 (length gname)) gid gname)
513 size 515 size
@@ -751,7 +753,7 @@ into the tar-file buffer that it came from. The changes will
751actually appear on disk when you save the tar-file's buffer." 753actually appear on disk when you save the tar-file's buffer."
752 ;; Don't do this, because it is redundant and wastes mode line space. 754 ;; Don't do this, because it is redundant and wastes mode line space.
753 ;; :lighter " TarFile" 755 ;; :lighter " TarFile"
754 nil nil nil 756 :lighter nil
755 (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) 757 (or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
756 (error "This buffer is not an element of a tar file")) 758 (error "This buffer is not an element of a tar file"))
757 (cond (tar-subfile-mode 759 (cond (tar-subfile-mode
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index eb521134dc4..932308ee59d 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -3744,7 +3744,7 @@ SPC.
3744 3744
3745For spell-checking \"on the fly\", not just after typing SPC or 3745For spell-checking \"on the fly\", not just after typing SPC or
3746RET, use `flyspell-mode'." 3746RET, use `flyspell-mode'."
3747 nil " Spell" ispell-minor-keymap) 3747 :lighter " Spell" :keymap ispell-minor-keymap)
3748 3748
3749(defun ispell-minor-check () 3749(defun ispell-minor-check ()
3750 "Check previous word, then continue with the normal binding of this key. 3750 "Check previous word, then continue with the normal binding of this key.
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 53519ac3386..e710180d5f5 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -245,10 +245,10 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
245 (forward-paragraph 1) 245 (forward-paragraph 1)
246 (setq end (point)) 246 (setq end (point))
247 (setq found 247 (setq found
248 (refer-every (lambda (keyword) 248 (seq-every-p (lambda (keyword)
249 (goto-char begin) 249 (goto-char begin)
250 (re-search-forward keyword end t)) 250 (re-search-forward keyword end t))
251 keywords-list)) 251 keywords-list))
252 (if (not found) 252 (if (not found)
253 (progn 253 (progn
254 (setq begin end) 254 (setq begin end)
@@ -260,12 +260,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
260 (progn (message "Scanning %s... not found" file) 260 (progn (message "Scanning %s... not found" file)
261 nil)))) 261 nil))))
262 262
263(defun refer-every (pred l)
264 (cond ((null l) nil)
265 ((funcall pred (car l))
266 (or (null (cdr l))
267 (refer-every pred (cdr l))))))
268
269(defun refer-convert-string-to-list-of-strings (s) 263(defun refer-convert-string-to-list-of-strings (s)
270 (let ((current (current-buffer)) 264 (let ((current (current-buffer))
271 (temp-buffer (get-buffer-create "*refer-temp*"))) 265 (temp-buffer (get-buffer-create "*refer-temp*")))
@@ -391,4 +385,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
391 (setq refer-bib-files files)) 385 (setq refer-bib-files files))
392 files)) 386 files))
393 387
388(define-obsolete-function-alias 'refer-every #'seq-every-p "28.1")
389
394;;; refer.el ends here 390;;; refer.el ends here
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index cd76bf80f19..8a0436afc64 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -607,7 +607,7 @@ This sets `buffer-save-without-query' so that `save-some-buffers' will
607save the notes buffer without asking. 607save the notes buffer without asking.
608 608
609\\{remember-notes-mode-map}" 609\\{remember-notes-mode-map}"
610 nil nil nil 610 :lighter nil
611 (cond 611 (cond
612 (remember-notes-mode 612 (remember-notes-mode
613 (add-hook 'kill-buffer-query-functions 613 (add-hook 'kill-buffer-query-functions
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 56cca840047..1471be0ecd6 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1408,13 +1408,11 @@ highlighting.
1408When ReST minor mode is enabled, the ReST mode keybindings 1408When ReST minor mode is enabled, the ReST mode keybindings
1409are installed on top of the major mode bindings. Use this 1409are installed on top of the major mode bindings. Use this
1410for modes derived from Text mode, like Mail mode." 1410for modes derived from Text mode, like Mail mode."
1411 ;; The initial value. 1411 ;; The indicator for the mode line.
1412 nil 1412 :lighter " ReST"
1413 ;; The indicator for the mode line. 1413 ;; The minor mode bindings.
1414 " ReST" 1414 :keymap rst-mode-map
1415 ;; The minor mode bindings. 1415 :group 'rst)
1416 rst-mode-map
1417 :group 'rst)
1418 1416
1419;; FIXME: can I somehow install these too? 1417;; FIXME: can I somehow install these too?
1420;; :abbrev-table rst-mode-abbrev-table 1418;; :abbrev-table rst-mode-abbrev-table
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 6958ab8f658..67f731917e2 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -2440,7 +2440,7 @@ The third `match-string' will be the used in the menu.")
2440HTML Autoview mode is a buffer-local minor mode for use with 2440HTML Autoview mode is a buffer-local minor mode for use with
2441`html-mode'. If enabled, saving the file automatically runs 2441`html-mode'. If enabled, saving the file automatically runs
2442`browse-url-of-buffer' to view it." 2442`browse-url-of-buffer' to view it."
2443 nil nil nil 2443 :lighter nil
2444 (if html-autoview-mode 2444 (if html-autoview-mode
2445 (add-hook 'after-save-hook #'browse-url-of-buffer nil t) 2445 (add-hook 'after-save-hook #'browse-url-of-buffer nil t)
2446 (remove-hook 'after-save-hook #'browse-url-of-buffer t))) 2446 (remove-hook 'after-save-hook #'browse-url-of-buffer t)))
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 069c8e3f443..163978b4315 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -486,7 +486,7 @@ that space character is replaced by a hard space specified by
486When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space 486When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space
487representation for current major mode, the `tildify-space-string' buffer-local 487representation for current major mode, the `tildify-space-string' buffer-local
488variable will be set to the representation." 488variable will be set to the representation."
489 nil " ~" nil 489 :lighter " ~"
490 (when tildify-mode 490 (when tildify-mode
491 (let ((space (with-suppressed-warnings ((obsolete 491 (let ((space (with-suppressed-warnings ((obsolete
492 tildify--pick-alist-entry)) 492 tildify--pick-alist-entry))
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 56b31662210..eabbaba32c0 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -191,7 +191,8 @@ when this variable is set to nil.")
191(defconst log-edit-files-buf "*log-edit-files*") 191(defconst log-edit-files-buf "*log-edit-files*")
192(defvar log-edit-initial-files nil) 192(defvar log-edit-initial-files nil)
193(defvar log-edit-callback nil) 193(defvar log-edit-callback nil)
194(defvar log-edit-diff-function nil) 194(defvar log-edit-diff-function
195 (lambda () (error "Diff functionality has not been setup")))
195(defvar log-edit-listfun nil) 196(defvar log-edit-listfun nil)
196 197
197(defvar log-edit-parent-buffer nil) 198(defvar log-edit-parent-buffer nil)
@@ -659,9 +660,7 @@ Also saves its contents in the comment history and hides
659(defun log-edit-show-diff () 660(defun log-edit-show-diff ()
660 "Show the diff for the files to be committed." 661 "Show the diff for the files to be committed."
661 (interactive) 662 (interactive)
662 (if (functionp log-edit-diff-function) 663 (funcall log-edit-diff-function))
663 (funcall log-edit-diff-function)
664 (error "Diff functionality has not been setup")))
665 664
666(defun log-edit-show-files () 665(defun log-edit-show-files ()
667 "Show the list of files to be committed." 666 "Show the list of files to be committed."
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 6e039cc6256..42f531e4f75 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -331,7 +331,7 @@ the primary since reading the primary can deactivate it."
331 "This mode is used for buffers related to a main *cvs* buffer. 331 "This mode is used for buffers related to a main *cvs* buffer.
332All the `cvs-mode' buffer operations are simply rebound under 332All the `cvs-mode' buffer operations are simply rebound under
333the \\[cvs-mode-map] prefix." 333the \\[cvs-mode-map] prefix."
334 nil " CVS" 334 :lighter " CVS"
335 :group 'pcl-cvs) 335 :group 'pcl-cvs)
336(put 'cvs-minor-mode 'permanent-local t) 336(put 'cvs-minor-mode 'permanent-local t)
337 337
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index 0bd5132f7c3..bac0069b852 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -83,26 +83,24 @@
83 83
84(defun vt-keypad-on (&optional tell) 84(defun vt-keypad-on (&optional tell)
85 "Turn on the VT applications keypad." 85 "Turn on the VT applications keypad."
86 (interactive) 86 (interactive "p")
87 (send-string-to-terminal "\e=") 87 (send-string-to-terminal "\e=")
88 (setq vt-applications-keypad-p t) 88 (setq vt-applications-keypad-p t)
89 (if (or tell (called-interactively-p 'interactive)) 89 (if tell (message "Applications keypad enabled.")))
90 (message "Applications keypad enabled.")))
91 90
92(defun vt-keypad-off (&optional tell) 91(defun vt-keypad-off (&optional tell)
93 "Turn off the VT applications keypad." 92 "Turn off the VT applications keypad."
94 (interactive "p") 93 (interactive "p")
95 (send-string-to-terminal "\e>") 94 (send-string-to-terminal "\e>")
96 (setq vt-applications-keypad-p nil) 95 (setq vt-applications-keypad-p nil)
97 (if (or tell (called-interactively-p 'interactive)) 96 (if tell (message "Applications keypad disabled.")))
98 (message "Applications keypad disabled.")))
99 97
100(defun vt-numlock nil 98(defun vt-numlock (&optional tell)
101 "Toggle VT application keypad on and off." 99 "Toggle VT application keypad on and off."
102 (interactive) 100 (interactive "p")
103 (if vt-applications-keypad-p 101 (if vt-applications-keypad-p
104 (vt-keypad-off (called-interactively-p 'interactive)) 102 (vt-keypad-off tell)
105 (vt-keypad-on (called-interactively-p 'interactive)))) 103 (vt-keypad-on tell)))
106 104
107(provide 'vt-control) 105(provide 'vt-control)
108 106
diff --git a/lisp/window.el b/lisp/window.el
index f27631bb86a..071761ea50f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -10256,6 +10256,10 @@ displaying that processes's buffer."
10256(defvar other-window-repeat-map 10256(defvar other-window-repeat-map
10257 (let ((map (make-sparse-keymap))) 10257 (let ((map (make-sparse-keymap)))
10258 (define-key map "o" 'other-window) 10258 (define-key map "o" 'other-window)
10259 (define-key map "O" (lambda ()
10260 (interactive)
10261 (setq repeat-map 'other-window-repeat-map)
10262 (other-window -1)))
10259 map) 10263 map)
10260 "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") 10264 "Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
10261(put 'other-window 'repeat-map 'other-window-repeat-map) 10265(put 'other-window 'repeat-map 'other-window-repeat-map)
diff --git a/lisp/winner.el b/lisp/winner.el
index 9506ac53bb2..f30fa6cf5cf 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,4 +1,4 @@
1;;; winner.el --- Restore old window configurations 1;;; winner.el --- Restore old window configurations -*- 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 4
@@ -33,14 +33,13 @@
33;;; Code: 33;;; Code:
34 34
35(eval-when-compile (require 'cl-lib)) 35(eval-when-compile (require 'cl-lib))
36(require 'ring)
36 37
37(defun winner-active-region () 38(defun winner-active-region ()
38 (declare (gv-setter (lambda (store) 39 (declare (gv-setter (lambda (store)
39 `(if ,store (activate-mark) (deactivate-mark))))) 40 `(if ,store (activate-mark) (deactivate-mark)))))
40 (region-active-p)) 41 (region-active-p))
41 42
42(require 'ring)
43
44(defgroup winner nil 43(defgroup winner nil
45 "Restoring window configurations." 44 "Restoring window configurations."
46 :group 'windows) 45 :group 'windows)
@@ -273,7 +272,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
273 (let* ((buffers nil) 272 (let* ((buffers nil)
274 (alive 273 (alive
275 ;; Possibly update `winner-point-alist' 274 ;; Possibly update `winner-point-alist'
276 (cl-loop for buf in (mapcar 'cdr (cdr conf)) 275 (cl-loop for buf in (mapcar #'cdr (cdr conf))
277 for pos = (winner-get-point buf nil) 276 for pos = (winner-get-point buf nil)
278 if (and pos (not (memq buf buffers))) 277 if (and pos (not (memq buf buffers)))
279 do (push buf buffers) 278 do (push buf buffers)
@@ -317,7 +316,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
317 ;; Return t if this is still a possible configuration. 316 ;; Return t if this is still a possible configuration.
318 (or (null xwins) 317 (or (null xwins)
319 (progn 318 (progn
320 (mapc 'delete-window (cdr xwins)) ; delete all but one 319 (mapc #'delete-window (cdr xwins)) ; delete all but one
321 (unless (one-window-p t) 320 (unless (one-window-p t)
322 (delete-window (car xwins)) 321 (delete-window (car xwins))
323 t)))))) 322 t))))))
@@ -328,22 +327,20 @@ You may want to include buffer names such as *Help*, *Apropos*,
328 327
329(defcustom winner-mode-hook nil 328(defcustom winner-mode-hook nil
330 "Functions to run whenever Winner mode is turned on or off." 329 "Functions to run whenever Winner mode is turned on or off."
331 :type 'hook 330 :type 'hook)
332 :group 'winner)
333 331
334(define-obsolete-variable-alias 'winner-mode-leave-hook 332(define-obsolete-variable-alias 'winner-mode-leave-hook
335 'winner-mode-off-hook "24.3") 333 'winner-mode-off-hook "24.3")
336 334
337(defcustom winner-mode-off-hook nil 335(defcustom winner-mode-off-hook nil
338 "Functions to run whenever Winner mode is turned off." 336 "Functions to run whenever Winner mode is turned off."
339 :type 'hook 337 :type 'hook)
340 :group 'winner)
341 338
342(defvar winner-mode-map 339(defvar winner-mode-map
343 (let ((map (make-sparse-keymap))) 340 (let ((map (make-sparse-keymap)))
344 (unless winner-dont-bind-my-keys 341 (unless winner-dont-bind-my-keys
345 (define-key map [(control c) left] 'winner-undo) 342 (define-key map [(control c) left] #'winner-undo)
346 (define-key map [(control c) right] 'winner-redo)) 343 (define-key map [(control c) right] #'winner-redo))
347 map) 344 map)
348 "Keymap for Winner mode.") 345 "Keymap for Winner mode.")
349 346
diff --git a/src/emacs.c b/src/emacs.c
index d353679b0f0..e5940ce1de6 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -62,6 +62,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
62# include <sys/socket.h> 62# include <sys/socket.h>
63#endif 63#endif
64 64
65#if defined HAVE_LINUX_SECCOMP_H && defined HAVE_LINUX_FILTER_H \
66 && HAVE_DECL_SECCOMP_SET_MODE_FILTER \
67 && HAVE_DECL_SECCOMP_FILTER_FLAG_TSYNC
68# define SECCOMP_USABLE 1
69#else
70# define SECCOMP_USABLE 0
71#endif
72
73#if SECCOMP_USABLE
74# include <linux/seccomp.h>
75# include <linux/filter.h>
76# include <sys/prctl.h>
77# include <sys/syscall.h>
78#endif
79
65#ifdef HAVE_WINDOW_SYSTEM 80#ifdef HAVE_WINDOW_SYSTEM
66#include TERM_HEADER 81#include TERM_HEADER
67#endif /* HAVE_WINDOW_SYSTEM */ 82#endif /* HAVE_WINDOW_SYSTEM */
@@ -242,6 +257,11 @@ Initialization options:\n\
242--dump-file FILE read dumped state from FILE\n\ 257--dump-file FILE read dumped state from FILE\n\
243", 258",
244#endif 259#endif
260#if SECCOMP_USABLE
261 "\
262--sandbox=FILE read Seccomp BPF filter from FILE\n\
263"
264#endif
245 "\ 265 "\
246--no-build-details do not add build details such as time stamps\n\ 266--no-build-details do not add build details such as time stamps\n\
247--no-desktop do not load a saved desktop\n\ 267--no-desktop do not load a saved desktop\n\
@@ -977,12 +997,195 @@ load_pdump (int argc, char **argv, char const *original_pwd)
977} 997}
978#endif /* HAVE_PDUMPER */ 998#endif /* HAVE_PDUMPER */
979 999
1000#if SECCOMP_USABLE
1001
1002/* Wrapper function for the `seccomp' system call on GNU/Linux. This
1003 system call usually doesn't have a wrapper function. See the
1004 manual page of `seccomp' for the signature. */
1005
1006static int
1007emacs_seccomp (unsigned int operation, unsigned int flags, void *args)
1008{
1009#ifdef SYS_seccomp
1010 return syscall (SYS_seccomp, operation, flags, args);
1011#else
1012 errno = ENOSYS;
1013 return -1;
1014#endif
1015}
1016
1017/* Read SIZE bytes into BUFFER. Return the number of bytes read, or
1018 -1 if reading failed altogether. */
1019
1020static ptrdiff_t
1021read_full (int fd, void *buffer, ptrdiff_t size)
1022{
1023 eassert (0 <= fd);
1024 eassert (buffer != NULL);
1025 eassert (0 <= size);
1026 enum
1027 {
1028 /* See MAX_RW_COUNT in sysdep.c. */
1029#ifdef MAX_RW_COUNT
1030 max_size = MAX_RW_COUNT
1031#else
1032 max_size = INT_MAX >> 18 << 18
1033#endif
1034 };
1035 if (PTRDIFF_MAX < size || max_size < size)
1036 {
1037 errno = EFBIG;
1038 return -1;
1039 }
1040 char *ptr = buffer;
1041 ptrdiff_t read = 0;
1042 while (size != 0)
1043 {
1044 ptrdiff_t n = emacs_read (fd, ptr, size);
1045 if (n < 0)
1046 return -1;
1047 if (n == 0)
1048 break; /* Avoid infinite loop on encountering EOF. */
1049 eassert (n <= size);
1050 size -= n;
1051 ptr += n;
1052 read += n;
1053 }
1054 return read;
1055}
1056
1057/* Attempt to load Secure Computing filters from FILE. Return false
1058 if that doesn't work for some reason. */
1059
1060static bool
1061load_seccomp (const char *file)
1062{
1063 bool success = false;
1064 void *buffer = NULL;
1065 int fd
1066 = emacs_open_noquit (file, O_RDONLY | O_CLOEXEC | O_BINARY, 0);
1067 if (fd < 0)
1068 {
1069 emacs_perror ("open");
1070 goto out;
1071 }
1072 struct stat stat;
1073 if (fstat (fd, &stat) != 0)
1074 {
1075 emacs_perror ("fstat");
1076 goto out;
1077 }
1078 if (! S_ISREG (stat.st_mode))
1079 {
1080 fprintf (stderr, "seccomp file %s is not regular\n", file);
1081 goto out;
1082 }
1083 struct sock_fprog program;
1084 if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size
1085 || PTRDIFF_MAX <= stat.st_size
1086 || stat.st_size % sizeof *program.filter != 0)
1087 {
1088 fprintf (stderr, "seccomp filter %s has invalid size %ld\n",
1089 file, (long) stat.st_size);
1090 goto out;
1091 }
1092 size_t size = stat.st_size;
1093 size_t count = size / sizeof *program.filter;
1094 eassert (0 < count && count < SIZE_MAX);
1095 if (USHRT_MAX < count)
1096 {
1097 fprintf (stderr, "seccomp filter %s is too big\n", file);
1098 goto out;
1099 }
1100 /* Try reading one more byte to detect file size changes. */
1101 buffer = malloc (size + 1);
1102 if (buffer == NULL)
1103 {
1104 emacs_perror ("malloc");
1105 goto out;
1106 }
1107 ptrdiff_t read = read_full (fd, buffer, size + 1);
1108 if (read < 0)
1109 {
1110 emacs_perror ("read");
1111 goto out;
1112 }
1113 eassert (read <= SIZE_MAX);
1114 if (read != size)
1115 {
1116 fprintf (stderr,
1117 "seccomp filter %s changed size while reading\n",
1118 file);
1119 goto out;
1120 }
1121 if (emacs_close (fd) != 0)
1122 emacs_perror ("close"); /* not a fatal error */
1123 fd = -1;
1124 program.len = count;
1125 program.filter = buffer;
1126
1127 /* See man page of `seccomp' why this is necessary. Note that we
1128 intentionally don't check the return value: a parent process
1129 might have made this call before, in which case it would fail;
1130 or, if enabling privilege-restricting mode fails, the `seccomp'
1131 syscall will fail anyway. */
1132 prctl (PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0);
1133 /* Install the filter. Make sure that potential other threads can't
1134 escape it. */
1135 if (emacs_seccomp (SECCOMP_SET_MODE_FILTER,
1136 SECCOMP_FILTER_FLAG_TSYNC, &program)
1137 != 0)
1138 {
1139 emacs_perror ("seccomp");
1140 goto out;
1141 }
1142 success = true;
1143
1144 out:
1145 if (0 <= fd)
1146 emacs_close (fd);
1147 free (buffer);
1148 return success;
1149}
1150
1151/* Load Secure Computing filter from file specified with the --seccomp
1152 option. Exit if that fails. */
1153
1154static void
1155maybe_load_seccomp (int argc, char **argv)
1156{
1157 int skip_args = 0;
1158 char *file = NULL;
1159 while (skip_args < argc - 1)
1160 {
1161 if (argmatch (argv, argc, "-seccomp", "--seccomp", 9, &file,
1162 &skip_args)
1163 || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
1164 break;
1165 ++skip_args;
1166 }
1167 if (file == NULL)
1168 return;
1169 if (! load_seccomp (file))
1170 fatal ("cannot enable seccomp filter from %s", file);
1171}
1172
1173#endif /* SECCOMP_USABLE */
1174
980int 1175int
981main (int argc, char **argv) 1176main (int argc, char **argv)
982{ 1177{
983 /* Variable near the bottom of the stack, and aligned appropriately 1178 /* Variable near the bottom of the stack, and aligned appropriately
984 for pointers. */ 1179 for pointers. */
985 void *stack_bottom_variable; 1180 void *stack_bottom_variable;
1181
1182 /* First, check whether we should apply a seccomp filter. This
1183 should come at the very beginning to allow the filter to protect
1184 the initialization phase. */
1185#if SECCOMP_USABLE
1186 maybe_load_seccomp (argc, argv);
1187#endif
1188
986 bool no_loadup = false; 1189 bool no_loadup = false;
987 char *junk = 0; 1190 char *junk = 0;
988 char *dname_arg = 0; 1191 char *dname_arg = 0;
@@ -2179,12 +2382,15 @@ static const struct standard_args standard_args[] =
2179 { "-color", "--color", 5, 0}, 2382 { "-color", "--color", 5, 0},
2180 { "-no-splash", "--no-splash", 3, 0 }, 2383 { "-no-splash", "--no-splash", 3, 0 },
2181 { "-no-desktop", "--no-desktop", 3, 0 }, 2384 { "-no-desktop", "--no-desktop", 3, 0 },
2182 /* The following two must be just above the file-name args, to get 2385 /* The following three must be just above the file-name args, to get
2183 them out of our way, but without mixing them with file names. */ 2386 them out of our way, but without mixing them with file names. */
2184 { "-temacs", "--temacs", 1, 1 }, 2387 { "-temacs", "--temacs", 1, 1 },
2185#ifdef HAVE_PDUMPER 2388#ifdef HAVE_PDUMPER
2186 { "-dump-file", "--dump-file", 1, 1 }, 2389 { "-dump-file", "--dump-file", 1, 1 },
2187#endif 2390#endif
2391#if SECCOMP_USABLE
2392 { "-seccomp", "--seccomp", 1, 1 },
2393#endif
2188#ifdef HAVE_NS 2394#ifdef HAVE_NS
2189 { "-NSAutoLaunch", 0, 5, 1 }, 2395 { "-NSAutoLaunch", 0, 5, 1 },
2190 { "-NXAutoLaunch", 0, 5, 1 }, 2396 { "-NXAutoLaunch", 0, 5, 1 },
diff --git a/src/xdisp.c b/src/xdisp.c
index a405d51f803..50d9040057a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -13607,8 +13607,9 @@ redisplay_tab_bar (struct frame *f)
13607 13607
13608/* Get information about the tab-bar item which is displayed in GLYPH 13608/* Get information about the tab-bar item which is displayed in GLYPH
13609 on frame F. Return in *PROP_IDX the index where tab-bar item 13609 on frame F. Return in *PROP_IDX the index where tab-bar item
13610 properties start in F->tab_bar_items. Value is false if 13610 properties start in F->tab_bar_items. Return in CLOSE_P an
13611 GLYPH doesn't display a tab-bar item. */ 13611 indication whether the click was on the close-tab icon of the tab.
13612 Value is false if GLYPH doesn't display a tab-bar item. */
13612 13613
13613static bool 13614static bool
13614tab_bar_item_info (struct frame *f, struct glyph *glyph, 13615tab_bar_item_info (struct frame *f, struct glyph *glyph,
@@ -13654,7 +13655,6 @@ static int
13654get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph, 13655get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
13655 int *hpos, int *vpos, int *prop_idx, bool *close_p) 13656 int *hpos, int *vpos, int *prop_idx, bool *close_p)
13656{ 13657{
13657 Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
13658 struct window *w = XWINDOW (f->tab_bar_window); 13658 struct window *w = XWINDOW (f->tab_bar_window);
13659 int area; 13659 int area;
13660 13660
@@ -13668,18 +13668,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
13668 if (!tab_bar_item_info (f, *glyph, prop_idx, close_p)) 13668 if (!tab_bar_item_info (f, *glyph, prop_idx, close_p))
13669 return -1; 13669 return -1;
13670 13670
13671 /* Is mouse on the highlighted item? */ 13671 return *prop_idx == f->last_tab_bar_item ? 0 : 1;
13672 if (EQ (f->tab_bar_window, hlinfo->mouse_face_window)
13673 && *vpos >= hlinfo->mouse_face_beg_row
13674 && *vpos <= hlinfo->mouse_face_end_row
13675 && (*vpos > hlinfo->mouse_face_beg_row
13676 || *hpos >= hlinfo->mouse_face_beg_col)
13677 && (*vpos < hlinfo->mouse_face_end_row
13678 || *hpos < hlinfo->mouse_face_end_col
13679 || hlinfo->mouse_face_past_end))
13680 return 0;
13681
13682 return 1;
13683} 13672}
13684 13673
13685 13674
@@ -13693,7 +13682,6 @@ void
13693handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, 13682handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
13694 int modifiers) 13683 int modifiers)
13695{ 13684{
13696 Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
13697 struct window *w = XWINDOW (f->tab_bar_window); 13685 struct window *w = XWINDOW (f->tab_bar_window);
13698 int hpos, vpos, prop_idx; 13686 int hpos, vpos, prop_idx;
13699 bool close_p; 13687 bool close_p;
@@ -13701,47 +13689,27 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
13701 Lisp_Object enabled_p; 13689 Lisp_Object enabled_p;
13702 int ts; 13690 int ts;
13703 13691
13704 /* If not on the highlighted tab-bar item, and mouse-highlight is
13705 non-nil, return. This is so we generate the tab-bar button
13706 click only when the mouse button is released on the same item as
13707 where it was pressed. However, when mouse-highlight is disabled,
13708 generate the click when the button is released regardless of the
13709 highlight, since tab-bar items are not highlighted in that
13710 case. */
13711 frame_to_window_pixel_xy (w, &x, &y); 13692 frame_to_window_pixel_xy (w, &x, &y);
13712 ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p); 13693 ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
13713 if (ts == -1 13694 if (ts == -1
13714 || (ts != 0 && !NILP (Vmouse_highlight))) 13695 /* If the button is released on a tab other than the one where
13696 it was pressed, don't generate the tab-bar button click event. */
13697 || (ts != 0 && !down_p))
13715 return; 13698 return;
13716 13699
13717 /* When mouse-highlight is off, generate the click for the item
13718 where the button was pressed, disregarding where it was
13719 released. */
13720 if (NILP (Vmouse_highlight) && !down_p)
13721 prop_idx = f->last_tab_bar_item;
13722
13723 /* If item is disabled, do nothing. */ 13700 /* If item is disabled, do nothing. */
13724 enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P); 13701 enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P);
13725 if (NILP (enabled_p)) 13702 if (NILP (enabled_p))
13726 return; 13703 return;
13727 13704
13728 if (down_p) 13705 if (down_p)
13729 { 13706 f->last_tab_bar_item = prop_idx; /* record the pressed tab */
13730 /* Show item in pressed state. */
13731 if (!NILP (Vmouse_highlight))
13732 show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN);
13733 f->last_tab_bar_item = prop_idx;
13734 }
13735 else 13707 else
13736 { 13708 {
13737 Lisp_Object key, frame; 13709 Lisp_Object key, frame;
13738 struct input_event event; 13710 struct input_event event;
13739 EVENT_INIT (event); 13711 EVENT_INIT (event);
13740 13712
13741 /* Show item in released state. */
13742 if (!NILP (Vmouse_highlight))
13743 show_mouse_face (hlinfo, DRAW_IMAGE_RAISED);
13744
13745 key = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY); 13713 key = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY);
13746 13714
13747 XSETFRAME (frame, f); 13715 XSETFRAME (frame, f);
@@ -13754,97 +13722,6 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
13754 } 13722 }
13755} 13723}
13756 13724
13757
13758/* Possibly highlight a tab-bar item on frame F when mouse moves to
13759 tab-bar window-relative coordinates X/Y. Called from
13760 note_mouse_highlight. */
13761
13762static void
13763note_tab_bar_highlight (struct frame *f, int x, int y)
13764{
13765 Lisp_Object window = f->tab_bar_window;
13766 struct window *w = XWINDOW (window);
13767 Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
13768 int hpos, vpos;
13769 struct glyph *glyph;
13770 struct glyph_row *row;
13771 int i;
13772 Lisp_Object enabled_p;
13773 int prop_idx;
13774 bool close_p;
13775 enum draw_glyphs_face draw = DRAW_IMAGE_RAISED;
13776 int rc;
13777
13778 /* Function note_mouse_highlight is called with negative X/Y
13779 values when mouse moves outside of the frame. */
13780 if (x <= 0 || y <= 0)
13781 {
13782 clear_mouse_face (hlinfo);
13783 return;
13784 }
13785
13786 rc = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
13787 if (rc < 0)
13788 {
13789 /* Not on tab-bar item. */
13790 clear_mouse_face (hlinfo);
13791 return;
13792 }
13793 else if (rc == 0)
13794 /* On same tab-bar item as before. */
13795 goto set_help_echo;
13796
13797 clear_mouse_face (hlinfo);
13798
13799 bool mouse_down_p = false;
13800#ifndef HAVE_NS
13801 /* Mouse is down, but on different tab-bar item? */
13802 Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
13803 mouse_down_p = (gui_mouse_grabbed (dpyinfo)
13804 && f == dpyinfo->last_mouse_frame);
13805
13806 if (mouse_down_p && f->last_tab_bar_item != prop_idx)
13807 return;
13808#endif
13809 draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED;
13810
13811 /* If tab-bar item is not enabled, don't highlight it. */
13812 enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P);
13813 if (!NILP (enabled_p) && !NILP (Vmouse_highlight))
13814 {
13815 /* Compute the x-position of the glyph. In front and past the
13816 image is a space. We include this in the highlighted area. */
13817 row = MATRIX_ROW (w->current_matrix, vpos);
13818 for (i = x = 0; i < hpos; ++i)
13819 x += row->glyphs[TEXT_AREA][i].pixel_width;
13820
13821 /* Record this as the current active region. */
13822 hlinfo->mouse_face_beg_col = hpos;
13823 hlinfo->mouse_face_beg_row = vpos;
13824 hlinfo->mouse_face_beg_x = x;
13825 hlinfo->mouse_face_past_end = false;
13826
13827 hlinfo->mouse_face_end_col = hpos + 1;
13828 hlinfo->mouse_face_end_row = vpos;
13829 hlinfo->mouse_face_end_x = x + glyph->pixel_width;
13830 hlinfo->mouse_face_window = window;
13831 hlinfo->mouse_face_face_id = TAB_BAR_FACE_ID;
13832
13833 /* Display it as active. */
13834 show_mouse_face (hlinfo, draw);
13835 }
13836
13837 set_help_echo:
13838
13839 /* Set help_echo_string to a help string to display for this tab-bar item.
13840 XTread_socket does the rest. */
13841 help_echo_object = help_echo_window = Qnil;
13842 help_echo_pos = -1;
13843 help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_HELP);
13844 if (NILP (help_echo_string))
13845 help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_CAPTION);
13846}
13847
13848#endif /* HAVE_WINDOW_SYSTEM */ 13725#endif /* HAVE_WINDOW_SYSTEM */
13849 13726
13850/* Find the tab-bar item at X coordinate and return its information. */ 13727/* Find the tab-bar item at X coordinate and return its information. */
@@ -33537,13 +33414,9 @@ note_mouse_highlight (struct frame *f, int x, int y)
33537 frame_to_window_pixel_xy (w, &x, &y); 33414 frame_to_window_pixel_xy (w, &x, &y);
33538 33415
33539#if defined (HAVE_WINDOW_SYSTEM) 33416#if defined (HAVE_WINDOW_SYSTEM)
33540 /* Handle tab-bar window differently since it doesn't display a 33417 /* We don't highlight tab-bar buttons. */
33541 buffer. */
33542 if (EQ (window, f->tab_bar_window)) 33418 if (EQ (window, f->tab_bar_window))
33543 { 33419 return;
33544 note_tab_bar_highlight (f, x, y);
33545 return;
33546 }
33547#endif 33420#endif
33548 33421
33549#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR) 33422#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR)
diff --git a/test/Makefile.in b/test/Makefile.in
index 3cfd60d46c0..84ab4e70aee 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -286,6 +286,8 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h
286 $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c 286 $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c
287endif 287endif
288 288
289src/emacs-tests.log: ../lib-src/seccomp-filter.c
290
289## Check that there is no 'automated' subdirectory, which would 291## Check that there is no 'automated' subdirectory, which would
290## indicate an incomplete merge from an older version of Emacs where 292## indicate an incomplete merge from an older version of Emacs where
291## the tests were arranged differently. 293## the tests were arranged differently.
diff --git a/test/lisp/calculator-tests.el b/test/lisp/calculator-tests.el
new file mode 100644
index 00000000000..9551b1a4c61
--- /dev/null
+++ b/test/lisp/calculator-tests.el
@@ -0,0 +1,51 @@
1;;; calculator-tests.el --- Test suite for calculator. -*- lexical-binding: t -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Code:
21(require 'ert)
22(require 'calculator)
23
24(ert-deftest calculator-test-calculator-string-to-number ()
25 (dolist (x '(("" 0.0)
26 ("+" 0.0)
27 ("-" 0.0)
28 ("." 0.0)
29 ("+." 0.0)
30 ("-." -0.0)
31 (".-" 0.0)
32 ("--." 0.0)
33 ("-0.0e" -0.0)
34 ("1e1" 10.0)
35 ("1e+1" 10.0)
36 ("1e-1" 0.1)
37 ("+1e1" 10.0)
38 ("-1e1" -10.0)
39 ("+1e-1" 0.1)
40 ("-1e-1" -0.1)
41 (".1.e1" 0.1)
42 (".1..e1" 0.1)
43 ("1e+1.1" 10.0)
44 ("-2e-1.1" -0.2)))
45 (pcase x
46 (`(,str ,expected)
47 (let ((calculator-input-radix nil))
48 (should (equal (calculator-string-to-number str) expected)))))))
49
50(provide 'calculator-tests)
51;; calculator-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5147cd26883..a11832d805e 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -41,7 +41,7 @@
41 "Identity, but hidden from some optimisations." 41 "Identity, but hidden from some optimisations."
42 x) 42 x)
43 43
44(defconst byte-opt-testsuite-arith-data 44(defconst bytecomp-tests--test-cases
45 '( 45 '(
46 ;; some functional tests 46 ;; some functional tests
47 (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c)) 47 (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c))
@@ -364,17 +364,17 @@
364 '((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c) 364 '((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c)
365 (t c) (x "a") (x "c") (x c) (x d) (x e))) 365 (t c) (x "a") (x "c") (x c) (x d) (x e)))
366 366
367 (mapcar (lambda (x) (cond ((member '(a . b) x) 1) 367 (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1)
368 ((equal x '(c)) 2))) 368 ((equal x '(c)) 2))))
369 '(((a . b)) a b (c) (d))) 369 '(((a . b)) a b (c) (d)))
370 (mapcar (lambda (x) (cond ((memq '(a . b) x) 1) 370 (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1)
371 ((equal x '(c)) 2))) 371 ((equal x '(c)) 2))))
372 '(((a . b)) a b (c) (d))) 372 '(((a . b)) a b (c) (d)))
373 (mapcar (lambda (x) (cond ((member '(a b) x) 1) 373 (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1)
374 ((equal x '(c)) 2))) 374 ((equal x '(c)) 2))))
375 '(((a b)) a b (c) (d))) 375 '(((a b)) a b (c) (d)))
376 (mapcar (lambda (x) (cond ((memq '(a b) x) 1) 376 (mapcar (lambda (x) (ignore-errors (cond ((memq '(a b) x) 1)
377 ((equal x '(c)) 2))) 377 ((equal x '(c)) 2))))
378 '(((a b)) a b (c) (d))) 378 '(((a b)) a b (c) (d)))
379 379
380 (assoc 'b '((a 1) (b 2) (c 3))) 380 (assoc 'b '((a 1) (b 2) (c 3)))
@@ -396,7 +396,7 @@
396 x) 396 x)
397 397
398 (let ((x 1) (bytecomp-test-var 2) (y 3)) 398 (let ((x 1) (bytecomp-test-var 2) (y 3))
399 (list x bytecomp-test-var (bytecomp-get-test-var) y)) 399 (list x bytecomp-test-var (bytecomp-test-get-var) y))
400 400
401 (progn 401 (progn
402 (defvar d) 402 (defvar d)
@@ -430,69 +430,67 @@
430 (list s x i)) 430 (list s x i))
431 431
432 (let ((x 2)) 432 (let ((x 2))
433 (list (or (bytecomp-identity 'a) (setq x 3)) x))) 433 (list (or (bytecomp-test-identity 'a) (setq x 3)) x))
434 "List of expression for test.
435Each element will be executed by interpreter and with
436bytecompiled code, and their results compared.")
437 434
438(defun bytecomp-check-1 (pat) 435 (let* ((x 1)
439 "Return non-nil if PAT is the same whether directly evalled or compiled." 436 (y (condition-case x
440 (let ((warning-minimum-log-level :emergency) 437 (/ 1 0)
441 (byte-compile-warnings nil) 438 (arith-error x))))
442 (v0 (condition-case err 439 (list x y))
443 (eval pat) 440
444 (error (list 'bytecomp-check-error (car err))))) 441 (funcall
445 (v1 (condition-case err 442 (condition-case x
446 (funcall (byte-compile (list 'lambda nil pat))) 443 (/ 1 0)
447 (error (list 'bytecomp-check-error (car err)))))) 444 (arith-error (prog1 (lambda (y) (+ y x))
448 (equal v0 v1))) 445 (setq x 10))))
449 446 4)
450(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) 447 )
451 448 "List of expressions for cross-testing interpreted and compiled code.")
452(defun bytecomp-explain-1 (pat) 449
453 (let ((v0 (condition-case err 450(defconst bytecomp-tests--test-cases-lexbind-only
454 (eval pat) 451 `(
455 (error (list 'bytecomp-check-error (car err))))) 452 ;; This would infloop (and exhaust stack) with dynamic binding.
456 (v1 (condition-case err 453 (let ((f #'car))
457 (funcall (byte-compile (list 'lambda nil pat))) 454 (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
458 (error (list 'bytecomp-check-error (car err)))))) 455 (funcall f '(1 . 2))))
459 (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." 456 )
460 pat v0 v1))) 457 "List of expressions for cross-testing interpreted and compiled code.
461 458These are only tested with lexical binding.")
462(ert-deftest bytecomp-tests () 459
463 "Test the Emacs byte compiler." 460(defun bytecomp-tests--eval-interpreted (form)
464 (dolist (pat byte-opt-testsuite-arith-data) 461 "Evaluate FORM using the Lisp interpreter, returning errors as a
465 (should (bytecomp-check-1 pat)))) 462special value."
466 463 (condition-case err
467(defun test-byte-opt-arithmetic (&optional arg) 464 (eval form lexical-binding)
468 "Unit test for byte-opt arithmetic operations. 465 (error (list 'bytecomp-check-error (car err)))))
469Subtests signal errors if something goes wrong." 466
470 (interactive "P") 467(defun bytecomp-tests--eval-compiled (form)
471 (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) 468 "Evaluate FORM using the Lisp byte-code compiler, returning errors as a
469special value."
472 (let ((warning-minimum-log-level :emergency) 470 (let ((warning-minimum-log-level :emergency)
473 (byte-compile-warnings nil) 471 (byte-compile-warnings nil))
474 (pass-face '((t :foreground "green"))) 472 (condition-case err
475 (fail-face '((t :foreground "red"))) 473 (funcall (byte-compile (list 'lambda nil form)))
476 (print-escape-nonascii t) 474 (error (list 'bytecomp-check-error (car err))))))
477 (print-escape-newlines t) 475
478 (print-quoted t) 476(ert-deftest bytecomp-tests-lexbind ()
479 v0 v1) 477 "Check that various expressions behave the same when interpreted and
480 (dolist (pat byte-opt-testsuite-arith-data) 478byte-compiled. Run with lexical binding."
481 (condition-case err 479 (let ((lexical-binding t))
482 (setq v0 (eval pat)) 480 (dolist (form (append bytecomp-tests--test-cases-lexbind-only
483 (error (setq v0 (list 'bytecomp-check-error (car err))))) 481 bytecomp-tests--test-cases))
484 (condition-case err 482 (ert-info ((prin1-to-string form) :prefix "form: ")
485 (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) 483 (should (equal (bytecomp-tests--eval-interpreted form)
486 (error (setq v1 (list 'bytecomp-check-error (car err))))) 484 (bytecomp-tests--eval-compiled form)))))))
487 (insert (format "%s" pat)) 485
488 (indent-to-column 65) 486(ert-deftest bytecomp-tests-dynbind ()
489 (if (equal v0 v1) 487 "Check that various expressions behave the same when interpreted and
490 (insert (propertize "OK" 'face pass-face)) 488byte-compiled. Run with dynamic binding."
491 (insert (propertize "FAIL\n" 'face fail-face)) 489 (let ((lexical-binding nil))
492 (indent-to-column 55) 490 (dolist (form bytecomp-tests--test-cases)
493 (insert (propertize (format "[%s] vs [%s]" v0 v1) 491 (ert-info ((prin1-to-string form) :prefix "form: ")
494 'face fail-face))) 492 (should (equal (bytecomp-tests--eval-interpreted form)
495 (insert "\n")))) 493 (bytecomp-tests--eval-compiled form)))))))
496 494
497(defun test-byte-comp-compile-and-load (compile &rest forms) 495(defun test-byte-comp-compile-and-load (compile &rest forms)
498 (declare (indent 1)) 496 (declare (indent 1))
@@ -584,8 +582,8 @@ Subtests signal errors if something goes wrong."
584 `(with-current-buffer (get-buffer-create "*Compile-Log*") 582 `(with-current-buffer (get-buffer-create "*Compile-Log*")
585 (let ((inhibit-read-only t)) (erase-buffer)) 583 (let ((inhibit-read-only t)) (erase-buffer))
586 (byte-compile ,@form) 584 (byte-compile ,@form)
587 (ert-info ((buffer-string) :prefix "buffer: ") 585 (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ")
588 (should (re-search-forward ,re-warning))))) 586 (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning))))))
589 587
590(ert-deftest bytecomp-warn-wrong-args () 588(ert-deftest bytecomp-warn-wrong-args ()
591 (bytecomp--with-warning-test "remq.*3.*2" 589 (bytecomp--with-warning-test "remq.*3.*2"
@@ -611,12 +609,13 @@ Subtests signal errors if something goes wrong."
611 609
612(defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) 610(defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse)
613 `(ert-deftest ,(intern (format "bytecomp/%s" file)) () 611 `(ert-deftest ,(intern (format "bytecomp/%s" file)) ()
614 :expected-result ,(if reverse :failed :passed)
615 (with-current-buffer (get-buffer-create "*Compile-Log*") 612 (with-current-buffer (get-buffer-create "*Compile-Log*")
616 (let ((inhibit-read-only t)) (erase-buffer)) 613 (let ((inhibit-read-only t)) (erase-buffer))
617 (byte-compile-file ,(ert-resource-file file)) 614 (byte-compile-file ,(ert-resource-file file))
618 (ert-info ((buffer-string) :prefix "buffer: ") 615 (ert-info ((buffer-string) :prefix "buffer: ")
619 (should (re-search-forward ,re-warning)))))) 616 (,(if reverse 'should-not 'should)
617 (re-search-forward ,(string-replace " " "[ \n]+" re-warning)
618 nil t))))))
620 619
621(bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el" 620(bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el"
622 "add-hook.*lexical var") 621 "add-hook.*lexical var")
@@ -658,10 +657,10 @@ Subtests signal errors if something goes wrong."
658 "free.*foo") 657 "free.*foo")
659 658
660(bytecomp--define-warning-file-test "warn-free-variable-reference.el" 659(bytecomp--define-warning-file-test "warn-free-variable-reference.el"
661 "free.*bar") 660 "free variable .bar")
662 661
663(bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el" 662(bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el"
664 "make-variable-buffer-local.*not called at toplevel") 663 "make-variable-buffer-local. not called at toplevel")
665 664
666(bytecomp--define-warning-file-test "warn-interactive-only.el" 665(bytecomp--define-warning-file-test "warn-interactive-only.el"
667 "next-line.*interactive use only.*forward-line") 666 "next-line.*interactive use only.*forward-line")
@@ -670,19 +669,19 @@ Subtests signal errors if something goes wrong."
670 "malformed interactive spec") 669 "malformed interactive spec")
671 670
672(bytecomp--define-warning-file-test "warn-obsolete-defun.el" 671(bytecomp--define-warning-file-test "warn-obsolete-defun.el"
673 "foo-obsolete.*obsolete function.*99.99") 672 "foo-obsolete. is an obsolete function (as of 99.99)")
674 673
675(defvar bytecomp--tests-obsolete-var nil) 674(defvar bytecomp--tests-obsolete-var nil)
676(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99") 675(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99")
677 676
678(bytecomp--define-warning-file-test "warn-obsolete-hook.el" 677(bytecomp--define-warning-file-test "warn-obsolete-hook.el"
679 "bytecomp--tests-obs.*obsolete[^z-a]*99.99") 678 "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
680 679
681(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el" 680(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el"
682 "foo-obs.*obsolete.*99.99" t) 681 "foo-obs.*obsolete.*99.99" t)
683 682
684(bytecomp--define-warning-file-test "warn-obsolete-variable.el" 683(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
685 "bytecomp--tests-obs.*obsolete[^z-a]*99.99") 684 "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
686 685
687(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el" 686(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
688 "bytecomp--tests-obs.*obsolete.*99.99" t) 687 "bytecomp--tests-obs.*obsolete.*99.99" t)
@@ -713,64 +712,64 @@ Subtests signal errors if something goes wrong."
713 712
714(bytecomp--define-warning-file-test 713(bytecomp--define-warning-file-test
715 "warn-wide-docstring-autoload.el" 714 "warn-wide-docstring-autoload.el"
716 "autoload.*foox.*wider than.*characters") 715 "autoload .foox. docstring wider than .* characters")
717 716
718(bytecomp--define-warning-file-test 717(bytecomp--define-warning-file-test
719 "warn-wide-docstring-custom-declare-variable.el" 718 "warn-wide-docstring-custom-declare-variable.el"
720 "custom-declare-variable.*foo.*wider than.*characters") 719 "custom-declare-variable .foo. docstring wider than .* characters")
721 720
722(bytecomp--define-warning-file-test 721(bytecomp--define-warning-file-test
723 "warn-wide-docstring-defalias.el" 722 "warn-wide-docstring-defalias.el"
724 "defalias.*foo.*wider than.*characters") 723 "defalias .foo. docstring wider than .* characters")
725 724
726(bytecomp--define-warning-file-test 725(bytecomp--define-warning-file-test
727 "warn-wide-docstring-defconst.el" 726 "warn-wide-docstring-defconst.el"
728 "defconst.*foo.*wider than.*characters") 727 "defconst .foo-bar. docstring wider than .* characters")
729 728
730(bytecomp--define-warning-file-test 729(bytecomp--define-warning-file-test
731 "warn-wide-docstring-define-abbrev-table.el" 730 "warn-wide-docstring-define-abbrev-table.el"
732 "define-abbrev.*foo.*wider than.*characters") 731 "define-abbrev-table .foo. docstring wider than .* characters")
733 732
734(bytecomp--define-warning-file-test 733(bytecomp--define-warning-file-test
735 "warn-wide-docstring-define-obsolete-function-alias.el" 734 "warn-wide-docstring-define-obsolete-function-alias.el"
736 "defalias.*foo.*wider than.*characters") 735 "defalias .foo. docstring wider than .* characters")
737 736
738(bytecomp--define-warning-file-test 737(bytecomp--define-warning-file-test
739 "warn-wide-docstring-define-obsolete-variable-alias.el" 738 "warn-wide-docstring-define-obsolete-variable-alias.el"
740 "defvaralias.*foo.*wider than.*characters") 739 "defvaralias .foo. docstring wider than .* characters")
741 740
742;; TODO: We don't yet issue warnings for defuns. 741;; TODO: We don't yet issue warnings for defuns.
743(bytecomp--define-warning-file-test 742(bytecomp--define-warning-file-test
744 "warn-wide-docstring-defun.el" 743 "warn-wide-docstring-defun.el"
745 "wider than.*characters" 'reverse) 744 "wider than .* characters" 'reverse)
746 745
747(bytecomp--define-warning-file-test 746(bytecomp--define-warning-file-test
748 "warn-wide-docstring-defvar.el" 747 "warn-wide-docstring-defvar.el"
749 "defvar.*foo.*wider than.*characters") 748 "defvar .foo-bar. docstring wider than .* characters")
750 749
751(bytecomp--define-warning-file-test 750(bytecomp--define-warning-file-test
752 "warn-wide-docstring-defvaralias.el" 751 "warn-wide-docstring-defvaralias.el"
753 "defvaralias.*foo.*wider than.*characters") 752 "defvaralias .foo-bar. docstring wider than .* characters")
754 753
755(bytecomp--define-warning-file-test 754(bytecomp--define-warning-file-test
756 "warn-wide-docstring-ignore-fill-column.el" 755 "warn-wide-docstring-ignore-fill-column.el"
757 "defvar.*foo.*wider than.*characters" 'reverse) 756 "defvar .foo-bar. docstring wider than .* characters" 'reverse)
758 757
759(bytecomp--define-warning-file-test 758(bytecomp--define-warning-file-test
760 "warn-wide-docstring-ignore-override.el" 759 "warn-wide-docstring-ignore-override.el"
761 "defvar.*foo.*wider than.*characters" 'reverse) 760 "defvar .foo-bar. docstring wider than .* characters" 'reverse)
762 761
763(bytecomp--define-warning-file-test 762(bytecomp--define-warning-file-test
764 "warn-wide-docstring-ignore.el" 763 "warn-wide-docstring-ignore.el"
765 "defvar.*foo.*wider than.*characters" 'reverse) 764 "defvar .foo-bar. docstring wider than .* characters" 'reverse)
766 765
767(bytecomp--define-warning-file-test 766(bytecomp--define-warning-file-test
768 "warn-wide-docstring-multiline-first.el" 767 "warn-wide-docstring-multiline-first.el"
769 "defvar.*foo.*wider than.*characters") 768 "defvar .foo-bar. docstring wider than .* characters")
770 769
771(bytecomp--define-warning-file-test 770(bytecomp--define-warning-file-test
772 "warn-wide-docstring-multiline.el" 771 "warn-wide-docstring-multiline.el"
773 "defvar.*foo.*wider than.*characters") 772 "defvar .foo-bar. docstring wider than .* characters")
774 773
775(bytecomp--define-warning-file-test 774(bytecomp--define-warning-file-test
776 "nowarn-inline-after-defvar.el" 775 "nowarn-inline-after-defvar.el"
@@ -813,47 +812,6 @@ Subtests signal errors if something goes wrong."
813 (defun def () (m)))) 812 (defun def () (m))))
814 (should (equal (funcall 'def) 4))) 813 (should (equal (funcall 'def) 4)))
815 814
816(defconst bytecomp-lexbind-tests
817 `(
818 (let ((f #'car))
819 (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
820 (funcall f '(1 . 2))))
821 )
822 "List of expression for test.
823Each element will be executed by interpreter and with
824bytecompiled code, and their results compared.")
825
826(defun bytecomp-lexbind-check-1 (pat)
827 "Return non-nil if PAT is the same whether directly evalled or compiled."
828 (let ((warning-minimum-log-level :emergency)
829 (byte-compile-warnings nil)
830 (v0 (condition-case err
831 (eval pat t)
832 (error (list 'bytecomp-check-error (car err)))))
833 (v1 (condition-case err
834 (funcall (let ((lexical-binding t))
835 (byte-compile `(lambda nil ,pat))))
836 (error (list 'bytecomp-check-error (car err))))))
837 (equal v0 v1)))
838
839(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1)
840
841(defun bytecomp-lexbind-explain-1 (pat)
842 (let ((v0 (condition-case err
843 (eval pat t)
844 (error (list 'bytecomp-check-error (car err)))))
845 (v1 (condition-case err
846 (funcall (let ((lexical-binding t))
847 (byte-compile (list 'lambda nil pat))))
848 (error (list 'bytecomp-check-error (car err))))))
849 (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
850 pat v0 v1)))
851
852(ert-deftest bytecomp-lexbind-tests ()
853 "Test the Emacs byte compiler lexbind handling."
854 (dolist (pat bytecomp-lexbind-tests)
855 (should (bytecomp-lexbind-check-1 pat))))
856
857(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) 815(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body)
858 (declare (indent 1)) 816 (declare (indent 1))
859 (cl-check-type file-name-var symbol) 817 (cl-check-type file-name-var symbol)
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index dd6487603d3..5c3e603b92e 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -629,14 +629,24 @@ collection clause."
629 (let (n1) 629 (let (n1)
630 (and xs 630 (and xs
631 (progn (setq n1 (1+ n)) 631 (progn (setq n1 (1+ n))
632 (len2 (cdr xs) n1))))))) 632 (len2 (cdr xs) n1))))))
633 ;; Tail call in error handler.
634 (len3 (xs n)
635 (if xs
636 (condition-case nil
637 (/ 1 0)
638 (arith-error (len3 (cdr xs) (1+ n))))
639 n)))
633 (should (equal (len nil 0) 0)) 640 (should (equal (len nil 0) 0))
634 (should (equal (len2 nil 0) 0)) 641 (should (equal (len2 nil 0) 0))
642 (should (equal (len3 nil 0) 0))
635 (should (equal (len list-42 0) 42)) 643 (should (equal (len list-42 0) 42))
636 (should (equal (len2 list-42 0) 42)) 644 (should (equal (len2 list-42 0) 42))
645 (should (equal (len3 list-42 0) 42))
637 ;; Should not bump into stack depth limits. 646 ;; Should not bump into stack depth limits.
638 (should (equal (len list-42k 0) 42000)) 647 (should (equal (len list-42k 0) 42000))
639 (should (equal (len2 list-42k 0) 42000)))) 648 (should (equal (len2 list-42k 0) 42000))
649 (should (equal (len3 list-42k 0) 42000))))
640 650
641 ;; Check that non-recursive functions are handled more efficiently. 651 ;; Check that non-recursive functions are handled more efficiently.
642 (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) 652 (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index dcb261c2eb9..7d45432e57e 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -1061,5 +1061,30 @@ backtracking (Bug#42701)."
1061 "edebug-anon10001" 1061 "edebug-anon10001"
1062 "edebug-tests-duplicate-symbol-backtrack")))))) 1062 "edebug-tests-duplicate-symbol-backtrack"))))))
1063 1063
1064(defmacro edebug-tests--duplicate-&define (_arg)
1065 "Helper macro for the ERT test `edebug-tests-duplicate-&define'.
1066The Edebug specification is similar to the one used by `cl-flet'
1067previously; see Bug#41988."
1068 (declare (debug (&or (&define name function-form) (defun)))))
1069
1070(ert-deftest edebug-tests-duplicate-&define ()
1071 "Check that Edebug doesn't backtrack out of `&define' forms.
1072This avoids potential duplicate definitions (Bug#41988)."
1073 (with-temp-buffer
1074 (print '(defun edebug-tests-duplicate-&define ()
1075 (edebug-tests--duplicate-&define
1076 (edebug-tests-duplicate-&define-inner () nil)))
1077 (current-buffer))
1078 (let* ((edebug-all-defs t)
1079 (edebug-initial-mode 'Go-nonstop)
1080 (instrumented-names ())
1081 (edebug-new-definition-function
1082 (lambda (name)
1083 (when (memq name instrumented-names)
1084 (error "Duplicate definition of `%s'" name))
1085 (push name instrumented-names)
1086 (edebug-new-definition name))))
1087 (should-error (eval-buffer) :type 'invalid-read-syntax))))
1088
1064(provide 'edebug-tests) 1089(provide 'edebug-tests)
1065;;; edebug-tests.el ends here 1090;;; edebug-tests.el ends here
diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el
new file mode 100644
index 00000000000..b29796da42d
--- /dev/null
+++ b/test/lisp/loadhist-tests.el
@@ -0,0 +1,57 @@
1;;; loadhist-tests.el --- Tests for loadhist.el -*- lexical-binding:t -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; Author: Stefan Kangas <stefankangas@gmail.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;;; Code:
25
26(require 'ert)
27(require 'loadhist)
28
29(ert-deftest loadhist-tests-feature-symbols ()
30 (should (equal (file-name-base (car (feature-symbols 'loadhist))) "loadhist"))
31 (should-not (feature-symbols 'non-existent-feature)))
32
33(ert-deftest loadhist-tests-feature-file ()
34 (should (equal (file-name-base (feature-file 'loadhist)) "loadhist"))
35 (should-error (feature-file 'non-existent-feature)))
36
37(ert-deftest loadhist-tests-file-loadhist-lookup ()
38 ;; This should probably be extended...
39 (should (listp (file-loadhist-lookup "loadhist"))))
40
41(ert-deftest loadhist-tests-file-provides ()
42 (should (eq (car (file-provides "loadhist")) 'loadhist)))
43
44(ert-deftest loadhist-tests-file-requires ()
45 (should-not (file-requires "loadhist")))
46
47(ert-deftest loadhist-tests-file-dependents ()
48 (require 'dired-x)
49 (let ((deps (file-dependents "dired")))
50 (should (member "dired-x" (mapcar #'file-name-base deps)))))
51
52(ert-deftest loadhist-tests-unload-feature ()
53 (require 'dired-x)
54 (should-error (unload-feature 'dired))
55 (unload-feature 'dired-x))
56
57;;; loadhist-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 0c2d7123dd7..7b9c2ff63b2 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -117,8 +117,8 @@
117 (ignore-errors (delete-file shadow-info-file)) 117 (ignore-errors (delete-file shadow-info-file))
118 (ignore-errors (delete-file shadow-todo-file)) 118 (ignore-errors (delete-file shadow-todo-file))
119 ;; Reset variables. 119 ;; Reset variables.
120 (shadow-invalidate-hashtable)
120 (setq shadow-info-buffer nil 121 (setq shadow-info-buffer nil
121 shadow-hashtable nil
122 shadow-todo-buffer nil 122 shadow-todo-buffer nil
123 shadow-files-to-copy nil)) 123 shadow-files-to-copy nil))
124 124
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
new file mode 100644
index 00000000000..9053a8743e4
--- /dev/null
+++ b/test/manual/indent/scheme.scm
@@ -0,0 +1,23 @@
1;; Testing sexp-comments
2
3(define a #;(hello) there)
4
5(define a #;1 there)
6
7(define a #;"asdf" there)
8
9(define a ;; #;(hello
10 there)
11
12(define a #;(hello
13 there) 2)
14
15(define a #;(hello
16 #;(world))
17 and)
18 there) 2)
19
20(define a #;(hello
21 #;"asdf" (world
22 and)
23 there) 2)
diff --git a/test/src/emacs-resources/seccomp-filter-exec.bpf b/test/src/emacs-resources/seccomp-filter-exec.bpf
new file mode 120000
index 00000000000..5b0e9978221
--- /dev/null
+++ b/test/src/emacs-resources/seccomp-filter-exec.bpf
@@ -0,0 +1 @@
../../../lib-src/seccomp-filter-exec.bpf \ No newline at end of file
diff --git a/test/src/emacs-resources/seccomp-filter.bpf b/test/src/emacs-resources/seccomp-filter.bpf
new file mode 120000
index 00000000000..b3d603d0aeb
--- /dev/null
+++ b/test/src/emacs-resources/seccomp-filter.bpf
@@ -0,0 +1 @@
../../../lib-src/seccomp-filter.bpf \ No newline at end of file
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
new file mode 100644
index 00000000000..09f9a248efb
--- /dev/null
+++ b/test/src/emacs-tests.el
@@ -0,0 +1,213 @@
1;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2020 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published
9;; by the Free Software Foundation, either version 3 of the License,
10;; or (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15;; 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;; Unit tests for src/emacs.c.
23
24;;; Code:
25
26(require 'cl-lib)
27(require 'ert)
28(require 'ert-x)
29(require 'rx)
30(require 'subr-x)
31
32(ert-deftest emacs-tests/seccomp/absent-file ()
33 (skip-unless (string-match-p (rx bow "SECCOMP" eow)
34 system-configuration-features))
35 (let ((emacs
36 (expand-file-name invocation-name invocation-directory))
37 (process-environment nil))
38 (skip-unless (file-executable-p emacs))
39 (should-not (file-exists-p "/does-not-exist.bpf"))
40 (should-not
41 (eql (call-process emacs nil nil nil
42 "--quick" "--batch"
43 "--seccomp=/does-not-exist.bpf")
44 0))))
45
46(cl-defmacro emacs-tests--with-temp-file
47 (var (prefix &optional suffix text) &rest body)
48 "Evaluate BODY while a new temporary file exists.
49Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT
50to `make-temp-file', which see."
51 (declare (indent 2) (debug (symbolp (form form form) body)))
52 (cl-check-type var symbol)
53 ;; Use an uninterned symbol so that the code still works if BODY
54 ;; changes VAR.
55 (let ((filename (make-symbol "filename")))
56 `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text)))
57 (unwind-protect
58 (let ((,var ,filename))
59 ,@body)
60 (delete-file ,filename)))))
61
62(ert-deftest emacs-tests/seccomp/empty-file ()
63 (skip-unless (string-match-p (rx bow "SECCOMP" eow)
64 system-configuration-features))
65 (let ((emacs
66 (expand-file-name invocation-name invocation-directory))
67 (process-environment nil))
68 (skip-unless (file-executable-p emacs))
69 (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf")
70 ;; The --seccomp option is processed early, without filename
71 ;; handlers. Therefore remote or quoted filenames wouldn't
72 ;; work.
73 (should-not (file-remote-p filter))
74 (cl-callf file-name-unquote filter)
75 ;; According to the Seccomp man page, a filter must have at
76 ;; least one element, so Emacs should reject an empty file.
77 (should-not
78 (eql (call-process emacs nil nil nil
79 "--quick" "--batch"
80 (concat "--seccomp=" filter))
81 0)))))
82
83(ert-deftest emacs-tests/seccomp/file-too-large ()
84 (skip-unless (string-match-p (rx bow "SECCOMP" eow)
85 system-configuration-features))
86 (let ((emacs
87 (expand-file-name invocation-name invocation-directory))
88 (process-environment nil)
89 ;; This value should be correct on all supported systems.
90 (ushort-max #xFFFF)
91 ;; Either 8 or 16, but 16 should be large enough in all cases.
92 (filter-size 16))
93 (skip-unless (file-executable-p emacs))
94 (emacs-tests--with-temp-file
95 filter ("seccomp-too-large-" ".bpf"
96 (make-string (* (1+ ushort-max) filter-size) ?a))
97 ;; The --seccomp option is processed early, without filename
98 ;; handlers. Therefore remote or quoted filenames wouldn't
99 ;; work.
100 (should-not (file-remote-p filter))
101 (cl-callf file-name-unquote filter)
102 ;; The filter count must fit into an `unsigned short'. A bigger
103 ;; file should be rejected.
104 (should-not
105 (eql (call-process emacs nil nil nil
106 "--quick" "--batch"
107 (concat "--seccomp=" filter))
108 0)))))
109
110(ert-deftest emacs-tests/seccomp/invalid-file-size ()
111 (skip-unless (string-match-p (rx bow "SECCOMP" eow)
112 system-configuration-features))
113 (let ((emacs
114 (expand-file-name invocation-name invocation-directory))
115 (process-environment nil))
116 (skip-unless (file-executable-p emacs))
117 (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf"
118 "123456")
119 ;; The --seccomp option is processed early, without filename
120 ;; handlers. Therefore remote or quoted filenames wouldn't
121 ;; work.
122 (should-not (file-remote-p filter))
123 (cl-callf file-name-unquote filter)
124 ;; The Seccomp filter file must have a file size that's a
125 ;; multiple of the size of struct sock_filter, which is 8 or 16,
126 ;; but never 6.
127 (should-not
128 (eql (call-process emacs nil nil nil
129 "--quick" "--batch"
130 (concat "--seccomp=" filter))
131 0)))))
132
133(ert-deftest emacs-tests/seccomp/allows-stdout ()
134 (skip-unless (string-match-p (rx bow "SECCOMP" eow)
135 system-configuration-features))
136 (let ((emacs
137 (expand-file-name invocation-name invocation-directory))
138 (filter (ert-resource-file "seccomp-filter.bpf"))
139 (process-environment nil))
140 (skip-unless (file-executable-p emacs))
141 (skip-unless (file-readable-p filter))
142 ;; The --seccomp option is processed early, without filename
143 ;; handlers. Therefore remote or quoted filenames wouldn't work.
144 (should-not (file-remote-p filter))
145 (cl-callf file-name-unquote filter)
146 (with-temp-buffer
147 (let ((status (call-process
148 emacs nil t nil
149 "--quick" "--batch"
150 (concat "--seccomp=" filter)
151 (format "--eval=%S" '(message "Hi")))))
152 (ert-info ((format "Process output: %s" (buffer-string)))
153 (should (eql status 0)))
154 (should (equal (string-trim (buffer-string)) "Hi"))))))
155
156(ert-deftest emacs-tests/seccomp/forbids-subprocess ()
157 (skip-unless (string-match-p (rx bow "SECCOMP" eow)
158 system-configuration-features))
159 (let ((emacs
160 (expand-file-name invocation-name invocation-directory))
161 (filter (ert-resource-file "seccomp-filter.bpf"))
162 (process-environment nil))
163 (skip-unless (file-executable-p emacs))
164 (skip-unless (file-readable-p filter))
165 ;; The --seccomp option is processed early, without filename
166 ;; handlers. Therefore remote or quoted filenames wouldn't work.
167 (should-not (file-remote-p filter))
168 (cl-callf file-name-unquote filter)
169 (with-temp-buffer
170 (let ((status
171 (call-process
172 emacs nil t nil
173 "--quick" "--batch"
174 (concat "--seccomp=" filter)
175 (format "--eval=%S" `(call-process ,emacs nil nil nil
176 "--version")))))
177 (ert-info ((format "Process output: %s" (buffer-string)))
178 (should-not (eql status 0)))))))
179
180(ert-deftest emacs-tests/bwrap/allows-stdout ()
181 (let ((bash (executable-find "bash"))
182 (bwrap (executable-find "bwrap"))
183 (emacs
184 (expand-file-name invocation-name invocation-directory))
185 (filter (ert-resource-file "seccomp-filter-exec.bpf"))
186 (process-environment nil))
187 (skip-unless bash)
188 (skip-unless bwrap)
189 (skip-unless (file-executable-p emacs))
190 (skip-unless (file-readable-p filter))
191 (should-not (file-remote-p bwrap))
192 (should-not (file-remote-p emacs))
193 (should-not (file-remote-p filter))
194 (with-temp-buffer
195 (let* ((command
196 (concat
197 (mapconcat #'shell-quote-argument
198 `(,(file-name-unquote bwrap)
199 "--ro-bind" "/" "/"
200 "--seccomp" "20"
201 "--"
202 ,(file-name-unquote emacs)
203 "--quick" "--batch"
204 ,(format "--eval=%S" '(message "Hi")))
205 " ")
206 " 20< "
207 (shell-quote-argument (file-name-unquote filter))))
208 (status (call-process bash nil t nil "-c" command)))
209 (ert-info ((format "Process output: %s" (buffer-string)))
210 (should (eql status 0)))
211 (should (equal (string-trim (buffer-string)) "Hi"))))))
212
213;;; emacs-tests.el ends here