[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk de46c77: Merge branch 'master' of git.sv.gnu.org:/srv/git/e
|
From: |
Yuuki Harano |
|
Subject: |
feature/pgtk de46c77: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk |
|
Date: |
Sun, 18 Apr 2021 02:37:49 -0400 (EDT) |
branch: feature/pgtk
commit de46c7796e635faf8647a7c6a5ae34fda9adae3b
Merge: fb5f3e6 5c07cd0
Author: Yuuki Harano <masm+github@masm11.me>
Commit: Yuuki Harano <masm+github@masm11.me>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
---
.gitignore | 8 +
admin/grammars/Makefile.in | 13 +-
admin/update_autogen | 12 +-
configure.ac | 27 +-
doc/emacs/buffers.texi | 9 +
doc/emacs/mini.texi | 8 +-
doc/emacs/search.texi | 8 +
doc/lispref/control.texi | 9 +-
doc/lispref/display.texi | 26 +-
doc/lispref/edebug.texi | 10 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/frames.texi | 5 +-
doc/lispref/keymaps.texi | 2 +-
doc/lispref/modes.texi | 64 +-
doc/lispref/objects.texi | 2 +-
doc/lispref/processes.texi | 7 +-
doc/misc/eshell.texi | 4 +-
doc/misc/eww.texi | 19 +-
doc/misc/message.texi | 163 ++--
doc/misc/tramp.texi | 27 +
etc/NEWS | 73 +-
lib-src/Makefile.in | 39 +
lib-src/seccomp-filter.c | 363 ++++++++
lisp/align.el | 2 -
lisp/allout-widgets.el | 1 -
lisp/allout.el | 1 -
lisp/array.el | 54 +-
lisp/autoarg.el | 4 +-
lisp/autorevert.el | 5 +-
lisp/bs.el | 1 -
lisp/calc/calc-alg.el | 12 +-
lisp/calc/calc-ext.el | 22 +-
lisp/calc/calc-prog.el | 12 +-
lisp/calculator.el | 9 +-
lisp/calendar/icalendar.el | 26 +-
lisp/calendar/parse-time.el | 62 +-
lisp/cedet/semantic/bovine/el.el | 2 +-
lisp/cedet/semantic/db-ebrowse.el | 2 +-
lisp/cedet/semantic/decorate/mode.el | 2 +-
lisp/cedet/semantic/grammar.el | 7 +-
.../semantic/{grammar-wy.el => grm-wy-boot.el} | 0
lisp/cedet/semantic/idle.el | 3 +-
lisp/cmuscheme.el | 103 +--
lisp/comint.el | 25 +-
lisp/cus-dep.el | 6 +-
lisp/cus-edit.el | 2 -
lisp/cus-face.el | 2 -
lisp/custom.el | 2 -
lisp/dired-aux.el | 2 +-
lisp/dirtrack.el | 4 +-
lisp/dynamic-setting.el | 7 +-
lisp/edmacro.el | 36 +-
lisp/emacs-lisp/bindat.el | 33 +-
lisp/emacs-lisp/byte-opt.el | 10 +-
lisp/emacs-lisp/bytecomp.el | 63 +-
lisp/emacs-lisp/cconv.el | 4 +-
lisp/emacs-lisp/checkdoc.el | 2 +-
lisp/emacs-lisp/cl-indent.el | 2 +-
lisp/emacs-lisp/cl-macs.el | 9 +
lisp/emacs-lisp/debug.el | 2 +-
lisp/emacs-lisp/easy-mmode.el | 229 ++---
lisp/emacs-lisp/easymenu.el | 8 +-
lisp/emacs-lisp/edebug.el | 25 +-
lisp/emacs-lisp/eieio-base.el | 3 +-
lisp/emacs-lisp/eieio-core.el | 12 +-
lisp/emacs-lisp/faceup.el | 5 -
lisp/emacs-lisp/float-sup.el | 1 +
lisp/emacs-lisp/lisp-mnt.el | 5 -
lisp/emacs-lisp/macroexp.el | 3 +-
lisp/emacs-lisp/memory-report.el | 18 +-
lisp/emacs-lisp/ring.el | 2 -
lisp/emacs-lisp/smie.el | 34 +-
lisp/emacs-lisp/tabulated-list.el | 19 +-
lisp/emulation/edt-mapper.el | 2 +-
lisp/epa-file.el | 4 +-
lisp/epa-mail.el | 2 +-
lisp/erc/erc-dcc.el | 24 +-
lisp/erc/erc-fill.el | 1 -
lisp/erc/erc-track.el | 9 +-
lisp/erc/erc.el | 27 +-
lisp/eshell/em-script.el | 5 +-
lisp/eshell/em-xtra.el | 44 +-
lisp/eshell/esh-proc.el | 38 +-
lisp/eshell/esh-util.el | 166 ++--
lisp/expand.el | 1 -
lisp/facemenu.el | 1 +
lisp/filecache.el | 4 -
lisp/filenotify.el | 1 -
lisp/files-x.el | 4 +-
lisp/files.el | 28 +-
lisp/find-file.el | 300 ++-----
lisp/foldout.el | 52 +-
lisp/font-core.el | 1 -
lisp/frame.el | 125 +--
lisp/generic-x.el | 335 ++++---
lisp/gnus/gnus-cite.el | 4 +-
lisp/gnus/gnus-cus.el | 2 -
lisp/gnus/gnus-diary.el | 5 -
lisp/gnus/gnus-registry.el | 2 -
lisp/gnus/message.el | 204 ++---
lisp/gnus/nnagent.el | 1 -
lisp/gnus/nnselect.el | 1 -
lisp/hippie-exp.el | 53 +-
lisp/ibuf-ext.el | 152 ++--
lisp/ibuf-macs.el | 32 +-
lisp/icomplete.el | 43 +-
lisp/image-mode.el | 8 +-
lisp/informat.el | 4 +-
lisp/international/ja-dic-cnv.el | 6 +-
lisp/isearch.el | 92 +-
lisp/jka-compr.el | 27 +-
lisp/language/thai-word.el | 2 +-
lisp/loadhist.el | 2 +-
lisp/loadup.el | 18 +-
lisp/ls-lisp.el | 2 +-
lisp/mail/rmailmm.el | 2 +-
lisp/mh-e/mh-acros.el | 2 -
lisp/mh-e/mh-alias.el | 2 -
lisp/mh-e/mh-buffers.el | 2 -
lisp/mh-e/mh-comp.el | 2 -
lisp/mh-e/mh-compat.el | 2 -
lisp/mh-e/mh-folder.el | 2 -
lisp/mh-e/mh-funcs.el | 2 -
lisp/mh-e/mh-gnus.el | 2 -
lisp/mh-e/mh-identity.el | 2 -
lisp/mh-e/mh-inc.el | 2 -
lisp/mh-e/mh-junk.el | 2 -
lisp/mh-e/mh-letter.el | 2 -
lisp/mh-e/mh-limit.el | 2 -
lisp/mh-e/mh-mime.el | 2 -
lisp/mh-e/mh-print.el | 2 -
lisp/mh-e/mh-scan.el | 2 -
lisp/mh-e/mh-search.el | 42 +-
lisp/mh-e/mh-seq.el | 2 -
lisp/mh-e/mh-show.el | 4 +-
lisp/mh-e/mh-speed.el | 2 -
lisp/mh-e/mh-thread.el | 38 +-
lisp/mh-e/mh-tool-bar.el | 2 -
lisp/mh-e/mh-utils.el | 6 +-
lisp/mh-e/mh-xface.el | 2 -
lisp/minibuffer.el | 13 +-
lisp/misearch.el | 28 +-
lisp/msb.el | 79 +-
lisp/net/ange-ftp.el | 4 -
lisp/net/eww.el | 10 +
lisp/net/goto-addr.el | 8 +-
lisp/net/net-utils.el | 12 +-
lisp/net/rcirc.el | 7 +-
lisp/net/shr.el | 12 +-
lisp/net/tramp-sh.el | 191 ++--
lisp/net/tramp.el | 52 +-
lisp/nxml/xmltok.el | 45 +-
lisp/obsolete/fast-lock.el | 2 -
lisp/obsolete/iswitchb.el | 2 +-
lisp/obsolete/lazy-lock.el | 2 -
lisp/obsolete/nnir.el | 1 -
lisp/obsolete/pc-select.el | 2 -
lisp/obsolete/sregex.el | 4 +-
lisp/obsolete/tpu-mapper.el | 2 +-
lisp/org/org-capture.el | 2 +-
lisp/org/org-indent.el | 2 +-
lisp/org/org-list.el | 2 +-
lisp/org/org-src.el | 2 +-
lisp/org/org-table.el | 6 +-
lisp/org/org.el | 2 +-
lisp/org/ox-beamer.el | 8 +-
lisp/outline.el | 5 +-
lisp/progmodes/bug-reference.el | 6 -
lisp/progmodes/cc-align.el | 5 +-
lisp/progmodes/cc-awk.el | 2 +-
lisp/progmodes/cc-bytecomp.el | 18 +-
lisp/progmodes/cc-cmds.el | 79 +-
lisp/progmodes/cc-defs.el | 201 ++---
lisp/progmodes/cc-engine.el | 58 +-
lisp/progmodes/cc-fonts.el | 33 +-
lisp/progmodes/cc-guess.el | 6 +-
lisp/progmodes/cc-langs.el | 33 +-
lisp/progmodes/cc-menus.el | 2 +-
lisp/progmodes/cc-mode.el | 4 +-
lisp/progmodes/cc-styles.el | 4 +-
lisp/progmodes/cc-vars.el | 5 +-
lisp/progmodes/cmacexp.el | 37 +-
lisp/progmodes/elisp-mode.el | 2 +-
lisp/progmodes/flymake.el | 5 +-
lisp/progmodes/glasses.el | 4 -
lisp/progmodes/gud.el | 15 +
lisp/progmodes/meta-mode.el | 3 -
lisp/progmodes/project.el | 63 +-
lisp/progmodes/ps-mode.el | 38 +-
lisp/progmodes/python.el | 5 +-
lisp/progmodes/sh-script.el | 2 +-
lisp/progmodes/sql.el | 4 +-
lisp/progmodes/verilog-mode.el | 40 +-
lisp/progmodes/vhdl-mode.el | 981 +++++++++++----------
lisp/progmodes/xref.el | 3 +-
lisp/ps-bdf.el | 4 +-
lisp/ps-mule.el | 46 +-
lisp/rect.el | 2 +-
lisp/repeat.el | 131 ++-
lisp/replace.el | 34 +-
lisp/ruler-mode.el | 2 -
lisp/scroll-all.el | 2 +-
lisp/shadowfile.el | 91 +-
lisp/shell.el | 2 +-
lisp/simple.el | 1 -
lisp/so-long.el | 2 +-
lisp/speedbar.el | 1 -
lisp/startup.el | 5 +-
lisp/strokes.el | 2 +-
lisp/tab-bar.el | 22 +
lisp/tar-mode.el | 40 +-
lisp/textmodes/artist.el | 2 +-
lisp/textmodes/bibtex-style.el | 1 -
lisp/textmodes/bibtex.el | 3 -
lisp/textmodes/ispell.el | 2 +-
lisp/textmodes/makeinfo.el | 1 -
lisp/textmodes/page.el | 2 -
lisp/textmodes/paragraphs.el | 8 +-
lisp/textmodes/refer.el | 16 +-
lisp/textmodes/remember.el | 2 +-
lisp/textmodes/rst.el | 12 +-
lisp/textmodes/sgml-mode.el | 2 +-
lisp/textmodes/table.el | 2 +-
lisp/textmodes/tex-mode.el | 1 -
lisp/textmodes/texinfmt.el | 6 +-
lisp/textmodes/texnfo-upd.el | 2 -
lisp/textmodes/tildify.el | 4 +-
lisp/textmodes/two-column.el | 11 +-
lisp/uniquify.el | 2 -
lisp/vc/log-edit.el | 7 +-
lisp/vc/pcvs.el | 2 +-
lisp/vc/vc-hg.el | 4 -
lisp/vt-control.el | 16 +-
lisp/widget.el | 2 -
lisp/window.el | 4 +
lisp/winner.el | 19 +-
src/alloc.c | 2 +-
src/character.c | 56 +-
src/character.h | 4 +-
src/editfns.c | 9 +-
src/emacs.c | 207 ++++-
src/eval.c | 34 +-
src/frame.c | 1 +
src/image.c | 58 +-
src/minibuf.c | 38 +-
src/w32term.c | 20 +-
src/window.c | 35 +-
src/window.h | 1 +
src/xdisp.c | 58 +-
src/xselect.c | 21 +-
test/Makefile.in | 2 +
test/lisp/calculator-tests.el | 51 ++
test/lisp/emacs-lisp/bytecomp-tests.el | 357 +++++---
test/lisp/emacs-lisp/cl-macs-tests.el | 15 +-
test/lisp/emacs-lisp/edebug-tests.el | 25 +
test/lisp/loadhist-tests.el | 57 ++
test/lisp/net/tramp-tests.el | 40 +-
test/lisp/progmodes/project-tests.el | 44 +
test/lisp/shadowfile-tests.el | 2 +-
test/manual/cedet/tests/test.el | 3 -
test/manual/indent/scheme.scm | 23 +
test/src/character-tests.el | 45 +
test/src/emacs-resources/seccomp-filter-exec.bpf | 1 +
test/src/emacs-resources/seccomp-filter.bpf | 1 +
test/src/emacs-tests.el | 257 ++++++
265 files changed, 4722 insertions(+), 3198 deletions(-)
diff --git a/.gitignore b/.gitignore
index 7281383..7be876b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -88,6 +88,7 @@ lisp/cedet/semantic/wisent/javat-wy.el
lisp/cedet/semantic/wisent/js-wy.el
lisp/cedet/semantic/wisent/python-wy.el
lisp/cedet/srecode/srt-wy.el
+lisp/cedet/semantic/grammar-wy.el
lisp/eshell/esh-groups.el
lisp/finder-inf.el
lisp/leim/ja-dic/
@@ -188,6 +189,7 @@ lib-src/make-docfile
lib-src/make-fingerprint
lib-src/movemail
lib-src/profile
+lib-src/seccomp-filter
lib-src/test-distrib
lib-src/update-game-score
nextstep/Cocoa/Emacs.base/Contents/Info.plist
@@ -302,5 +304,11 @@ nt/emacsclient.rc
src/gdb.ini
/var/
+# Seccomp filter files.
+lib-src/seccomp-filter.bpf
+lib-src/seccomp-filter.pfc
+lib-src/seccomp-filter-exec.bpf
+lib-src/seccomp-filter-exec.pfc
+
# gsettings schema
/etc/*.gschema.valid
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index 35ce554..4172411 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -51,14 +51,11 @@ BOVINE = \
${bovinedir}/make-by.el \
${bovinedir}/scm-by.el
-## FIXME Should include this one too:
-## ${cedetdir}/semantic/grammar-wy.el
-## but semantic/grammar.el (which is what we use to generate grammar-wy.el)
-## requires it! https://debbugs.gnu.org/16008
-WISENT = \
- ${wisentdir}/javat-wy.el \
- ${wisentdir}/js-wy.el \
- ${wisentdir}/python-wy.el \
+WISENT = \
+ ${cedetdir}/semantic/grammar-wy.el \
+ ${wisentdir}/javat-wy.el \
+ ${wisentdir}/js-wy.el \
+ ${wisentdir}/python-wy.el \
${cedetdir}/srecode/srt-wy.el
ALL = ${BOVINE} ${WISENT}
diff --git a/admin/update_autogen b/admin/update_autogen
index 35c391d..11c4313 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -317,7 +317,7 @@ EOF
echo "Finding loaddef targets..."
find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \
- sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
+ sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
>| $tempfile || die "Error finding targets"
genfiles=
@@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs
|| die "make src error"
## Ignore comment differences.
-[ ! "$lboot_flag" ] || \
+[ ! "$lboot_flag" ] || \
diff -q -I '^;' $ldefs_in $ldefs_out || \
cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
+# Refresh the prebuilt grammar-wy.el
+grammar_in=lisp/cedet/semantic/grammar-wy.el
+grammar_out=lisp/cedet/semantic/grm-wy-boot.el
+make -C admin/grammars/ ../../$grammar_in
+cp $grammar_in $grammar_out || die "cp grm_wy_boot error"
+
echo "Checking status of loaddef files..."
## It probably would be fine to just check+commit lisp/, since
## making autoloads should not effect any other files. But better
## safe than sorry.
-modified=$(status $genfiles $ldefs_out) || die
+modified=$(status $genfiles $ldefs_out $grammar_out) || die
commit "loaddefs" $modified || die "commit error"
diff --git a/configure.ac b/configure.ac
index 17e5fcf..fc95d19 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4254,6 +4254,22 @@ fi
AC_SUBST([BLESSMAIL_TARGET])
AC_SUBST([LIBS_MAIL])
+HAVE_SECCOMP=no
+AC_CHECK_HEADERS(
+ [linux/seccomp.h linux/filter.h],
+ [AC_CHECK_DECLS(
+ [SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC],
+ [HAVE_SECCOMP=yes], [],
+ [[
+ #include <linux/seccomp.h>
+ ]])])
+AC_SUBST([HAVE_SECCOMP])
+
+EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0])
+AC_SUBST([HAVE_LIBSECCOMP])
+AC_SUBST([LIBSECCOMP_LIBS])
+AC_SUBST([LIBSECCOMP_CFLAGS])
+
OLD_LIBS=$LIBS
LIBS="$LIB_PTHREAD $LIB_MATH $LIBS"
AC_CHECK_FUNCS(accept4 fchdir gethostname \
@@ -4261,7 +4277,7 @@ getrusage get_current_dir_name \
lrand48 random rint trunc \
select getpagesize setlocale newlocale \
getrlimit setrlimit shutdown \
-pthread_sigmask strsignal setitimer timer_getoverrun \
+pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getifaddrs freeifaddrs \
gai_strerror sync \
getpwent endpwent getgrent endgrent \
@@ -5562,6 +5578,12 @@ gl_INIT
CFLAGS=$SAVE_CFLAGS
LIBS=$SAVE_LIBS
+# timer_getoverrun needs the same libarary as timer_settime
+OLD_LIBS=$LIBS
+LIBS="$LIB_TIMER_TIME $LIBS"
+AC_CHECK_FUNCS(timer_getoverrun)
+LIBS=$OLD_LIBS
+
if test "${opsys}" = "mingw32"; then
CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc"
# Remove unneeded switches from the value of CC that goes to Makefiles
@@ -5751,7 +5773,8 @@ optsep=
emacs_config_features=
for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
- M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PGTK PNG RSVG SOUND THREADS TIFF \
+ M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PGTK PNG RSVG SECCOMP SOUND \
+ THREADS TIFF \
TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
ZLIB; do
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 3a166e4..bec7f37 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -765,6 +765,15 @@ your initialization file (@pxref{Init File}):
the variable @code{fido-mode} to @code{t} (@pxref{Easy
Customization}).
+@findex icomplete-vertical-mode
+@cindex Icomplete vertical mode
+
+ Icomplete mode and Fido mode display the possible completions on the
+same line as the prompt by default. To display the completion candidates
+vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or
+customize the variable @code{icomplete-vertical-mode} to @code{t}
+(@pxref{Easy Customization}).
+
@node Buffer Menus
@subsection Customizing Buffer Menus
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index d0865c5..1eba707 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -64,10 +64,10 @@ minibuffer-electric-default-mode}.
Since the minibuffer appears in the echo area, it can conflict with
other uses of the echo area. If an error message or an informative
-message is emitted while the minibuffer is active, the message hides
-the minibuffer for a few seconds, or until you type something; then
-the minibuffer comes back. While the minibuffer is in use, Emacs does
-not echo keystrokes.
+message is emitted while the minibuffer is active, the message is
+displayed in brackets after the minibuffer text for a few seconds, or
+until you type something; then the message disappears. While the
+minibuffer is in use, Emacs does not echo keystrokes.
@vindex minibuffer-follows-selected-frame
While using the minibuffer, you can switch to a different frame,
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index f3c42bc..38430a2 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
backward search, leaving the search string unchanged. Similarly,
@kbd{C-s} in a backward search switches to a forward search.
+@cindex search, changing direction
+@vindex isearch-repeat-on-direction-change
+ When you change the direction of a search, the first command you
+type will, by default, remain on the same match, and the cursor will
+move to the other end of the match. To move to another match
+immediately, customize the variable
+@code{isearch-repeat-on-direction-change} to @code{t}.
+
@cindex search, wrapping around
@cindex search, overwrapped
@cindex wrapped search
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 3388102..22b665b 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -2012,7 +2012,8 @@ that can be handled).
This special form establishes the error handlers @var{handlers} around
the execution of @var{protected-form}. If @var{protected-form} executes
without error, the value it returns becomes the value of the
-@code{condition-case} form; in this case, the @code{condition-case} has
+@code{condition-case} form (in the absence of a success handler; see below).
+In this case, the @code{condition-case} has
no effect. The @code{condition-case} form makes a difference when an
error occurs during @var{protected-form}.
@@ -2062,6 +2063,12 @@ error description.
If @var{var} is @code{nil}, that means no variable is bound. Then the
error symbol and associated data are not available to the handler.
+@cindex success handler
+As a special case, one of the @var{handlers} can be a list of the
+form @code{(:success @var{body}@dots{})}, where @var{body} is executed
+with @var{var} (if non-@code{nil}) bound to the return value of
+@var{protected-form} when that expression terminates without error.
+
@cindex rethrow a signal
Sometimes it is necessary to re-throw a signal caught by
@code{condition-case}, for some outer-level handler to catch. Here's
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 68d7e82..228c940 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1965,9 +1965,18 @@ Tables}). The width of a tab character is usually
@code{tab-width}
(@pxref{Usual Display}).
@end defun
-@defun string-width string
+@defun string-width string &optional from to
This function returns the width in columns of the string @var{string},
if it were displayed in the current buffer and the selected window.
+Optional arguments @var{from} and @var{to} specify the substring of
+@var{string} to consider, and are interpreted as in @code{substring}
+(@pxref{Creating Strings}).
+
+The return value is an approximation: it only considers the values
+returned by @code{char-width} for the constituent characters, always
+takes a tab character as taking @code{tab-width} columns, ignores
+display properties and fonts, etc. For these reasons, we recommend
+using @code{window-text-pixel-size}, described below, instead.
@end defun
@defun truncate-string-to-width string width &optional start-column padding
ellipsis ellipsis-text-property
@@ -4752,6 +4761,7 @@ window on a minibuffer-less frame.
@node Display Property
@section The @code{display} Property
@cindex display specification
+@cindex display property
@kindex display @r{(text property)}
The @code{display} text property (or overlay property) is used to
@@ -5289,6 +5299,16 @@ where @var{props} is a property list of alternating
keyword symbols
and values, including at least the pair @code{:type @var{type}} that
specifies the image type.
+ Image descriptors which define image dimensions, @code{:width},
+@code{:height}, @code{:max-width} and @code{:max-height}, may take
+either an integer, which represents the dimension in pixels, or a pair
+@code{(@var{value} . em)}, where @var{value} is the dimension's
+length in @dfn{ems}@footnote{In typography an em is a distance
+equivalent to the height of the type. For example when using 12 point
+type 1 em is equal to 12 points. Its use ensures distances and type
+remain proportional.}. One em is equivalent to the height of the font
+and @var{value} may be an integer or a float.
+
The following is a list of properties that are meaningful for all
image types (there are also properties which are meaningful only for
certain image types, as documented in the following subsections):
@@ -5758,13 +5778,13 @@ properties:
@item :foreground @var{foreground}
@var{foreground}, if non-@code{nil}, should be a string specifying a
color, which is used as the image's foreground color. If the value is
-@code{nil}, it defaults to the faces's foreground color.
+@code{nil}, it defaults to the current face's foreground color.
@item :background @var{background}
@var{background}, if non-@code{nil}, should be a string specifying a
color, which is used as the image's background color if the image
supports transparency. If the value is @code{nil}, it defaults to the
-faces's background color.
+current face's background color.
@item :css @var{css}
@var{css}, if non-@code{nil}, should be a string specifying the CSS to
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 8942f55..323130f 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
must be in the form itself rather than at a higher level.
Backtracking is also disabled after successfully matching a quoted
-symbol or string specification, since this usually indicates a
-recognized construct. But if you have a set of alternative constructs that
-all begin with the same symbol, you can usually work around this
-constraint by factoring the symbol out of the alternatives, e.g.,
-@code{["foo" &or [first case] [second case] ...]}.
+symbol, string specification, or @code{&define} keyword, since this
+usually indicates a recognized construct. But if you have a set of
+alternative constructs that all begin with the same symbol, you can
+usually work around this constraint by factoring the symbol out of the
+alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}.
Most needs are satisfied by these two ways that backtracking is
automatically disabled, but occasionally it is useful to explicitly
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index dade855..be0c835 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -531,6 +531,7 @@ Scoping Rules for Variable Bindings
* Dynamic Binding Tips:: Avoiding problems with dynamic binding.
* Lexical Binding:: A different type of local variable binding.
* Using Lexical Binding:: How to enable lexical binding.
+* Converting to Lexical Binding:: Convert existing code to lexical binding.
Buffer-Local Variables
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index cd2ff8f..a9d20c5 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
@code{delete-frame} event, whose normal definition is a command that
calls the function @code{delete-frame}. @xref{Misc Events}.
-@deffn Command delete-other-frames &optional frame
+@deffn Command delete-other-frames &optional frame iconify
This command deletes all frames on @var{frame}'s terminal, except
@var{frame}. If @var{frame} uses another frame's minibuffer, that
minibuffer frame is left untouched. The argument @var{frame} must
@@ -2639,6 +2639,9 @@ this command works by calling @code{delete-frame} with
@var{force}
This function does not delete any of @var{frame}'s child frames
(@pxref{Child Frames}). If @var{frame} is a child frame, it deletes
@var{frame}'s siblings only.
+
+With the prefix argument @var{iconify}, the frames are iconified rather
+than deleted.
@end deffn
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index dabf985..cbc94d8 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1686,7 +1686,7 @@ presence of such a binding can still prevent translation
from taking place.
For example, let us return to our VT100 example above and add a binding for
@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c
@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c
-@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}},
+@key{PF1}} because it will stop reading keys right after @kbd{C-c @key{ESC}},
leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c
@key{ESC}}, in which case Emacs should not sit there waiting for the next key
to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}.
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 6cf4dd2..88f2f14 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1660,7 +1660,7 @@ reserved for users. @xref{Key Binding Conventions}.
The macro @code{define-minor-mode} offers a convenient way of
implementing a mode in one self-contained definition.
-@defmac define-minor-mode mode doc [init-value [lighter [keymap]]]
keyword-args@dots{} body@dots{}
+@defmac define-minor-mode mode doc keyword-args@dots{} body@dots{}
This macro defines a new minor mode whose name is @var{mode} (a
symbol). It defines a command named @var{mode} to toggle the minor
mode, with @var{doc} as its documentation string.
@@ -1675,41 +1675,12 @@ If @var{doc} is @code{nil}, the macro supplies a
default documentation string
explaining the above.
By default, it also defines a variable named @var{mode}, which is set to
-@code{t} or @code{nil} by enabling or disabling the mode. The variable
-is initialized to @var{init-value}. Except in unusual circumstances
-(see below), this value must be @code{nil}.
+@code{t} or @code{nil} by enabling or disabling the mode.
-The string @var{lighter} says what to display in the mode line
-when the mode is enabled; if it is @code{nil}, the mode is not displayed
-in the mode line.
-
-The optional argument @var{keymap} specifies the keymap for the minor
-mode. If non-@code{nil}, it should be a variable name (whose value is
-a keymap), a keymap, or an alist of the form
-
-@example
-(@var{key-sequence} . @var{definition})
-@end example
-
-@noindent
-where each @var{key-sequence} and @var{definition} are arguments
-suitable for passing to @code{define-key} (@pxref{Changing Key
-Bindings}). If @var{keymap} is a keymap or an alist, this also
-defines the variable @code{@var{mode}-map}.
-
-The above three arguments @var{init-value}, @var{lighter}, and
-@var{keymap} can be (partially) omitted when @var{keyword-args} are
-used. The @var{keyword-args} consist of keywords followed by
+The @var{keyword-args} consist of keywords followed by
corresponding values. A few keywords have special meanings:
@table @code
-@item :group @var{group}
-Custom group name to use in all generated @code{defcustom} forms.
-Defaults to @var{mode} without the possible trailing @samp{-mode}.
-@strong{Warning:} don't use this default group name unless you have
-written a @code{defgroup} to define that group properly. @xref{Group
-Definitions}.
-
@item :global @var{global}
If non-@code{nil}, this specifies that the minor mode should be global
rather 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
through the Customize interface turns the mode on and off, and its
value can be saved for future Emacs sessions (@pxref{Saving
Customizations,,, emacs, The GNU Emacs Manual}. For the saved
-variable to work, you should ensure that the @code{define-minor-mode}
-form is evaluated each time Emacs starts; for packages that are not
-part of Emacs, the easiest way to do this is to specify a
-@code{:require} keyword.
+variable to work, you should ensure that the minor mode function
+is available each time Emacs starts; usually this is done by
+marking the @code{define-minor-mode} form as autoloaded.
@item :init-value @var{init-value}
-This is equivalent to specifying @var{init-value} positionally.
+This is the value to which the @var{mode} variable is initialized.
+Except in unusual circumstances (see below), this value must be
+@code{nil}.
@item :lighter @var{lighter}
-This is equivalent to specifying @var{lighter} positionally.
+The string @var{lighter} says what to display in the mode line
+when the mode is enabled; if it is @code{nil}, the mode is not displayed
+in the mode line.
@item :keymap @var{keymap}
-This is equivalent to specifying @var{keymap} positionally.
+The optional argument @var{keymap} specifies the keymap for the minor
+mode. If non-@code{nil}, it should be a variable name (whose value is
+a keymap), a keymap, or an alist of the form
+
+@example
+(@var{key-sequence} . @var{definition})
+@end example
+
+@noindent
+where each @var{key-sequence} and @var{definition} are arguments
+suitable for passing to @code{define-key} (@pxref{Changing Key
+Bindings}). If @var{keymap} is a keymap or an alist, this also
+defines the variable @code{@var{mode}-map}.
@item :variable @var{place}
This replaces the default variable @var{mode}, used to store the state
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 0d0caeb..d8091f1 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2411,7 +2411,7 @@ that is evaluated. For example:
@noindent
Although the list @code{(0.5)} was mutable when it was created, it should not
-have been changed via @code{setcar} because it given to @code{eval}. The
+have been changed via @code{setcar} because it was given to @code{eval}. The
reverse does not occur: an object that should not be changed never
becomes mutable afterwards.
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index b324649..0dfdac7 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1325,7 +1325,7 @@ the numeric ID of the foreground process group of
@var{process}; it
returns @code{nil} if Emacs can be certain that this is not so. The
value is @code{t} if Emacs cannot tell whether this is true. This
function signals an error if @var{process} is a network, serial, or
-pipe connection, or is the subprocess is not active.
+pipe connection, or if the subprocess is not active.
@end defun
@node Signals to Processes
@@ -3410,8 +3410,9 @@ Unsigned integer in little endian order, with
@var{bitlen} bits.
@item str @var{len}
String of bytes of length @var{len}.
-@item strz @var{len}
-Zero-terminated string of bytes, in a fixed-size field with length @var{len}.
+@item strz &optional @var{len}
+Zero-terminated string of bytes, can be of arbitrary length or in a fixed-size
+field with length @var{len}.
@item vec @var{len} [@var{type}]
Vector of @var{len} elements. The type of the elements is given by
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index e106f39..fc2e3f3 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -515,8 +515,8 @@ below the @code{completion-cycle-threshold}), press
@kbd{M-?}.
@subsection pcomplete
Pcomplete, short for programmable completion, is the completion
library originally written for Eshell, but usable for command
-completion@footnote{Command completion as opposed to code completion,
-which is a beyond the scope of pcomplete.} in other modes.
+completion@footnote{Command completion, as opposed to code completion,
+which is beyond the scope of pcomplete.} in other modes.
Completions are defined as functions (with @code{defun}) named
@code{pcomplete/COMMAND}, where @code{COMMAND} is the name of the
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 6e82a97..cc546a9 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
only display this part. This usually gets rid of menus and the like.
@findex eww-toggle-fonts
-@findex shr-use-fonts
+@vindex shr-use-fonts
@kindex F
The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use
variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable.
@findex eww-toggle-colors
-@findex shr-use-colors
-@kindex F
+@vindex shr-use-colors
+@kindex M-C
The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use
HTML-specified colors or not. This sets the @code{shr-use-colors} variable.
+@findex eww-toggle-images
+@vindex shr-inhibit-images
+@kindex M-I
+@cindex Image Display
+ The @kbd{M-I} command (@code{eww-toggle-images}, capital letter i)
+toggles whether to display images or not. This also sets the
+@code{shr-inhibit-images} variable.
+
@findex eww-download
@vindex eww-download-directory
@kindex d
@@ -305,6 +313,11 @@ of the width and height. If Emacs supports image scaling
(ImageMagick
support required) then larger images are scaled down. You can block
specific images completely by customizing @code{shr-blocked-images}.
+@vindex shr-inhibit-images
+ You can control image display by customizing
+@code{shr-inhibit-images}. If this variable is @code{nil}, display
+the ``ALT'' text of images instead.
+
@vindex shr-color-visible-distance-min
@vindex shr-color-visible-luminance-min
@cindex Contrast
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index 1497c71..d2353e6 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -1792,8 +1792,89 @@ member list with elements @code{CC} and @code{To}, then
@code{message-carefully-insert-headers} will not insert a @code{To}
header when the message is already @code{CC}ed to the recipient.
+@item message-syntax-checks
+@vindex message-syntax-checks
+Controls what syntax checks should not be performed on outgoing posts.
+To disable checking of long signatures, for instance, add
+
+@lisp
+(signature . disabled)
+@end lisp
+
+to this list.
+
+Valid checks are:
+
+@table @code
+@item approved
+@cindex approved
+Check whether the article has an @code{Approved} header, which is
+something only moderators should include.
+@item continuation-headers
+Check whether there are continuation header lines that don't begin with
+whitespace.
+@item control-chars
+Check for invalid characters.
+@item empty
+Check whether the article is empty.
+@item existing-newsgroups
+Check whether the newsgroups mentioned in the @code{Newsgroups} and
+@code{Followup-To} headers exist.
+@item from
+Check whether the @code{From} header seems nice.
+@item illegible-text
+Check whether there is any non-printable character in the body.
+@item invisible-text
+Check whether there is any invisible text in the buffer.
+@item long-header-lines
+Check for too long header lines.
+@item long-lines
+@cindex long lines
+Check for too long lines in the body.
+@item message-id
+Check whether the @code{Message-ID} looks syntactically ok.
+@item multiple-headers
+Check for the existence of multiple equal headers.
+@item new-text
+Check whether there is any new text in the messages.
+@item newsgroups
+Check whether the @code{Newsgroups} header exists and is not empty.
+@item quoting-style
+Check whether text follows last quoted portion.
+@item repeated-newsgroups
+Check whether the @code{Newsgroups} and @code{Followup-To} headers
+contains repeated group names.
+@item reply-to
+Check whether the @code{Reply-To} header looks ok.
+@item sender
+@cindex Sender
+Insert a new @code{Sender} header if the @code{From} header looks odd.
+@item sendsys
+@cindex sendsys
+Check for the existence of version and sendsys commands.
+@item shoot
+Check whether the domain part of the @code{Message-ID} header looks ok.
+@item shorten-followup-to
+Check whether to add a @code{Followup-To} header to shorten the number
+of groups to post to.
+@item signature
+Check the length of the signature.
+@item size
+Check for excessive size.
+@item subject
+Check whether the @code{Subject} header exists and is not empty.
+@item subject-cmsg
+Check the subject for commands.
+@item valid-newsgroups
+Check whether the @code{Newsgroups} and @code{Followup-To} headers
+are valid syntactically.
@end table
+All these conditions are checked by default, except for @code{sender}
+for which the check is disabled by default if
+@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
+
+@end table
@node Mail Headers
@section Mail Headers
@@ -2072,88 +2153,6 @@ Other variables for customizing outgoing news articles:
@table @code
-@item message-syntax-checks
-@vindex message-syntax-checks
-Controls what syntax checks should not be performed on outgoing posts.
-To disable checking of long signatures, for instance, add
-
-@lisp
-(signature . disabled)
-@end lisp
-
-to this list.
-
-Valid checks are:
-
-@table @code
-@item approved
-@cindex approved
-Check whether the article has an @code{Approved} header, which is
-something only moderators should include.
-@item continuation-headers
-Check whether there are continuation header lines that don't begin with
-whitespace.
-@item control-chars
-Check for invalid characters.
-@item empty
-Check whether the article is empty.
-@item existing-newsgroups
-Check whether the newsgroups mentioned in the @code{Newsgroups} and
-@code{Followup-To} headers exist.
-@item from
-Check whether the @code{From} header seems nice.
-@item illegible-text
-Check whether there is any non-printable character in the body.
-@item invisible-text
-Check whether there is any invisible text in the buffer.
-@item long-header-lines
-Check for too long header lines.
-@item long-lines
-@cindex long lines
-Check for too long lines in the body.
-@item message-id
-Check whether the @code{Message-ID} looks syntactically ok.
-@item multiple-headers
-Check for the existence of multiple equal headers.
-@item new-text
-Check whether there is any new text in the messages.
-@item newsgroups
-Check whether the @code{Newsgroups} header exists and is not empty.
-@item quoting-style
-Check whether text follows last quoted portion.
-@item repeated-newsgroups
-Check whether the @code{Newsgroups} and @code{Followup-To} headers
-contains repeated group names.
-@item reply-to
-Check whether the @code{Reply-To} header looks ok.
-@item sender
-@cindex Sender
-Insert a new @code{Sender} header if the @code{From} header looks odd.
-@item sendsys
-@cindex sendsys
-Check for the existence of version and sendsys commands.
-@item shoot
-Check whether the domain part of the @code{Message-ID} header looks ok.
-@item shorten-followup-to
-Check whether to add a @code{Followup-To} header to shorten the number
-of groups to post to.
-@item signature
-Check the length of the signature.
-@item size
-Check for excessive size.
-@item subject
-Check whether the @code{Subject} header exists and is not empty.
-@item subject-cmsg
-Check the subject for commands.
-@item valid-newsgroups
-Check whether the @code{Newsgroups} and @code{Followup-To} headers
-are valid syntactically.
-@end table
-
-All these conditions are checked by default, except for @code{sender}
-for which the check is disabled by default if
-@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
-
@item message-ignored-news-headers
@vindex message-ignored-news-headers
Regexp of headers to be removed before posting. The default is@*
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 5ea0275..40245ac 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5067,6 +5067,33 @@ remote files}.
@item
+How to prevent @value{tramp} from clearing the @code{recentf-list}?
+
+When @value{tramp} cleans a connection, it removes the respective
+remote file name(s) from @code{recentf-list}. This is needed, because
+an unresponsive remote host could trigger @code{recentf} to connect
+that host again and again.
+
+If you find the cleanup disturbing, because the file names in
+@code{recentf-list} are precious to you, you could add the following
+two forms in your @file{~/.emacs} after loading the @code{tramp} and
+@code{recentf} packages:
+
+@lisp
+@group
+(remove-hook
+ 'tramp-cleanup-connection-hook
+ #'tramp-recentf-cleanup)
+@end group
+@group
+(remove-hook
+ 'tramp-cleanup-all-connections-hook
+ #'tramp-recentf-cleanup-all)
+@end group
+@end lisp
+
+
+@item
I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs
c.d}
@value{tramp} comes with compatibility code for different Emacs
diff --git a/etc/NEWS b/etc/NEWS
index 1421efc..b641e8d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -90,6 +90,17 @@ lacks the terminfo database, you can instruct Emacs to
support 24-bit
true color by setting 'COLORTERM=truecolor' in the environment. This is
useful on systems such as FreeBSD which ships only with "etc/termcap".
+** Emacs now supports loading a Secure Computing filter.
+This is supported only on capable GNU/Linux systems. To activate,
+invoke Emacs with the '--seccomp=FILE' command-line option. FILE must
+name a binary file containing an array of 'struct sock_filter'
+structures. Emacs will then install that list of Secure Computing
+filters into its own process early during the startup process. You
+can use this functionality to put an Emacs process in a sandbox to
+avoid security issues when executing untrusted code. See the manual
+page for 'seccomp' system call, for details about Secure Computing
+filters.
+
* Changes in Emacs 28.1
@@ -265,6 +276,9 @@ input using the minibuffer.
* Editing Changes in Emacs 28.1
+++
+** A prefix arg now causes 'delete-other-frames' to only iconify frames
+
++++
** New command 'execute-extended-command-for-buffer'.
This new command, bound to 'M-S-x', works like
'execute-extended-command', but limits the set of commands to the
@@ -367,6 +381,12 @@ trying to be non-destructive.
This command opens a new buffer called "*Memory Report*" and gives a
summary of where Emacs is using memory currently.
++++
+** New user option 'isearch-repeat-on-direction-change'.
+When this option is set, direction changes in Isearch move to another
+search match, if there is one, instead of moving point to the other
+end of the current match.
+
** Outline
+++
@@ -477,6 +497,13 @@ documented.
SMIE is now always enabled and 'ruby-use-smie' only controls whether
indentation is done using SMIE or with the old ad-hoc code.
+** Icomplete
+
++++
+*** New minor mode Icomplete-Vertical mode.
+This mode is intended to be used with Icomplete or Fido, to display the
+list of completions candidates vertically instead of horizontally.
+
---
** Specific warnings can now be disabled from the warning buffer.
When a warning is displayed to the user, the resulting buffer now has
@@ -929,6 +956,14 @@ take the actual screenshot, and defaults to "ImageMagick
import".
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
+** Search and Replace
+
+*** New user option 'isearch-wrap-pause' defines how to wrap the search.
+There are choices to disable wrapping completely and to wrap immediately.
+When wrapping immediately, it consistently handles the numeric arguments
+of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
+continuing with the remaining count after wrapping.
+
** Grep
+++
@@ -1524,6 +1559,13 @@ will match the font size in use where it is embedded.
This feature relies on librsvg 2.48 or above being available.
++++
+*** Image properties support 'em' sizes.
+Size image properties, for example ':height', ':max-height', etc., can
+be given a cons of the form '(SIZE . em)', where SIZE is an integer or
+float which is multiplied by the font size to calculate the image
+size, and em is a symbol.
+
** EWW
+++
@@ -2251,6 +2293,10 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo
many changes,
'M-g n n p p' to navigate next-error matches. Any other key exits
transient mode and then is executed normally. 'repeat-exit-key'
defines an additional key to exit mode like 'isearch-exit' ('RET').
+With 'repeat-keep-prefix' you can keep the prefix arg of the previous command.
+For example, this can help to reverse the window navigation direction
+with e.g. 'C-x o M-- o o'. Also it can help to set a new step with
+e.g. 'C-x { C-5 { { {' will set the window resizing step to 5 columns.
* New Modes and Packages in Emacs 28.1
@@ -2327,6 +2373,11 @@ This is to keep the same behavior as Eshell.
* Incompatible Lisp Changes in Emacs 28.1
++++
+** The use of positional arguments in 'define-minor-mode' is obsolete.
+These were actually rendered obsolete in Emacs-21 but were never
+marked as such.
+
** 'facemenu-color-alist' is now obsolete, and is not used.
** 'facemenu.el' is no longer preloaded.
@@ -2391,11 +2442,6 @@ parameter.
by mistake and were not useful to Lisp code.
---
-** Loading 'generic-x' unconditionally loads all modes.
-The user option 'generic-extras-enable-list' is now obsolete, and
-setting it has no effect.
-
----
** The 'load-dangerous-libraries' variable is now obsolete.
It was used to allow loading Lisp libraries compiled by XEmacs, a
modified version of Emacs which is no longer actively maintained.
@@ -2511,6 +2557,12 @@ back in Emacs 23.1. The affected functions are:
'make-obsolete',
** The 'values' variable is now obsolete.
++++
+** The '&define' keyword in an Edebug specification now disables backtracking.
+The implementation was buggy, and multiple &define forms in an &or
+form should be exceedingly rare. See the Info node 'Backtracking' in
+the Emacs Lisp reference manual for background.
+
* Lisp Changes in Emacs 28.1
@@ -2620,6 +2672,11 @@ argument ELLIPSIS, will now indicate truncation using
'…' when
the selected frame can display it, and using "..." otherwise.
+++
+** 'string-width' now accepts two optional arguments FROM and TO.
+This allows calculating the width of a substring without consing a
+new string.
+
++++
** New command 'make-directory-autoloads'.
This does the same as the old command 'update-directory-autoloads',
but has different semantics: Instead of passing in the output file via
@@ -2885,6 +2942,12 @@ arrays nor objects.
The special events 'dbus-event' and 'file-notify' are now ignored in
'while-no-input' when added to this variable.
++++
+** 'condition-case' now allows for a success handler.
+It is written as (:success BODY...) where BODY is executed whenever
+the protected form terminates without error, with the specified
+variable bound to the the value of the protected form.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 05eb524..923d0cf 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -189,6 +189,30 @@ LIB_WSOCK32=@LIB_WSOCK32@
## Extra libraries for etags
LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM)
+HAVE_SECCOMP=@HAVE_SECCOMP@
+HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@
+LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@
+LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@
+
+# Currently, we can only generate seccomp filter files for x86-64.
+ifeq ($(HAVE_SECCOMP),yes)
+ifeq ($(HAVE_LIBSECCOMP),yes)
+ifeq ($(shell uname -m),x86_64)
+# We require SECCOMP_RET_KILL_PROCESS, which is only available in
+# Linux 4.14 and later.
+ifeq ($(shell { echo 4.14; uname -r | cut -d . -f 1-2; } | \
+ sort -C -t . -n -k 1,1 -k 2,2 && \
+ echo 1),1)
+SECCOMP_FILTER=1
+endif
+endif
+endif
+endif
+
+ifeq ($(SECCOMP_FILTER),1)
+DONT_INSTALL += seccomp-filter$(EXEEXT)
+endif
+
## Extra libraries to use when linking movemail.
LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
$(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS)
@@ -218,6 +242,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h
all: ${EXE_FILES} ${SCRIPTS}
+ifeq ($(SECCOMP_FILTER),1)
+all: seccomp-filter.bpf seccomp-filter-exec.bpf
+endif
+
.PHONY: all need-blessmail maybe-blessmail
LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
@@ -400,4 +428,15 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c
$(NTLIB) $(config_h)
emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico
$(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $<
+ifeq ($(SECCOMP_FILTER),1)
+seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h)
+ $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \
+ $(LIBSECCOMP_LIBS) -o $@
+
+seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf
seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT)
+ $(AM_V_GEN)./seccomp-filter$(EXEEXT) \
+ seccomp-filter.bpf seccomp-filter.pfc \
+ seccomp-filter-exec.bpf seccomp-filter-exec.pfc
+endif
+
## Makefile ends here.
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
new file mode 100644
index 0000000..fc3c3a0
--- /dev/null
+++ b/lib-src/seccomp-filter.c
@@ -0,0 +1,363 @@
+/* Generate a Secure Computing filter definition file.
+
+Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation, either version 3 of the License, or (at your
+option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see
+<https://www.gnu.org/licenses/>. */
+
+/* This program creates a small Secure Computing filter usable for a
+typical minimal Emacs sandbox. See the man page for `seccomp' for
+details about Secure Computing filters. This program requires the
+`libseccomp' library. However, the resulting filter file requires
+only a Linux kernel supporting the Secure Computing extension.
+
+Usage:
+
+ seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc
+
+This writes the raw `struct sock_filter' array to out.bpf and a
+human-readable representation to out.pfc. Additionally, it writes
+variants of those files that can be used to sandbox Emacs before
+'execve' to out-exec.bpf and out-exec.pfc. */
+
+#include "config.h"
+
+#include <errno.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <time.h>
+
+#include <asm/prctl.h>
+#include <sys/ioctl.h>
+#include <sys/mman.h>
+#include <sys/prctl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <linux/futex.h>
+#include <linux/filter.h>
+#include <linux/seccomp.h>
+#include <fcntl.h>
+#include <sched.h>
+#include <seccomp.h>
+#include <unistd.h>
+
+#include "verify.h"
+
+static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void
+fail (int error, const char *format, ...)
+{
+ va_list ap;
+ va_start (ap, format);
+ if (error == 0)
+ {
+ vfprintf (stderr, format, ap);
+ fputc ('\n', stderr);
+ }
+ else
+ {
+ char buffer[1000];
+ vsnprintf (buffer, sizeof buffer, format, ap);
+ errno = error;
+ perror (buffer);
+ }
+ va_end (ap);
+ fflush (NULL);
+ exit (EXIT_FAILURE);
+}
+
+/* This binary is trivial, so we use a single global filter context
+ object that we release using `atexit'. */
+
+static scmp_filter_ctx ctx;
+
+static void
+release_context (void)
+{
+ seccomp_release (ctx);
+}
+
+/* Wrapper functions and macros for libseccomp functions. We exit
+ immediately upon any error to avoid error checking noise. */
+
+static void
+set_attribute (enum scmp_filter_attr attr, uint32_t value)
+{
+ int status = seccomp_attr_set (ctx, attr, value);
+ if (status < 0)
+ fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value);
+}
+
+/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you
+ don't have to specify the number of comparator arguments, and any
+ failure will exit the process. */
+
+#define RULE(action, syscall, ...) \
+ do \
+ { \
+ const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \
+ enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \
+ int status = seccomp_rule_add_array (ctx, (action), (syscall), \
+ arg_cnt, arg_array); \
+ if (status < 0) \
+ fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \
+ #action, #syscall, arg_cnt, #__VA_ARGS__); \
+ } \
+ while (false)
+
+static void
+export_filter (const char *file,
+ int (*function) (const scmp_filter_ctx, int),
+ const char *name)
+{
+ int fd = TEMP_FAILURE_RETRY (
+ open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC,
+ 0644));
+ if (fd < 0)
+ fail (errno, "open %s", file);
+ int status = function (ctx, fd);
+ if (status < 0)
+ fail (-status, "%s", name);
+ if (close (fd) != 0)
+ fail (errno, "close");
+}
+
+#define EXPORT_FILTER(file, function) \
+ export_filter ((file), (function), #function)
+
+int
+main (int argc, char **argv)
+{
+ if (argc != 5)
+ fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc",
+ argv[0]);
+
+ /* Any unhandled syscall should abort the Emacs process. */
+ ctx = seccomp_init (SCMP_ACT_KILL_PROCESS);
+ if (ctx == NULL)
+ fail (0, "seccomp_init");
+ atexit (release_context);
+
+ /* We want to abort immediately if the architecture is unknown. */
+ set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS);
+ set_attribute (SCMP_FLTATR_CTL_NNP, 1);
+ set_attribute (SCMP_FLTATR_CTL_TSYNC, 1);
+
+ verify (CHAR_BIT == 8);
+ verify (sizeof (int) == 4 && INT_MIN == INT32_MIN
+ && INT_MAX == INT32_MAX);
+ verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN
+ && LONG_MAX == INT64_MAX);
+ verify (sizeof (void *) == 8);
+ verify ((uintptr_t) NULL == 0);
+
+ /* Allow a clean exit. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group));
+
+ /* Allow `mmap' and friends. This is necessary for dynamic loading,
+ reading the portable dump file, and thread creation. We don't
+ allow pages to be both writable and executable. */
+ verify (MAP_PRIVATE != 0);
+ verify (MAP_SHARED != 0);
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(PROT_NONE | PROT_READ | PROT_WRITE)),
+ /* Only support known flags. MAP_DENYWRITE is ignored, but
+ some versions of the dynamic loader still use it. Also
+ allow allocating thread stacks. */
+ SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
+ ~(MAP_PRIVATE | MAP_FILE | MAP_ANONYMOUS
+ | MAP_FIXED | MAP_DENYWRITE | MAP_STACK
+ | MAP_NORESERVE),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(PROT_NONE | PROT_READ | PROT_EXEC)),
+ /* Only support known flags. MAP_DENYWRITE is ignored, but
+ some versions of the dynamic loader still use it. */
+ SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
+ ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED
+ | MAP_DENYWRITE),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect),
+ /* Don't allow making pages executable. */
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(PROT_NONE | PROT_READ | PROT_WRITE), 0));
+
+ /* Futexes are used everywhere. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex),
+ SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE));
+
+ /* Allow basic dynamic memory management. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk));
+
+ /* Allow some status inquiries. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp));
+
+ /* Allow operations on open file descriptors. File descriptors are
+ capabilities, and operating on them shouldn't cause security
+ issues. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (read));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (write));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (close));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat));
+
+ /* Allow read operations on the filesystem. If necessary, these
+ should be further restricted using mount namespaces. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (access));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd));
+
+ /* Allow opening files, assuming they are only opened for
+ reading. */
+ verify (O_WRONLY != 0);
+ verify (O_RDWR != 0);
+ verify (O_CREAT != 0);
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (open),
+ SCMP_A1_32 (SCMP_CMP_MASKED_EQ,
+ ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
+ | O_DIRECTORY | O_NOFOLLOW),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat),
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
+ | O_DIRECTORY | O_NOFOLLOW),
+ 0));
+
+ /* Allow `tcgetpgrp'. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO),
+ SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP));
+
+ /* Allow reading (but not setting) file flags. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl),
+ SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64),
+ SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
+
+ /* Allow reading random numbers from the kernel. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom));
+
+ /* Changing the umask is uncritical. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask));
+
+ /* Allow creation of pipes. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2));
+
+ /* Allow reading (but not changing) resource limits. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64),
+ SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
+ SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */);
+
+ /* Block changing resource limits, but don't crash. */
+ RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64),
+ SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
+ SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */);
+
+ /* Emacs installs signal handlers, which is harmless. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask));
+
+ /* Allow reading the current time. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime),
+ SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (time));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday));
+
+ /* Allow timer support. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create));
+
+ /* Allow thread creation. See the NOTES section in the manual page
+ for the `clone' function. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone),
+ SCMP_A0_64 (SCMP_CMP_MASKED_EQ,
+ /* Flags needed to create threads. See
+ create_thread in libc. */
+ ~(CLONE_VM | CLONE_FS | CLONE_FILES
+ | CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD
+ | CLONE_SETTLS | CLONE_PARENT_SETTID
+ | CLONE_CHILD_CLEARTID),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list));
+
+ /* Allow setting the process name for new threads. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME));
+
+ /* Allow some event handling functions used by glib. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll));
+
+ /* Don't allow creating sockets (network access would be extremely
+ dangerous), but also don't crash. */
+ RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket));
+
+ EXPORT_FILTER (argv[1], seccomp_export_bpf);
+ EXPORT_FILTER (argv[2], seccomp_export_pfc);
+
+ /* When applying a Seccomp filter before executing the Emacs binary
+ (e.g. using the `bwrap' program), we need to allow further system
+ calls. Firstly, the wrapper binary will need to `execve' the
+ Emacs binary. Furthermore, the C library requires some system
+ calls at startup time to set up thread-local storage. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs));
+
+ /* We want to allow starting the Emacs binary itself with the
+ --seccomp flag, so we need to allow the `prctl' and `seccomp'
+ system calls. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS),
+ SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0),
+ SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp),
+ SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER),
+ SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC));
+
+ EXPORT_FILTER (argv[3], seccomp_export_bpf);
+ EXPORT_FILTER (argv[4], seccomp_export_pfc);
+}
diff --git a/lisp/align.el b/lisp/align.el
index 7ae067f..a0b626a 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1587,8 +1587,6 @@ aligner would have dealt with are."
(if report
(message "Aligning...done"))))
-;; Provide:
-
(provide 'align)
(run-hooks 'align-load-hook)
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 931dfbc..90f3f61 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -2290,7 +2290,6 @@ The elements of LIST are not copied, just the list
structure itself."
(define-obsolete-function-alias 'allout-frame-property #'frame-parameter
"28.1")
-;;;_ : provide
(provide 'allout-widgets)
;;;_ . Local emacs vars.
diff --git a/lisp/allout.el b/lisp/allout.el
index f50f5fd..1605ce2 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -6457,7 +6457,6 @@ If BEG is bigger than END we return 0."
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.
diff --git a/lisp/array.el b/lisp/array.el
index cd8971b..6632da5 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -1,4 +1,4 @@
-;;; array.el --- array editing commands for GNU Emacs
+;;; array.el --- array editing commands for GNU Emacs -*- lexical-binding: t;
-*-
;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc.
@@ -769,25 +769,25 @@ Return COLUMN."
(defvar array-mode-map
(let ((map (make-keymap)))
- (define-key map "\M-ad" 'array-display-local-variables)
- (define-key map "\M-am" 'array-make-template)
- (define-key map "\M-ae" 'array-expand-rows)
- (define-key map "\M-ar" 'array-reconfigure-rows)
- (define-key map "\M-a=" 'array-what-position)
- (define-key map "\M-ag" 'array-goto-cell)
- (define-key map "\M-af" 'array-fill-rectangle)
- (define-key map "\C-n" 'array-next-row)
- (define-key map "\C-p" 'array-previous-row)
- (define-key map "\C-f" 'array-forward-column)
- (define-key map "\C-b" 'array-backward-column)
- (define-key map "\M-n" 'array-copy-down)
- (define-key map "\M-p" 'array-copy-up)
- (define-key map "\M-f" 'array-copy-forward)
- (define-key map "\M-b" 'array-copy-backward)
- (define-key map "\M-\C-n" 'array-copy-row-down)
- (define-key map "\M-\C-p" 'array-copy-row-up)
- (define-key map "\M-\C-f" 'array-copy-column-forward)
- (define-key map "\M-\C-b" 'array-copy-column-backward)
+ (define-key map "\M-ad" #'array-display-local-variables)
+ (define-key map "\M-am" #'array-make-template)
+ (define-key map "\M-ae" #'array-expand-rows)
+ (define-key map "\M-ar" #'array-reconfigure-rows)
+ (define-key map "\M-a=" #'array-what-position)
+ (define-key map "\M-ag" #'array-goto-cell)
+ (define-key map "\M-af" #'array-fill-rectangle)
+ (define-key map "\C-n" #'array-next-row)
+ (define-key map "\C-p" #'array-previous-row)
+ (define-key map "\C-f" #'array-forward-column)
+ (define-key map "\C-b" #'array-backward-column)
+ (define-key map "\M-n" #'array-copy-down)
+ (define-key map "\M-p" #'array-copy-up)
+ (define-key map "\M-f" #'array-copy-forward)
+ (define-key map "\M-b" #'array-copy-backward)
+ (define-key map "\M-\C-n" #'array-copy-row-down)
+ (define-key map "\M-\C-p" #'array-copy-row-up)
+ (define-key map "\M-\C-f" #'array-copy-column-forward)
+ (define-key map "\M-\C-b" #'array-copy-column-backward)
map)
"Keymap used in array mode.")
@@ -815,17 +815,17 @@ in array mode may have different values assigned to the
variables.
The variables are:
Variables you assign:
- array-max-row: The number of rows in the array.
- array-max-column: The number of columns in the array.
- array-columns-per-line: The number of columns in the array
+ `array-max-row': The number of rows in the array.
+ `array-max-column': The number of columns in the array.
+ `array-columns-per-line': The number of columns in the array
per line of buffer.
- array-field-width: The width of each field, in characters.
- array-rows-numbered: A logical variable describing whether to ignore
+ `array-field-width': The width of each field, in characters.
+ `array-rows-numbered': A logical variable describing whether to ignore
row numbers in the buffer.
Variables which are calculated:
- array-line-length: The number of characters in a buffer line.
- array-lines-per-row: The number of buffer lines used to
+ `array-line-length': The number of characters in a buffer line.
+ `array-lines-per-row': The number of buffer lines used to
display each row.
The following commands are available (an asterisk indicates it may
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index c2cb0c7..7c2c6f1 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -107,7 +107,7 @@ then invokes the normal binding of \\[autoarg-terminate].
`C-u \\[autoarg-terminate]' invokes the normal binding of
\\[autoarg-terminate] four times.
\\{autoarg-mode-map}"
- nil " Aarg" autoarg-mode-map :global t :group 'keyboard)
+ :lighter" Aarg" :global t :group 'keyboard)
;;;###autoload
(define-minor-mode autoarg-kp-mode
@@ -118,7 +118,7 @@ This is similar to `autoarg-mode' but rebinds the keypad
keys
`kp-1' etc. to supply digit arguments.
\\{autoarg-kp-mode-map}"
- nil " Aakp" autoarg-kp-mode-map :global t :group 'keyboard
+ :lighter " Aakp" :global t :group 'keyboard
(if autoarg-kp-mode
(dotimes (i 10)
(let ((sym (intern (format "kp-%d" i))))
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 57258f9..edd4c7e 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -227,10 +227,10 @@ modes, etc., of files. You may still sometimes want to
revert
them manually.
Use this option with care since it could lead to excessive auto-reverts.
-For more information, see Info node `(emacs)Autorevert'."
+For more information, see Info node `(emacs)Auto Revert'."
:group 'auto-revert
:type 'boolean
- :link '(info-link "(emacs)Autorevert"))
+ :link '(info-link "(emacs)Auto Revert"))
(defcustom global-auto-revert-ignore-modes ()
"List of major modes Global Auto-Revert Mode should not check."
@@ -937,7 +937,6 @@ the timer when no buffers need to be checked."
(cancel-timer auto-revert-timer))
(setq auto-revert-timer nil)))))
-;; The end:
(provide 'autorevert)
(run-hooks 'auto-revert-load-hook)
diff --git a/lisp/bs.el b/lisp/bs.el
index 154e359..494bc42 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -1504,7 +1504,6 @@ name of buffer configuration."
;; continue standard unloading
nil)
-;; Now provide feature bs
(provide 'bs)
;;; bs.el ends here
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 1327cf0..162026d 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -444,12 +444,12 @@ Code can refer to the expression to simplify via lexical
variable `expr'
and should return the simplified expression to use (or nil)."
(declare (indent 1) (debug (sexp body)))
(cons 'progn
- (mapcar #'(lambda (func)
- `(put ',func 'math-simplify
- (nconc
- (get ',func 'math-simplify)
- (list
- #'(lambda (expr) ,@code)))))
+ (mapcar (lambda (func)
+ `(put ',func 'math-simplify
+ (nconc
+ (get ',func 'math-simplify)
+ (list
+ (lambda (expr) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(math-defsimplify (+ -)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 24781ed..e85ecf0 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -2784,23 +2784,23 @@ If X is not an error form, return 1."
(declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
- (mapcar #'(lambda (func)
- `(put ',func 'math-integral
- (nconc
- (get ',func 'math-integral)
- (list
- #'(lambda (u) ,@code)))))
+ (mapcar (lambda (func)
+ `(put ',func 'math-integral
+ (nconc
+ (get ',func 'math-integral)
+ (list
+ (lambda (u) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(defmacro math-defintegral-2 (funcs &rest code)
(declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
- (mapcar #'(lambda (func)
- `(put ',func 'math-integral-2
- (nconc
- (get ',func 'math-integral-2)
- (list #'(lambda (u v) ,@code)))))
+ (mapcar (lambda (func)
+ `(put ',func 'math-integral-2
+ (nconc
+ (get ',func 'math-integral-2)
+ (list (lambda (u v) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(defvar var-IntegAfterRules 'calc-IntegAfterRules)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index dd22145..4e27d76 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1881,9 +1881,9 @@ Redefine the corresponding command."
(if (fboundp (setq chk (intern (concat "math-" qual-name))))
(append rest
(if is-rest
- `((mapcar #'(lambda (x)
- (or (,chk x)
- (math-reject-arg x ',qual)))
+ `((mapcar (lambda (x)
+ (or (,chk x)
+ (math-reject-arg x ',qual)))
,var))
`((or (,chk ,var)
(math-reject-arg ,var ',qual)))))
@@ -1894,9 +1894,9 @@ Redefine the corresponding command."
qual-name 1))))))
(append rest
(if is-rest
- `((mapcar #'(lambda (x)
- (and (,chk x)
- (math-reject-arg x ',qual)))
+ `((mapcar (lambda (x)
+ (and (,chk x)
+ (math-reject-arg x ',qual)))
,var))
`((and
(,chk ,var)
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 6dd8d9a..99c9b62 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -836,10 +836,11 @@ The result should not exceed the screen width."
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
- (string-to-number str (cadr (assq calculator-input-radix
- '((bin 2) (oct 8) (hex 16)))))
- ;; Allow entry of "1.e3".
- (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str)))
+ (string-to-number str (cadr (assq calculator-input-radix
+ '((bin 2) (oct 8) (hex 16)))))
+ ;; parse numbers similarly to calculators
+ ;; (see tests in test/lisp/calculator-tests.el)
+ (let ((str (replace-regexp-in-string "\\.\\([^0-9].*\\)?$" ".0\\1" str)))
(float (string-to-number str)))))
(defun calculator-push-curnum ()
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 04b525e..6eb086a 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -581,19 +581,19 @@ ALIST is a VTIMEZONE potentially containing historical
records."
(list
(car
(sort components
- #'(lambda (a b)
- (let* ((get-recent (lambda (n)
- (car
- (sort
- (delq nil
- (mapcar (lambda (p)
- (and (memq (car p)
'(DTSTART RDATE))
- (car (cddr p))))
- n))
- 'string-greaterp))))
- (a-recent (funcall get-recent (car (cddr a))))
- (b-recent (funcall get-recent (car (cddr b)))))
- (string-greaterp a-recent b-recent))))))))
+ (lambda (a b)
+ (let* ((get-recent (lambda (n)
+ (car
+ (sort
+ (delq nil
+ (mapcar (lambda (p)
+ (and (memq (car p)
'(DTSTART RDATE))
+ (car (cddr p))))
+ n))
+ 'string-greaterp))))
+ (a-recent (funcall get-recent (car (cddr a))))
+ (b-recent (funcall get-recent (car (cddr b)))))
+ (string-greaterp a-recent b-recent))))))))
(defun icalendar--convert-all-timezones (icalendar)
"Convert all timezones in the ICALENDAR into an alist.
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index aa3236c..5a3d270 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."
((4) parse-time-months)
((5) (100))
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 8)
- (= (aref parse-time-elt 2) ?:)
- (= (aref parse-time-elt 5) ?:)))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 8)
+ (= (aref parse-time-elt 2) ?:)
+ (= (aref parse-time-elt 5) ?:)))
[0 2] [3 5] [6 8])
((8 7) parse-time-zoneinfo
- ,#'(lambda () (car parse-time-val))
- ,#'(lambda () (cadr parse-time-val)))
+ ,(lambda () (car parse-time-val))
+ ,(lambda () (cadr parse-time-val)))
((8)
- ,#'(lambda ()
- (and (stringp parse-time-elt)
- (= 5 (length parse-time-elt))
- (or (= (aref parse-time-elt 0) ?+)
- (= (aref parse-time-elt 0) ?-))))
- ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
- (* 60 (cl-parse-integer parse-time-elt :start 1
:end 3)))
- (if (= (aref parse-time-elt 0) ?-) -1 1))))
+ ,(lambda ()
+ (and (stringp parse-time-elt)
+ (= 5 (length parse-time-elt))
+ (or (= (aref parse-time-elt 0) ?+)
+ (= (aref parse-time-elt 0) ?-))))
+ ,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
+ (* 60 (cl-parse-integer parse-time-elt :start 1 :end
3)))
+ (if (= (aref parse-time-elt 0) ?-) -1 1))))
((5 4 3)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 10)
- (= (aref parse-time-elt 4) ?-)
- (= (aref parse-time-elt 7) ?-)))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 10)
+ (= (aref parse-time-elt 4) ?-)
+ (= (aref parse-time-elt 7) ?-)))
[0 4] [5 7] [8 10])
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 5)
- (= (aref parse-time-elt 2) ?:)))
- [0 2] [3 5] ,#'(lambda () 0))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 5)
+ (= (aref parse-time-elt 2) ?:)))
+ [0 2] [3 5] ,(lambda () 0))
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 4)
- (= (aref parse-time-elt 1) ?:)))
- [0 1] [2 4] ,#'(lambda () 0))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 4)
+ (= (aref parse-time-elt 1) ?:)))
+ [0 1] [2 4] ,(lambda () 0))
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 7)
- (= (aref parse-time-elt 1) ?:)))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 7)
+ (= (aref parse-time-elt 1) ?:)))
[0 1] [2 4] [5 7])
- ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
- ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
+ ((5) (50 110) ,(lambda () (+ 1900 parse-time-elt)))
+ ((5) (0 49) ,(lambda () (+ 2000 parse-time-elt))))
"(slots predicate extractor...)")
;;;###autoload(put 'parse-time-rules 'risky-local-variable t)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 1170e71..ebb2044 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -585,7 +585,7 @@ Overrides `semantic-nonterminal-static'."
;;; Context parsing
;;
-;; Emacs lisp is very different from C,C++ which most context parsing
+;; Emacs Lisp is very different from C,C++ which most context parsing
;; functions are written. Support them here.
(define-mode-local-override semantic-up-context emacs-lisp-mode
(&optional _point _bounds-type)
diff --git a/lisp/cedet/semantic/db-ebrowse.el
b/lisp/cedet/semantic/db-ebrowse.el
index efdf3df..682a4cc 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -222,7 +222,7 @@ warn instead."
;JAVE this just instantiates a default empty ebrowse struct?
; how would new instances wind up here?
-; the ebrowse class isn't singleton, unlike the emacs lisp one
+; the ebrowse class isn't singleton, unlike the Emacs Lisp one
(defvar-mode-local c++-mode semanticdb-project-system-databases
()
"Search Ebrowse for symbols.")
diff --git a/lisp/cedet/semantic/decorate/mode.el
b/lisp/cedet/semantic/decorate/mode.el
index 7895015..c6bf152 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
non-nil if the minor mode is enabled."
;;
;;\\{semantic-decoration-map}"
- nil nil nil
+ :lighter nil
(if semantic-decoration-mode
(if (not (and (featurep 'semantic) (semantic-active-p)))
(progn
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index dba289f..4c3bb6c 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -31,7 +31,12 @@
(require 'semantic/format)
;; FIXME this is a generated file, but we need to load this file to
;; generate it!
-(require 'semantic/grammar-wy)
+;; We need `semantic/grammar-wy.el' but we're also needed to generate
+;; that file from `grammar.wy', so to break the dependency, we keep
+;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008.
+(eval-and-compile
+ (unless (require 'semantic/grammar-wy nil t)
+ (load "semantic/grm-wy-boot")))
(require 'semantic/idle)
(require 'help-fns)
(require 'semantic/analyze)
diff --git a/lisp/cedet/semantic/grammar-wy.el
b/lisp/cedet/semantic/grm-wy-boot.el
similarity index 100%
rename from lisp/cedet/semantic/grammar-wy.el
rename to lisp/cedet/semantic/grm-wy-boot.el
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 420a457..b883573 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.)
The minor mode can be turned on only if semantic feature is
available and the current buffer was set up for parsing. Return
-non-nil if the minor mode is enabled." nil nil nil
+non-nil if the minor mode is enabled."
+ :lighter nil
(if semantic-idle-scheduler-mode
(if (not (and (featurep 'semantic) (semantic-active-p)))
(progn
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index d43cdb1..18087da 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -1,7 +1,6 @@
-;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
+;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*-
lexical-binding: t -*-
-;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1988-2021 Free Software Foundation, Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -26,20 +25,18 @@
;; This is a customization of comint-mode (see comint.el)
;;
-;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
+;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
;; 8/88
;;
;; Please send me bug reports, bug fixes, and extensions, so that I can
;; merge them into the master source.
;;
-;; The changelog is at the end of this file.
-;;
;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
;; interface that communicates process state back to the superior emacs by
-;; outputting special control sequences. The Emacs package, xscheme.el, has
+;; outputting special control sequences. The Emacs package, xscheme.el, has
;; lots and lots of special purpose code to read these control sequences, and
-;; so is very tightly integrated with the cscheme process. The cscheme
+;; so is very tightly integrated with the cscheme process. The cscheme
;; interrupt handler and debugger read single character commands in cbreak
;; mode; when this happens, xscheme.el switches to special keymaps that bind
;; the single letter command keys to emacs functions that directly send the
@@ -49,18 +46,18 @@
;;
;; Here's a summary of the pros and cons, as I see them.
;; xscheme: Tightly integrated with inferior cscheme process! A few commands
-;; not in cmuscheme. But. Integration is a bit of a hack. Input
-;; history only keeps the immediately prior input. Bizarre
+;; not in cmuscheme. But. Integration is a bit of a hack. Input
+;; history only keeps the immediately prior input. Bizarre
;; keybindings.
;;
;; cmuscheme: Not tightly integrated with inferior cscheme process. But.
;; Carefully integrated functionality with the entire suite of
-;; comint-derived CMU process modes. Keybindings reminiscent of
-;; Zwei and Hemlock. Good input history. A few commands not in
+;; comint-derived CMU process modes. Keybindings reminiscent of
+;; Zwei and Hemlock. Good input history. A few commands not in
;; xscheme.
;;
-;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
-;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
+;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
+;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
;; Cscheme-specific; you must use cmuscheme.el. Interested parties are
;; invited to port xscheme functionality on top of comint mode...
@@ -70,18 +67,18 @@
;; Created.
;;
;; 2/15/89 Olin
-;; Removed -emacs flag from process invocation. It's only useful for
+;; Removed -emacs flag from process invocation. It's only useful for
;; cscheme, and makes cscheme assume it's running under xscheme.el,
-;; which messes things up royally. A bug.
+;; which messes things up royally. A bug.
;;
;; 5/22/90 Olin
;; - Upgraded to use comint-send-string and comint-send-region.
;; - run-scheme now offers to let you edit the command line if
-;; you invoke it with a prefix-arg. M-x scheme is redundant, and
+;; you invoke it with a prefix-arg. M-x scheme is redundant, and
;; has been removed.
;; - Explicit references to process "scheme" have been replaced with
-;; (scheme-proc). This allows better handling of multiple process bufs.
-;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
+;; (scheme-proc). This allows better handling of multiple process bufs.
+;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
;; and friends, but interested hackers might find a useful application
;; of this facility.
@@ -95,42 +92,37 @@
(require 'scheme)
(require 'comint)
-
(defgroup cmuscheme nil
"Run a scheme process in a buffer."
:group 'scheme)
-;;; INFERIOR SCHEME MODE STUFF
-;;;============================================================================
-
(defcustom inferior-scheme-mode-hook nil
"Hook for customizing inferior-scheme mode."
- :type 'hook
- :group 'cmuscheme)
+ :type 'hook)
(defvar inferior-scheme-mode-map
(let ((m (make-sparse-keymap)))
- (define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention
- (define-key m "\C-x\C-e" 'scheme-send-last-sexp)
- (define-key m "\C-c\C-l" 'scheme-load-file)
- (define-key m "\C-c\C-k" 'scheme-compile-file)
+ (define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention
+ (define-key m "\C-x\C-e" #'scheme-send-last-sexp)
+ (define-key m "\C-c\C-l" #'scheme-load-file)
+ (define-key m "\C-c\C-k" #'scheme-compile-file)
(scheme-mode-commands m)
m))
;; Install the process communication commands in the scheme-mode keymap.
-(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention
-(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention
-(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition)
-(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go)
-(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region)
-(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
-(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
-(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
-(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure)
-(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form)
-(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
-(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
-(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
+(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention
+(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention
+(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition)
+(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region)
+(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go)
+(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition)
+(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure)
+(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form)
+(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme)
+(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file)
+(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile"
(let ((map (lookup-key scheme-mode-map [menu-bar scheme])))
(define-key map [separator-eval] '("--"))
@@ -157,8 +149,7 @@
(define-key map [send-region]
'("Evaluate Region" . scheme-send-region))
(define-key map [send-sexp]
- '("Evaluate Last S-expression" . scheme-send-last-sexp))
- )
+ '("Evaluate Last S-expression" . scheme-send-last-sexp)))
(defvar scheme-buffer)
@@ -209,8 +200,7 @@ to continue it."
(defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
"Input matching this regexp are not saved on the history list.
Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
- :type 'regexp
- :group 'cmuscheme)
+ :type 'regexp)
(defun scheme-input-filter (str)
"Don't save anything matching `inferior-scheme-filter-regexp'."
@@ -242,7 +232,7 @@ is run).
scheme-program-name)))
(if (not (comint-check-proc "*scheme*"))
(let ((cmdlist (split-string-and-unquote cmd)))
- (set-buffer (apply 'make-comint "scheme" (car cmdlist)
+ (set-buffer (apply #'make-comint "scheme" (car cmdlist)
(scheme-start-file (car cmdlist)) (cdr cmdlist)))
(inferior-scheme-mode)))
(setq scheme-program-name cmd)
@@ -282,8 +272,7 @@ in this order. Return nil if no start file found."
(defcustom scheme-compile-exp-command "(compile '%s)"
"Template for issuing commands to compile arbitrary Scheme expressions."
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defun scheme-compile-region (start end)
"Compile the current region in the inferior Scheme process.
@@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use
(setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace
%s))\")
For Scheme 48 and Scsh use \",trace %s\"."
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defcustom scheme-untrace-command "(untrace %s)"
"Template for switching off tracing of a Scheme procedure.
Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
-
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defun scheme-trace-procedure (proc &optional untrace)
"Trace procedure PROC in the inferior Scheme process.
@@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure
PROC."
(defcustom scheme-macro-expand-command "(expand %s)"
"Template for macro-expanding a Scheme form.
For Scheme 48 and Scsh use \",expand %s\"."
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defun scheme-expand-current-form ()
"Macro-expand the form at point in the inferior Scheme process."
@@ -410,8 +395,7 @@ Then switch to the process buffer."
If it's loaded into a buffer that is in one of these major modes, it's
considered a scheme source file by `scheme-load-file' and
`scheme-compile-file'.
Used by these commands to determine defaults."
- :type '(repeat function)
- :group 'cmuscheme)
+ :type '(repeat function))
(defvar scheme-prev-l/c-dir/file nil
"Caches the last (directory . file) pair.
@@ -514,8 +498,7 @@ command to run."
(defcustom cmuscheme-load-hook nil
"This hook is run when cmuscheme is loaded in.
This is a good place to put keybindings."
- :type 'hook
- :group 'cmuscheme)
+ :type 'hook)
(make-obsolete-variable 'cmuscheme-load-hook
"use `with-eval-after-load' instead." "28.1")
diff --git a/lisp/comint.el b/lisp/comint.el
index b04d404..ef34174 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1627,7 +1627,6 @@ or to the last history element for a backward search."
(if isearch-forward
(comint-goto-input (1- (ring-length comint-input-ring)))
(comint-goto-input nil))
- (setq isearch-success t)
(goto-char (if isearch-forward (comint-line-beginning-position)
(point-max))))
(defun comint-history-isearch-push-state ()
@@ -1798,6 +1797,10 @@ Ignore duplicates if `comint-input-ignoredups' is
non-nil."
(min size (- comint-input-ring-size size)))))
(ring-insert comint-input-ring cmd)))
+(defconst comint--prompt-rear-nonsticky
+ '(field inhibit-line-move-field-capture read-only font-lock-face)
+ "Text properties we set on the prompt and don't want to leak past it.")
+
(defun comint-send-input (&optional no-newline artificial)
"Send input to process.
After the process output mark, sends all text from the process mark to
@@ -1917,7 +1920,8 @@ Similarly for Soar, Scheme, etc."
(unless (or no-newline comint-use-prompt-regexp)
;; Cover the terminating newline
(add-text-properties end (1+ end)
- '(rear-nonsticky t
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky
field boundary
inhibit-line-move-field-capture t)))))
@@ -2124,9 +2128,10 @@ Make backspaces delete the previous character."
(unless comint-use-prompt-regexp
(with-silent-modifications
(add-text-properties comint-last-output-start (point)
- '(front-sticky
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky
+ front-sticky
(field inhibit-line-move-field-capture)
- rear-nonsticky t
field output
inhibit-line-move-field-capture t))))
@@ -2155,7 +2160,9 @@ Make backspaces delete the previous character."
(font-lock-prepend-text-property prompt-start (point)
'font-lock-face
'comint-highlight-prompt)
- (add-text-properties prompt-start (point) '(rear-nonsticky t)))
+ (add-text-properties prompt-start (point)
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky)))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
@@ -2251,23 +2258,23 @@ This function could be on
`comint-output-filter-functions' or bound to a key."
(let ((inhibit-read-only t))
(delete-region (point-min) (point)))))
-(defun comint-strip-ctrl-m (&optional _string)
+(defun comint-strip-ctrl-m (&optional _string interactive)
"Strip trailing `^M' characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
- (interactive)
+ (interactive (list nil t))
(let ((process (get-buffer-process (current-buffer))))
(if (not process)
;; This function may be used in
;; `comint-output-filter-functions', and in that case, if
;; there's no process, then we should do nothing. If
;; interactive, report an error.
- (when (called-interactively-p 'interactive)
+ (when interactive
(error "No process in the current buffer"))
(let ((pmark (process-mark process)))
(save-excursion
(condition-case nil
(goto-char
- (if (called-interactively-p 'interactive)
+ (if interactive
comint-last-input-end comint-last-output-start))
(error nil))
(while (re-search-forward "\r+$" pmark t)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index f0b108b..c14a45c 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -1,4 +1,4 @@
-;;; cus-dep.el --- find customization dependencies
+;;; cus-dep.el --- find customization dependencies -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;;
@@ -131,7 +131,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
- (eval expr))
+ (eval expr t))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
;; in the file (we haven't loaded the file).
@@ -163,7 +163,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(let ((members (get symbol 'custom-group))
where found)
(when members
- (dolist (member (mapcar 'car members))
+ (dolist (member (mapcar #'car members))
(setq where (get member 'custom-where))
(unless (or (null where)
(member where found))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 745f6bc..0103d5c 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -5159,8 +5159,6 @@ if that value is non-nil."
(put 'Custom-mode 'mode-class 'special)
-;;; The End.
-
(provide 'cus-edit)
;;; cus-edit.el ends here
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 21fe89c..6c0052b 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -395,8 +395,6 @@ This means reset FACE to its value in FROM-THEME."
(define-obsolete-function-alias 'custom-facep #'facep "28.1")
-;;; The End.
-
(provide 'cus-face)
;;; cus-face.el ends here
diff --git a/lisp/custom.el b/lisp/custom.el
index 85e5d65..2c9eadb 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1623,8 +1623,6 @@ If a choice with the same tag already exists, no action
is taken."
(put variable 'custom-type
(append choices (list choice))))))
-;;; The End.
-
(provide 'custom)
;;; custom.el ends here
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index d5f4910..8fe612f 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."
When on, Isearch skips matches outside file names using the predicate
`dired-isearch-filter-filenames' that matches only at file names.
When off, it uses the original predicate."
- nil nil nil
+ :lighter nil
(if dired-isearch-filenames-mode
(add-function :before-while (local 'isearch-filter-predicate)
#'dired-isearch-filter-filenames
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 7f76ef6..be8db75 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -184,7 +184,7 @@ working directory at all times, and that you set the
variable
This is an alternative to `shell-dirtrack-mode', which works by
tracking `cd' and similar commands which change the shell working
directory."
- nil nil nil
+ :lighter nil
(if dirtrack-mode
(add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
@@ -192,7 +192,7 @@ directory."
(define-minor-mode dirtrack-debug-mode
"Toggle Dirtrack debugging."
- nil nil nil
+ :lighter nil
(if dirtrack-debug-mode
(display-buffer (get-buffer-create dirtrack-debug-buffer))))
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 39d2a1d..6b037aa 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -24,8 +24,8 @@
;;; Commentary:
-;; This file provides the lisp part of the GConf and XSetting code in
-;; xsetting.c. But it is nothing that prevents it from being used by
+;; This file provides the Lisp part of the GConf and XSetting code in
+;; xsetting.c. But there is nothing that prevents it from being used by
;; other configuration schemes.
;;; Code:
@@ -92,3 +92,6 @@ Changes can be
(define-key special-event-map [config-changed-event]
#'dynamic-setting-handle-config-changed-event)
+
+(provide 'dynamic-setting)
+;;; dynamic-setting.el ends here
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 3d7db44..84de69a 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,4 +1,4 @@
-;;; edmacro.el --- keyboard macro editor
+;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal
notation."
(defvar edmacro-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'edmacro-finish-edit)
- (define-key map "\C-c\C-q" 'edmacro-insert-key)
+ (define-key map "\C-c\C-c" #'edmacro-finish-edit)
+ (define-key map "\C-c\C-q" #'edmacro-insert-key)
map))
(defvar edmacro-store-hook)
@@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise
way."
(set-buffer-modified-p nil))
(run-hooks 'edmacro-format-hook)))))
-;;; The next two commands are provided for convenience and backward
-;;; compatibility.
+;; The next two commands are provided for convenience and backward
+;; compatibility.
;;;###autoload
(defun edit-last-kbd-macro (&optional prefix)
@@ -237,8 +237,7 @@ or nil, use a compact 80-column format."
((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
(when edmacro-store-hook
(error "\"Command\" line not allowed in this context"))
- (let ((str (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (let ((str (match-string 1)))
(unless (equal str "")
(setq cmd (and (not (equal str "none"))
(intern str)))
@@ -253,8 +252,7 @@ or nil, use a compact 80-column format."
(when edmacro-store-hook
(error "\"Key\" line not allowed in this context"))
(let ((key (edmacro-parse-keys
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
+ (match-string 1))))
(unless (equal key "")
(if (equal key "none")
(setq no-keys t)
@@ -274,16 +272,14 @@ or nil, use a compact 80-column format."
((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
(when edmacro-store-hook
(error "\"Counter\" line not allowed in this context"))
- (let ((str (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (let ((str (match-string 1)))
(unless (equal str "")
(setq mac-counter (string-to-number str))))
t)
((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$")
(when edmacro-store-hook
(error "\"Format\" line not allowed in this context"))
- (let ((str (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (let ((str (match-string 1)))
(unless (equal str "")
(setq mac-format str)))
t)
@@ -475,7 +471,7 @@ doubt, use whitespace."
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) "
")
(cl-callf cl-subseq rest-mac i)))))))
- (bind-len (apply 'max 1
+ (bind-len (apply #'max 1
(cl-loop for map in maps
for b = (lookup-key map rest-mac)
when b collect b)))
@@ -506,7 +502,7 @@ doubt, use whitespace."
finally return i))
desc)
(if (stringp bind) (setq bind nil))
- (cond ((and (eq bind 'self-insert-command) (not prefix)
+ (cond ((and (eq bind #'self-insert-command) (not prefix)
(> text 1) (integerp first)
(> first 32) (<= first maxkey) (/= first 92)
(progn
@@ -520,11 +516,11 @@ doubt, use whitespace."
desc))))
(when (or (string-match "^\\^.$" desc)
(member desc res-words))
- (setq desc (mapconcat 'char-to-string desc " ")))
+ (setq desc (mapconcat #'char-to-string desc " ")))
(when verbose
(setq bind (format "%s * %d" bind text)))
(setq bind-len text))
- ((and (eq bind 'execute-extended-command)
+ ((and (eq bind #'execute-extended-command)
(> text bind-len)
(memq (aref rest-mac text) '(return 13))
(progn
@@ -667,10 +663,8 @@ This function assumes that the events can be stored in a
string."
(substring word 2 -2) "\r")))
((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
(progn
- (setq word (concat (substring word (match-beginning 1)
- (match-end 1))
- (substring word (match-beginning 3)
- (match-end 3))))
+ (setq word (concat (match-string 1 word)
+ (match-string 3 word)))
(not (string-match
"\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
word))))
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 9899496..247fb91 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -167,7 +167,7 @@
(defun bindat--unpack-strz (len)
(let ((i 0) s)
- (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
+ (while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
(setq bindat-idx (+ bindat-idx len))
@@ -439,6 +439,12 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(aset bindat-raw (+ bindat-idx i) (aref v i)))
(setq bindat-idx (+ bindat-idx len)))
+(defun bindat--pack-strz (v)
+ (let ((len (length v)))
+ (dotimes (i len)
+ (aset bindat-raw (+ bindat-idx i) (aref v i)))
+ (setq bindat-idx (+ bindat-idx len 1))))
+
(defun bindat--pack-bits (len v)
(let ((bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
@@ -677,14 +683,23 @@ is the name of a variable that will hold the value we
need to pack.")
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
-(cl-defmethod bindat--type (op (_ (eql strz)) len)
+(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
- (`(length . ,_) `(cl-incf bindat-idx ,len))
- ;; Here we don't add the terminating zero because we rely
- ;; on the fact that `bindat-raw' was presumably initialized with
- ;; all-zeroes before we started.
- (`(pack . ,args) `(bindat--pack-str ,len . ,args))))
+ (`(length ,val)
+ `(cl-incf bindat-idx ,(cond
+ ((null len) `(length ,val))
+ ((numberp len) len)
+ (t `(or ,len (length ,val))))))
+ (`(pack . ,args)
+ (macroexp-let2 nil len len
+ `(if ,len
+ ;; Same as non-zero terminated strings since we don't actually add
+ ;; the terminating zero anyway (because we rely on the fact that
+ ;; `bindat-raw' was presumably initialized with all-zeroes before
+ ;; we started).
+ (bindat--pack-str ,len . ,args)
+ (bindat--pack-strz . ,args))))))
(cl-defmethod bindat--type (op (_ (eql bits)) len)
(bindat--pcase op
@@ -812,7 +827,7 @@ is the name of a variable that will hold the value we need
to pack.")
'(&or ["uint" def-form]
["uintr" def-form]
["str" def-form]
- ["strz" def-form]
+ ["strz" &optional def-form]
["bits" def-form]
["fill" def-form]
["align" def-form]
@@ -832,7 +847,7 @@ TYPE is a Bindat type expression. It can take the
following forms:
uint BITLEN - Big-endian unsigned integer
uintr BITLEN - Little-endian unsigned integer
str LEN - Byte string
- strz LEN - Zero-terminated byte-string
+ strz [LEN] - Zero-terminated byte-string
bits LEN - Bit vector (LEN is counted in bytes)
fill LEN - Just a filler
align LEN - Fill up to the next multiple of LEN bytes
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index db8d825..e526537 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.")
`(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
+ (let ((byte-optimize--lexvars
+ (and lexical-binding
+ (if var
+ (cons (list var t)
+ byte-optimize--lexvars)
+ byte-optimize--lexvars))))
+ (cons (car clause)
+ (byte-optimize-body (cdr clause) for-effect))))
clauses))))
(`(unwind-protect ,exp . ,exps)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0babbbb..4f91f0d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4621,10 +4621,15 @@ binding slots have been popped."
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
+ (handlers (nthcdr 3 form))
(depth byte-compile-depth)
+ (success-handler (assq :success handlers))
+ (failure-handlers (if success-handler
+ (remq success-handler handlers)
+ handlers))
(clauses (mapcar (lambda (clause)
(cons (byte-compile-make-tag) clause))
- (nthcdr 3 form)))
+ failure-handlers))
(endtag (byte-compile-make-tag)))
(byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
@@ -4650,30 +4655,40 @@ binding slots have been popped."
(byte-compile-form body) ;; byte-compile--for-effect
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
- (byte-compile-goto 'byte-goto endtag)
- (while clauses
- (let ((clause (pop clauses))
- (byte-compile-bound-variables byte-compile-bound-variables)
- (byte-compile--lexical-environment
- byte-compile--lexical-environment))
- (setq byte-compile-depth (1+ depth))
- (byte-compile-out-tag (pop clause))
- (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
- (cond
- ((null var) (byte-compile-discard))
- (lexical-binding
- (push (cons var (1- byte-compile-depth))
- byte-compile--lexical-environment))
- (t (byte-compile-dynamic-variable-bind var)))
- (byte-compile-body (cdr clause)) ;; byte-compile--for-effect
- (cond
- ((null var) nil)
- (lexical-binding (byte-compile-discard 1 'preserve-tos))
- (t (byte-compile-out 'byte-unbind 1)))
- (byte-compile-goto 'byte-goto endtag)))
-
- (byte-compile-out-tag endtag)))
+ (let ((compile-handler-body
+ (lambda (body)
+ (let ((byte-compile-bound-variables byte-compile-bound-variables)
+ (byte-compile--lexical-environment
+ byte-compile--lexical-environment))
+ (cond
+ ((null var) (byte-compile-discard))
+ (lexical-binding
+ (push (cons var (1- byte-compile-depth))
+ byte-compile--lexical-environment))
+ (t (byte-compile-dynamic-variable-bind var)))
+
+ (byte-compile-body body) ;; byte-compile--for-effect
+
+ (cond
+ ((null var))
+ (lexical-binding (byte-compile-discard 1 'preserve-tos))
+ (t (byte-compile-out 'byte-unbind 1)))))))
+
+ (when success-handler
+ (funcall compile-handler-body (cdr success-handler)))
+
+ (byte-compile-goto 'byte-goto endtag)
+
+ (while clauses
+ (let ((clause (pop clauses)))
+ (setq byte-compile-depth (1+ depth))
+ (byte-compile-out-tag (pop clause))
+ (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+ (funcall compile-handler-body (cdr clause))
+ (byte-compile-goto 'byte-goto endtag)))
+
+ (byte-compile-out-tag endtag))))
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index afaa13a..f663710 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,4 +1,4 @@
-;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*-
lexical-binding: t -*-
+;;; cconv.el --- Closure conversion for statically scoped Emacs Lisp. -*-
lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -498,7 +498,7 @@ places where they originally did not directly appear."
(let* ((class (and var (cconv--var-classification (list var) form)))
(newenv
(cond ((eq class :captured+mutated)
- (cons `(,var . (car-save ,var)) env))
+ (cons `(,var . (car-safe ,var)) env))
((assq var env) (cons `(,var) env))
(t env)))
(msg (when (eq class :unused)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 96b16f7..00cc777 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
checking of documentation strings.
\\{checkdoc-minor-mode-map}"
- nil checkdoc-minor-mode-string nil
+ :lighter checkdoc-minor-mode-string
:group 'checkdoc)
;;; Subst utils
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 7d0bfc8..c88e15d 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -27,7 +27,7 @@
;; This package supplies a single entry point, common-lisp-indent-function,
;; which performs indentation in the preferred style for Common Lisp code.
-;; It is also a suitable function for indenting Emacs lisp code.
+;; It is also a suitable function for indenting Emacs Lisp code.
;;
;; To enable it:
;;
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 27ed07b..b7e5be9 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2141,6 +2141,15 @@ Like `cl-flet' but the definitions can refer to previous
ones.
;; tail-called any more.
(not (memq var shadowings)))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
+ ((and `(condition-case ,err-var ,bodyform . ,handlers)
+ (guard (not (eq err-var var))))
+ `(condition-case ,err-var
+ ,(if (assq :success handlers)
+ bodyform
+ `(progn (setq ,retvar ,bodyform) nil))
+ . ,(mapcar (lambda (h)
+ (cons (car h) (funcall opt-exps (cdr h))))
+ handlers)))
('nil nil) ;No need to set `retvar' to return nil.
(_ `(progn (setq ,retvar ,exp) nil))))))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index b2d54c7..069c7a9 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -213,7 +213,7 @@ the debugger will not be entered."
last-input-event last-command-event last-nonmenu-event
last-event-frame
overriding-local-map
- load-read-function
+ (load-read-function #'read)
;; If we are inside a minibuffer, allow nesting
;; so that we don't get an error from the `e' command.
(enable-recursive-minibuffers
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index addb58c..2dd1524 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -116,7 +116,7 @@ it is disabled.")
doc nil nil 1)))))
;;;###autoload
-(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
+(defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap
&rest body)
"Define a new minor mode MODE.
@@ -139,39 +139,31 @@ documenting what its argument does. If the word \"ARG\"
does not
appear in DOC, a paragraph is added to DOC explaining
usage of the mode argument.
-Optional INIT-VALUE is the initial value of the mode's variable.
- Note that the minor mode function won't be called by setting
- this option, so the value *reflects* the minor mode's natural
- initial state, rather than *setting* it.
- In the vast majority of cases it should be nil.
-Optional LIGHTER is displayed in the mode line when the mode is on.
-Optional KEYMAP is the default keymap bound to the mode keymap.
- If non-nil, it should be a variable name (whose value is a keymap),
- or an expression that returns either a keymap or a list of
- (KEY . BINDING) pairs where KEY and BINDING are suitable for
- `define-key'. If you supply a KEYMAP argument that is not a
- symbol, this macro defines the variable MODE-map and gives it
- the value that KEYMAP specifies.
-
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
alternating keywords and values. If you provide BODY, then you must
- provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
- at least one keyword argument, or both; otherwise, BODY would be
- misinterpreted as the first omitted argument. The following special
- keywords are supported (other keywords are passed to `defcustom' if
- the minor mode is global):
+ provide at least one keyword argument (e.g. `:lighter nil`).
+ The following special keywords are supported (other keywords are passed
+ to `defcustom' if the minor mode is global):
-:group GROUP Custom group name to use in all generated `defcustom' forms.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
-:init-value VAL Same as the INIT-VALUE argument.
+:init-value VAL the initial value of the mode's variable.
+ Note that the minor mode function won't be called by setting
+ this option, so the value *reflects* the minor mode's natural
+ initial state, rather than *setting* it.
+ In the vast majority of cases it should be nil.
Not used if you also specify :variable.
-:lighter SPEC Same as the LIGHTER argument.
-:keymap MAP Same as the KEYMAP argument.
-:require SYM Same as in `defcustom'.
+:lighter SPEC Text displayed in the mode line when the mode is on.
+:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'.
+ If non-nil, it should be a variable name (whose value is
+ a keymap), or an expression that returns either a keymap or
+ a list of (KEY . BINDING) pairs where KEY and BINDING are
+ suitable for `define-key'. If you supply a KEYMAP argument
+ that is not a symbol, this macro defines the variable MODE-map
+ and gives it the value that KEYMAP specifies.
:interactive VAL Whether this mode should be a command or not. The default
is to make it one; use nil to avoid that. If VAL is a list,
it's interpreted as a list of major modes this minor mode
@@ -185,14 +177,19 @@ BODY contains code to execute each time the mode is
enabled or disabled.
sets it. If you specify a :variable, this function does
not define a MODE variable (nor any of the terms used
in :variable).
-
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
:lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version
\"27.5\"
- ...BODY CODE...)"
+ ...BODY CODE...)
+
+For backward compatibility with the Emacs<21 calling convention,
+the keywords can also be preceded by the obsolete triplet
+INIT-VALUE LIGHTER KEYMAP.
+
+\(fn MODE DOC [KEYWORD VAL ... &rest BODY])"
(declare (doc-string 2)
(debug (&define name string-or-null-p
[&optional [¬ keywordp] sexp
@@ -201,23 +198,12 @@ For example, you could write
[&rest [keywordp sexp]]
def-body)))
- ;; Allow skipping the first three args.
- (cond
- ((keywordp init-value)
- (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
- `(,init-value ,lighter))
- init-value nil lighter nil keymap nil))
- ((keywordp lighter)
- (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
- ((keywordp keymap) (push keymap body) (setq keymap nil)))
-
(let* ((last-message (make-symbol "last-message"))
(mode-name (symbol-name mode))
- (pretty-name (easy-mmode-pretty-mode-name mode lighter))
+ (pretty-name nil)
(globalp nil)
(set nil)
(initialize nil)
- (group nil)
(type nil)
(extra-args nil)
(extra-keywords nil)
@@ -225,14 +211,28 @@ For example, you could write
(setter `(setq ,mode)) ;The beginning of the exp to set the mode var.
(getter mode) ;The exp to get the mode value.
(modefun mode) ;The minor mode function name we're defining.
- (require t)
(after-hook nil)
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(hook-off (intern (concat mode-name "-off-hook")))
(interactive t)
+ (warnwrap (if (keywordp init-value) #'identity
+ (lambda (exp)
+ (macroexp-warn-and-return
+ "Use keywords rather than deprecated positional
arguments to `define-minor-mode'"
+ exp))))
keyw keymap-sym tmp)
+ ;; Allow skipping the first three args.
+ (cond
+ ((keywordp init-value)
+ (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
+ `(,init-value ,lighter))
+ init-value nil lighter nil keymap nil))
+ ((keywordp lighter)
+ (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
+ ((keywordp keymap) (push keymap body) (setq keymap nil)))
+
;; Check keys.
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
@@ -246,9 +246,7 @@ For example, you could write
(:extra-args (setq extra-args (pop body)))
(:set (setq set (list :set (pop body))))
(:initialize (setq initialize (list :initialize (pop body))))
- (:group (setq group (nconc group (list :group (pop body)))))
(:type (setq type (list :type (pop body))))
- (:require (setq require (pop body)))
(:keymap (setq keymap (pop body)))
(:interactive (setq interactive (pop body)))
(:variable (setq variable (pop body))
@@ -264,13 +262,14 @@ For example, you could write
(:after-hook (setq after-hook (pop body)))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
+ (setq pretty-name (easy-mmode-pretty-mode-name mode lighter))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
(unless set (setq set '(:set #'custom-set-minor-mode)))
(unless initialize
- (setq initialize '(:initialize 'custom-initialize-default)))
+ (setq initialize '(:initialize #'custom-initialize-default)))
;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
(unless type (setq type '(:type 'boolean)))
@@ -301,70 +300,72 @@ or call the function `%s'."))))
,(format base-doc-string pretty-name mode mode)
,@set
,@initialize
- ,@group
,@type
- ,@(unless (eq require t) `(:require ,require))
,@(nreverse extra-keywords)))))
;; The actual function.
- (defun ,modefun (&optional arg ,@extra-args)
- ,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
- ,(when interactive
- ;; Use `toggle' rather than (if ,mode 0 1) so that using
- ;; repeat-command still does the toggling correctly.
- (if (consp interactive)
- `(interactive
- (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- 'toggle))
- ,@interactive)
- '(interactive (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- 'toggle)))))
- (let ((,last-message (current-message)))
- (,@setter
- (cond ((eq arg 'toggle)
- (not ,getter))
- ((and (numberp arg)
- (< arg 1))
- nil)
- (t
- t)))
- ;; Keep minor modes list up to date.
- ,@(if globalp
- ;; When running this byte-compiled code in earlier
- ;; Emacs versions, these variables may not be defined
- ;; there. So check defensively, even if they're
- ;; always defined in Emacs 28 and up.
- `((when (boundp 'global-minor-modes)
- (setq global-minor-modes
- (delq ',modefun global-minor-modes))
- (when ,getter
- (push ',modefun global-minor-modes))))
- ;; Ditto check.
- `((when (boundp 'local-minor-modes)
- (setq local-minor-modes (delq ',modefun local-minor-modes))
- (when ,getter
- (push ',modefun local-minor-modes)))))
- ,@body
- ;; The on/off hooks are here for backward compatibility only.
- (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
- (if (called-interactively-p 'any)
- (progn
- ,(if (and globalp (not variable))
- `(customize-mark-as-set ',mode))
- ;; Avoid overwriting a message shown by the body,
- ;; but do overwrite previous messages.
- (unless (and (current-message)
- (not (equal ,last-message
- (current-message))))
- (let ((local ,(if globalp "" " in current buffer")))
- (message ,(format "%s %%sabled%%s" pretty-name)
- (if ,getter "en" "dis") local)))))
- ,@(when after-hook `(,after-hook)))
- (force-mode-line-update)
- ;; Return the new setting.
- ,getter)
+ ,(funcall
+ warnwrap
+ `(defun ,modefun (&optional arg ,@extra-args)
+ ,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
+ ,(when interactive
+ ;; Use `toggle' rather than (if ,mode 0 1) so that using
+ ;; repeat-command still does the toggling correctly.
+ (if (consp interactive)
+ `(interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle))
+ ,@interactive)
+ '(interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle)))))
+ (let ((,last-message (current-message)))
+ (,@setter
+ (cond ((eq arg 'toggle)
+ (not ,getter))
+ ((and (numberp arg)
+ (< arg 1))
+ nil)
+ (t
+ t)))
+ ;; Keep minor modes list up to date.
+ ,@(if globalp
+ ;; When running this byte-compiled code in earlier
+ ;; Emacs versions, these variables may not be defined
+ ;; there. So check defensively, even if they're
+ ;; always defined in Emacs 28 and up.
+ `((when (boundp 'global-minor-modes)
+ (setq global-minor-modes
+ (delq ',modefun global-minor-modes))
+ (when ,getter
+ (push ',modefun global-minor-modes))))
+ ;; Ditto check.
+ `((when (boundp 'local-minor-modes)
+ (setq local-minor-modes
+ (delq ',modefun local-minor-modes))
+ (when ,getter
+ (push ',modefun local-minor-modes)))))
+ ,@body
+ ;; The on/off hooks are here for backward compatibility only.
+ (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
+ (if (called-interactively-p 'any)
+ (progn
+ ,(if (and globalp (not variable))
+ `(customize-mark-as-set ',mode))
+ ;; Avoid overwriting a message shown by the body,
+ ;; but do overwrite previous messages.
+ (unless (and (current-message)
+ (not (equal ,last-message
+ (current-message))))
+ (let ((local ,(if globalp "" " in current buffer")))
+ (message ,(format "%s %%sabled%%s" pretty-name)
+ (if ,getter "en" "dis") local)))))
+ ,@(when after-hook `(,after-hook)))
+ (force-mode-line-update)
+ ;; Return the new setting.
+ ,getter))
;; Autoloading a define-minor-mode autoloads everything
;; up-to-here.
@@ -406,9 +407,9 @@ No problems result if this variable is not bound.
;;;
;;;###autoload
-(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
+(defalias 'easy-mmode-define-global-mode #'define-globalized-minor-mode)
;;;###autoload
-(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
+(defalias 'define-global-minor-mode #'define-globalized-minor-mode)
;;;###autoload
(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
@@ -510,12 +511,12 @@ disable it. If called from Lisp, enable the mode if ARG
is omitted or nil.\n\n"
(if ,global-mode
(progn
(add-hook 'after-change-major-mode-hook
- ',MODE-enable-in-buffers)
- (add-hook 'find-file-hook ',MODE-check-buffers)
- (add-hook 'change-major-mode-hook ',MODE-cmhh))
- (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
- (remove-hook 'find-file-hook ',MODE-check-buffers)
- (remove-hook 'change-major-mode-hook ',MODE-cmhh))
+ #',MODE-enable-in-buffers)
+ (add-hook 'find-file-hook #',MODE-check-buffers)
+ (add-hook 'change-major-mode-hook #',MODE-cmhh))
+ (remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffers)
+ (remove-hook 'find-file-hook #',MODE-check-buffers)
+ (remove-hook 'change-major-mode-hook #',MODE-cmhh))
;; Go through existing buffers.
(dolist (buf (buffer-list))
@@ -555,7 +556,7 @@ list."
;; A function which checks whether MODE has been disabled in the major
;; mode hook which has just been run.
- (add-hook ',minor-MODE-hook ',MODE-set-explicitly)
+ (add-hook ',minor-MODE-hook #',MODE-set-explicitly)
;; List of buffers left to process.
(defvar ,MODE-buffers nil)
@@ -582,13 +583,13 @@ list."
(defun ,MODE-check-buffers ()
(,MODE-enable-in-buffers)
- (remove-hook 'post-command-hook ',MODE-check-buffers))
+ (remove-hook 'post-command-hook #',MODE-check-buffers))
(put ',MODE-check-buffers 'definition-name ',global-mode)
;; The function that catches kill-all-local-variables.
(defun ,MODE-cmhh ()
(add-to-list ',MODE-buffers (current-buffer))
- (add-hook 'post-command-hook ',MODE-check-buffers))
+ (add-hook 'post-command-hook #',MODE-check-buffers))
(put ',MODE-cmhh 'definition-name ',global-mode))))
(defun easy-mmode--globalized-predicate-p (predicate)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 87b34e7..f666154 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
`menu-bar-update-hook' or use a menu filter."
(easy-menu-add-item map path (easy-menu-create-menu name items) before))
-(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1"
+(defalias 'easy-menu-remove #'ignore
"Remove MENU from the current menu bar.
Contrary to XEmacs, this is a nop on Emacs since menus are automatically
\(de)activated when the corresponding keymap is (de)activated.
\(fn MENU)")
+(make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \
+and can be safely removed." "28.1")
-(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1"
+(defalias 'easy-menu-add #'ignore
"Add the menu to the menubar.
On Emacs this is a nop, because menus are already automatically
activated when the corresponding keymap is activated. On XEmacs
@@ -511,6 +513,8 @@ You should call this once the menu and keybindings are set
up
completely and menu filter functions can be expected to work.
\(fn MENU &optional MAP)")
+(make-obsolete 'easy-menu-add "this was always a no-op in Emacs \
+and can be safely removed." "28.1")
(defun add-submenu (menu-path submenu &optional before in-menu)
"Add submenu SUBMENU in the menu at MENU-PATH.
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index f1455ff..b08ee3c 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -459,6 +459,9 @@ invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
just FUNCTION is printed."
+ ;; Re-install our advice, in case `debug' re-bound `load-read-function' to
+ ;; its default value.
+ (add-function :around load-read-function #'edebug--read)
(let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs))))
(edebug-all-defs edebug-all-forms))
(funcall orig-fun nil)))
@@ -1942,14 +1945,16 @@ a sequence of elements."
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
;; of the current list. e.g. ("lambda" &define args def-body)
- (edebug-make-form-wrapper
- cursor
- (edebug-before-offset cursor)
- ;; Find the last offset in the list.
- (let ((offsets (edebug-cursor-offsets cursor)))
- (while (consp offsets) (setq offsets (cdr offsets)))
- offsets)
- specs))
+ (prog1 (edebug-make-form-wrapper
+ cursor
+ (edebug-before-offset cursor)
+ ;; Find the last offset in the list.
+ (let ((offsets (edebug-cursor-offsets cursor)))
+ (while (consp offsets) (setq offsets (cdr offsets)))
+ offsets)
+ specs)
+ ;; Stop backtracking here (Bug#41988).
+ (setq edebug-gate t)))
(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
@@ -4114,12 +4119,12 @@ This should be a list of `edebug---frame' objects.")
"Stack frames of the current Edebug Backtrace buffer with instrumentation.
This should be a list of `edebug---frame' objects.")
-;; Data structure for backtrace frames with information
-;; from Edebug instrumentation found in the backtrace.
(cl-defstruct
(edebug--frame
(:constructor edebug--make-frame)
(:include backtrace-frame))
+ "Data structure for backtrace frames with information
+from Edebug instrumentation found in the backtrace."
def-name before-index after-index)
(defun edebug-pop-to-backtrace ()
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index ec1077d..641882c 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,7 +1,6 @@
;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software
-;;; Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index e7727fd..2923dff 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -169,7 +169,7 @@ Return nil if that option doesn't exist."
(and (recordp obj)
(eieio--class-p (eieio--object-class obj))))
-(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
+(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
(defun class-abstract-p (class)
"Return non-nil if CLASS is abstract.
@@ -242,9 +242,9 @@ use \\='%s or turn off `eieio-backward-compatibility'
instead" cname)
(cl-deftype list-of (elem-type)
`(and list
- (satisfies (lambda (list)
- (cl-every (lambda (elem) (cl-typep elem ',elem-type))
- list)))))
+ (satisfies ,(lambda (list)
+ (cl-every (lambda (elem) (cl-typep elem elem-type))
+ list)))))
(defun eieio-make-class-predicate (class)
@@ -787,7 +787,7 @@ Fills in OBJ's SLOT with its default value."
(cond
;; Is it a function call? If so, evaluate it.
((eieio-eval-default-p val)
- (eval val))
+ (eval val t))
;;;; check for quoted things, and unquote them
;;((and (consp val) (eq (car val) 'quote))
;; (car (cdr val)))
@@ -1029,7 +1029,7 @@ method invocation orders of the involved classes."
(eieio--class-precedence-c3 class))))))
(define-obsolete-function-alias
- 'class-precedence-list 'eieio--class-precedence-list "24.4")
+ 'class-precedence-list #'eieio--class-precedence-list "24.4")
;;; Here are some special types of errors
diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
index 6c3931f..162c396 100644
--- a/lisp/emacs-lisp/faceup.el
+++ b/lisp/emacs-lisp/faceup.el
@@ -1170,11 +1170,6 @@ Intended to be called when a file is loaded."
;; File is being evaluated using, for example, `eval-buffer'.
default-directory)))
-
-;; ----------------------------------------------------------------------
-;; The end
-;;
-
(provide 'faceup)
;;; faceup.el ends here
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 4256bd5..0e86b92 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -31,6 +31,7 @@
(with-suppressed-warnings ((lexical pi))
(defconst pi float-pi
"Obsolete since Emacs-23.3. Use `float-pi' instead."))
+(make-obsolete-variable 'pi 'float-pi "23.3")
(internal-make-var-non-special 'pi)
(defconst float-e (exp 1) "The value of e (2.7182818...).")
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 6d9c8c3..73a33a5 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -109,11 +109,6 @@
;; * Footer line --- marks end-of-file so it can be distinguished from
;; an expanded formfeed or the results of truncation.
-;;; Change Log:
-
-;; Tue Jul 14 23:44:17 1992 ESR
-;; * Created.
-
;;; Code:
;;; Variables:
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 59ada5e..df86446 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'."
;; Record which arguments expect functions, so we can warn when those
;; are accidentally quoted with ' rather than with #'
-(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash))
+(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash
+ map-char-table map-keymap map-keymap-internal))
(put f 'funarg-positions '(1)))
(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
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 ecbca28..f4f0313 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -182,7 +182,7 @@ by counted more than once."
(cl-defmethod memory-report--object-size-1 (_ (value symbol))
;; Don't count global symbols -- makes sizes of lists of symbols too
- ;; heavey.
+ ;; heavy.
(if (intern-soft value obarray)
0
(memory-report--size 'symbol)))
@@ -214,14 +214,14 @@ by counted more than once."
(setf (gethash value counted) t)
(when (car value)
(cl-incf total (memory-report--object-size counted (car value))))
- (if (cdr value)
- (if (consp (cdr value))
- (if (gethash (cdr value) counted)
- (setq value nil)
- (setq value (cdr value)))
- (cl-incf total (memory-report--object-size counted (cdr value)))
- (setq value nil))
- (setq value nil)))
+ (let ((next (cdr value)))
+ (setq value (when next
+ (if (consp next)
+ (unless (gethash next counted)
+ (cdr value))
+ (cl-incf total (memory-report--object-size
+ counted next))
+ nil)))))
total))
(cl-defmethod memory-report--object-size-1 (counted (value vector))
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 9689465..ea27bb3 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -248,8 +248,6 @@ If SEQ is already a ring, return it."
(ring-insert-at-beginning ring (elt seq count))))
ring)))
-;;; provide ourself:
-
(provide 'ring)
;;; ring.el ends here
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 9944330..ab3cb3c 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -57,7 +57,7 @@
;;
;; SMIE: Weakness is Power! Auto-indentation with incomplete information
;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
-;; doi: 10.22152/programming-journal.org/2020/5/1
+;; doi: 10.22152/programming-journal.org/2021/5/1
;; A good background to understand the development (especially the parts
;; building the 2D precedence tables and then computing the precedence levels
@@ -68,7 +68,7 @@
;; OTOH we had to kill many chickens, read many coffee grounds, and practice
;; untold numbers of black magic spells, to come up with the indentation code.
;; Since then, some of that code has been beaten into submission, but the
-;; smie-indent-keyword is still pretty obscure.
+;; `smie-indent-keyword' function is still pretty obscure.
;; Conflict resolution:
@@ -247,7 +247,7 @@ be either:
;; (exp (exp (or "+" "*" "=" ..) exp)).
;; Basically, make it EBNF (except for the specification of a separator in
;; the repetition, maybe).
- (let* ((nts (mapcar 'car bnf)) ;Non-terminals.
+ (let* ((nts (mapcar #'car bnf)) ;Non-terminals.
(first-ops-table ())
(last-ops-table ())
(first-nts-table ())
@@ -266,7 +266,7 @@ be either:
(push resolver precs))
(t (error "Unknown resolver %S" resolver))))
(apply #'smie-merge-prec2s over
- (mapcar 'smie-precs->prec2 precs))))
+ (mapcar #'smie-precs->prec2 precs))))
again)
(dolist (rules bnf)
(let ((nt (car rules))
@@ -497,7 +497,7 @@ CSTS is a list of pairs representing arcs in a graph."
res))
cycle)))
(mapconcat
- (lambda (elems) (mapconcat 'identity elems "="))
+ (lambda (elems) (mapconcat #'identity elems "="))
(append names (list (car names)))
" < ")))
@@ -567,7 +567,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
;; Then eliminate trivial constraints iteratively.
(let ((i 0))
(while csts
- (let ((rhvs (mapcar 'cdr csts))
+ (let ((rhvs (mapcar #'cdr csts))
(progress nil))
(dolist (cst csts)
(unless (memq (car cst) rhvs)
@@ -657,8 +657,8 @@ use syntax-tables to handle them in efficient C code.")
Same calling convention as `smie-forward-token-function' except
it should move backward to the beginning of the previous token.")
-(defalias 'smie-op-left 'car)
-(defalias 'smie-op-right 'cadr)
+(defalias 'smie-op-left #'car)
+(defalias 'smie-op-right #'cadr)
(defun smie-default-backward-token ()
(forward-comment (- (point)))
@@ -974,8 +974,7 @@ I.e. a good choice can be:
(defcustom smie-blink-matching-inners t
"Whether SMIE should blink to matching opener for inner keywords.
If non-nil, it will blink not only for \"begin..end\" but also for
\"if...else\"."
- :type 'boolean
- :group 'smie)
+ :type 'boolean)
(defun smie-blink-matching-check (start end)
(save-excursion
@@ -1141,8 +1140,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a
closer."
(defcustom smie-indent-basic 4
"Basic amount of indentation."
- :type 'integer
- :group 'smie)
+ :type 'integer)
(defvar smie-rules-function #'ignore
"Function providing the indentation rules.
@@ -1189,7 +1187,7 @@ designed specifically for use in this function.")
(and ;; (looking-at comment-start-skip) ;(bug#16041).
(forward-comment (point-max))))))
-(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p)
+(defalias 'smie-rule-hanging-p #'smie-indent--hanging-p)
(defun smie-indent--hanging-p ()
"Return non-nil if the current token is \"hanging\".
A 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."
(funcall smie--hanging-eolp-function)
(point))))))
-(defalias 'smie-rule-bolp 'smie-indent--bolp)
+(defalias 'smie-rule-bolp #'smie-indent--bolp)
(defun smie-indent--bolp ()
"Return non-nil if the current token is the first on the line."
(save-excursion (skip-chars-backward " \t") (bolp)))
@@ -1421,7 +1419,7 @@ BASE-POS is the position relative to which offsets should
be applied."
(forward-sexp 1)
nil)
((eobp) nil)
- (t (error "Bumped into unknown token")))))
+ (t (error "Bumped into unknown token: %S" tok)))))
(defun smie-indent-backward-token ()
"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
return either nil if it has no opinion, or an integer representing the column
to which that point should be aligned, if we were to reindent it.")
+(defalias 'smie--funcall #'funcall) ;Debugging/tracing convenience indirection.
+
(defun smie-indent-calculate ()
"Compute the indentation to use for point."
- (run-hook-with-args-until-success 'smie-indent-functions))
+ (run-hook-wrapped 'smie-indent-functions #'smie--funcall))
(defun smie-indent-line ()
"Indent current line using the SMIE indentation engine."
@@ -2016,7 +2016,7 @@ value with which to replace it."
;; FIXME improve value-type.
:type '(choice (const nil)
(alist :key-type symbol))
- :initialize 'custom-initialize-set
+ :initialize #'custom-initialize-set
:set #'smie-config--setter)
(defun smie-config-local (rules)
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index 0c299b4..0b10dfd 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
buffer and inserts the entries with `tabulated-list-printer'.
Optional argument REMEMBER-POS, if non-nil, means to move point
-to the entry with the same ID element as the current line and
-recenter window line accordingly.
+to the entry with the same ID element as the current line.
Non-nil UPDATE argument means to use an alternative printing
method which is faster if most entries haven't changed since the
@@ -424,18 +423,10 @@ changing `tabulated-list-sort-key'."
(funcall tabulated-list-entries)
tabulated-list-entries))
(sorter (tabulated-list--get-sorter))
- entry-id saved-pt saved-col window-line)
+ entry-id saved-pt saved-col)
(and remember-pos
(setq entry-id (tabulated-list-get-id))
- (setq saved-col (current-column))
- (when (eq (window-buffer) (current-buffer))
- (setq window-line
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region (window-start) (point))
- (goto-char (point-min))
- (vertical-motion (buffer-size)))))))
+ (setq saved-col (current-column)))
;; Sort the entries, if necessary.
(when sorter
(setq entries (sort entries sorter)))
@@ -490,9 +481,7 @@ changing `tabulated-list-sort-key'."
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
(progn (goto-char saved-pt)
- (move-to-column saved-col)
- (when window-line
- (recenter window-line)))
+ (move-to-column saved-col))
(goto-char (point-min)))))
(defun tabulated-list-print-entry (id cols)
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 0b15278..a723dbd 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -26,7 +26,7 @@
;; [Part of the GNU Emacs EDT Emulation.]
-;; This emacs lisp program can be used to create an emacs lisp file
+;; This Emacs Lisp program can be used to create an Emacs Lisp file
;; that defines the mapping of the user's keyboard to the LK-201
;; keyboard function keys and keypad keys (around which EDT has been
;; designed). Please read the "Usage" AND "Known Problems" sections
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index e46e368..33bf5ad 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -198,7 +198,9 @@ encryption is used."
(mapcar #'car (epg-context-result-for
context 'encrypted-to)))
(if (or beg end)
- (setq string (substring string (or beg 0) end)))
+ (setq string (substring string
+ (or beg 0)
+ (and end (min end (length string))))))
(save-excursion
;; If visiting, bind off buffer-file-name so that
;; file-locking will not ask whether we should
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 7e10056..7eac1f8 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -59,7 +59,7 @@ Otherwise, signal an error."
;;;###autoload
(define-minor-mode epa-mail-mode
"A minor-mode for composing encrypted/clearsigned mails."
- nil " epa-mail" epa-mail-mode-map)
+ :lighter " epa-mail")
;;; Utilities
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 234b4b5..219af37 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."
(pcase (intern (downcase (pcomplete-arg 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
(cl-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type) 'CHAT))
+ (lambda (elt)
+ (eq (plist-get elt :type) 'CHAT))
erc-dcc-list)))
('close (delete-dups
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
erc-dcc-list)))
('get (mapcar #'erc-dcc-nick
(cl-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type) 'GET))
+ (lambda (elt)
+ (eq (plist-get elt :type) 'GET))
erc-dcc-list)))
('send (pcomplete-erc-all-nicks))))
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 2)))
('get (mapcar (lambda (elt) (plist-get elt :file))
(cl-remove-if-not
- #'(lambda (elt)
- (and (eq (plist-get elt :type) 'GET)
- (erc-nick-equal-p (erc-extract-nick
- (plist-get elt :nick))
- (pcomplete-arg 1))))
+ (lambda (elt)
+ (and (eq (plist-get elt :type) 'GET)
+ (erc-nick-equal-p (erc-extract-nick
+ (plist-get elt :nick))
+ (pcomplete-arg 1))))
erc-dcc-list)))
('close (mapcar #'erc-dcc-nick
(cl-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type)
- (intern (upcase (pcomplete-arg 1)))))
+ (lambda (elt)
+ (eq (plist-get elt :type)
+ (intern (upcase (pcomplete-arg 1)))))
erc-dcc-list)))
('send (pcomplete-entries)))))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 0312d22..4125668 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.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- nil nil nil
:global t
(if erc-fill-mode
(erc-fill-enable)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 8be5555..2364d45 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
sole purpose of providing the C-c C-SPC and C-c C-@ keybindings.
Make sure that you have enabled the track module, otherwise the
keybindings will not do anything useful."
- :init-value nil
- :lighter ""
- :keymap erc-track-minor-mode-map
:global t)
(defun erc-track-minor-mode-maybe (&optional buffer)
@@ -686,9 +683,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
(let* ((buffers (mapcar #'car erc-modified-channels-alist))
(counts (mapcar #'cadr erc-modified-channels-alist))
(faces (mapcar #'cddr erc-modified-channels-alist))
- (long-names (mapcar #'(lambda (buf)
- (or (buffer-name buf)
- ""))
+ (long-names (mapcar (lambda (buf)
+ (or (buffer-name buf)
+ ""))
buffers))
(short-names (if (functionp erc-track-shorten-function)
(funcall erc-track-shorten-function
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2f6e48d..e20aa80 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,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
%s" name name doc)
- nil nil nil
;; FIXME: We don't know if this group exists, so this `:group' may
;; actually just silence a valid warning about the fact that the var
;; is not associated with any group.
@@ -2321,7 +2320,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(use-local-map (make-sparse-keymap))
(local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
(add-hook 'kill-buffer-hook
- #'(lambda () (setq erc-debug-irc-protocol nil))
+ (lambda () (setq erc-debug-irc-protocol nil))
nil 'local)
(goto-char (point-max))
(let ((inhibit-read-only t))
@@ -2945,9 +2944,9 @@ If no USER argument is specified, list the contents of
`erc-ignore-list'."
(if (null (erc-with-server-buffer erc-ignore-list))
(erc-display-line (erc-make-notice "Ignore list is empty") 'active)
(erc-display-line (erc-make-notice "Ignore list:") 'active)
- (mapc #'(lambda (item)
- (erc-display-line (erc-make-notice item)
- 'active))
+ (mapc (lambda (item)
+ (erc-display-line (erc-make-notice item)
+ 'active))
(erc-with-server-buffer erc-ignore-list))))
t)
@@ -3129,8 +3128,8 @@ were most recently invited. See also `invitation'."
(when chnl
;; Prevent double joining of same channel on same server.
(let* ((joined-channels
- (mapcar #'(lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
+ (mapcar (lambda (chanbuf)
+ (with-current-buffer chanbuf (erc-default-target)))
(erc-channel-list erc-server-process)))
(server (with-current-buffer (process-buffer erc-server-process)
(or erc-session-server erc-server-announced-name)))
@@ -4149,9 +4148,9 @@ Displays PROC and PARSED appropriately using
`erc-display-message'."
(mapconcat
#'identity
(let (res)
- (mapc #'(lambda (x)
- (if (stringp x)
- (setq res (append res (list x)))))
+ (mapc (lambda (x)
+ (if (stringp x)
+ (setq res (append res (list x)))))
parsed)
res)
" ")))
@@ -4539,10 +4538,10 @@ See also: `erc-echo-notice-in-user-buffers',
;; Remove the unbanned masks from the ban list
(setq erc-channel-banlist
(cl-delete-if
- #'(lambda (y)
- (member (upcase (cdr y))
- (mapcar #'upcase
- (cdr (split-string mode)))))
+ (lambda (y)
+ (member (upcase (cdr y))
+ (mapcar #'upcase
+ (cdr (split-string mode)))))
erc-channel-banlist)))
((string-match "^\\+" mode)
;; Add the banned mask(s) to the ban list
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index 658ea08..1f08e89 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -60,8 +60,9 @@ This includes when running `eshell-command'."
"Initialize the script parsing code."
(setq-local eshell-interpreter-alist
(cons (cons (lambda (file _args)
- (string= (file-name-nondirectory file)
- "eshell"))
+ (and (file-regular-p file)
+ (string= (file-name-nondirectory file)
+ "eshell")))
'eshell/source)
eshell-interpreter-alist))
(setq-local eshell-complex-commands
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index fa3218b..f58e1b8 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -23,13 +23,10 @@
;;; Code:
+(require 'cl-lib)
(require 'esh-util)
(eval-when-compile
(require 'eshell))
-;; Strictly speaking, should only be needed at compile time.
-;; Require at run-time too to silence compiler.
-(require 'pcomplete)
-(require 'compile)
;; There are no items in this custom group, but eshell modules (ab)use
;; custom groups.
@@ -49,50 +46,45 @@ naturally accessible within Emacs."
(defun eshell/expr (&rest args)
"Implementation of expr, using the calc package."
- (if (not (fboundp 'calc-eval))
- (throw 'eshell-replace-command
- (eshell-parse-command "*expr" (flatten-tree args)))
- ;; to fool the byte-compiler...
- (let ((func 'calc-eval))
- (funcall func (eshell-flatten-and-stringify args)))))
+ (calc-eval (eshell-flatten-and-stringify args)))
(defun eshell/substitute (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'substitute (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-substitute', for comparing lists of strings."
+ (apply #'cl-substitute (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/count (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'count (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-count', for comparing lists of strings."
+ (apply #'cl-count (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/mismatch (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'mismatch (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-mismatch', for comparing lists of strings."
+ (apply #'cl-mismatch (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/union (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'union (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-union', for comparing lists of strings."
+ (apply #'cl-union (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/intersection (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'intersection (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-intersection', for comparing lists of strings."
+ (apply #'cl-intersection (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/set-difference (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'set-difference (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-set-difference', for comparing lists of strings."
+ (apply #'cl-set-difference (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/set-exclusive-or (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'set-exclusive-or (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-set-exclusive-or', for comparing lists of strings."
+ (apply #'cl-set-exclusive-or (car args) (cadr args) :test #'equal
(cddr args)))
-(defalias 'eshell/ff 'find-name-dired)
-(defalias 'eshell/gf 'find-grep-dired)
+(defalias 'eshell/ff #'find-name-dired)
+(defalias 'eshell/gf #'find-grep-dired)
(provide 'em-xtra)
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 3693829..96c9a60 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -37,23 +37,19 @@ finish."
(defcustom eshell-proc-load-hook nil
"A hook that gets run when `eshell-proc' is loaded."
:version "24.1" ; removed eshell-proc-initialize
- :type 'hook
- :group 'eshell-proc)
+ :type 'hook)
(defcustom eshell-process-wait-seconds 0
"The number of seconds to delay waiting for a synchronous process."
- :type 'integer
- :group 'eshell-proc)
+ :type 'integer)
(defcustom eshell-process-wait-milliseconds 50
"The number of milliseconds to delay waiting for a synchronous process."
- :type 'integer
- :group 'eshell-proc)
+ :type 'integer)
(defcustom eshell-done-messages-in-minibuffer t
"If non-nil, subjob \"Done\" messages will display in minibuffer."
- :type 'boolean
- :group 'eshell-proc)
+ :type 'boolean)
(defcustom eshell-delete-exited-processes t
"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
Note that Eshell will have to be restarted for a change in this
variable's value to take effect."
- :type 'boolean
- :group 'eshell-proc)
+ :type 'boolean)
(defcustom eshell-reset-signals
"^\\(interrupt\\|killed\\|quit\\|stopped\\)"
"If a termination signal matches this regexp, the terminal will be reset."
- :type 'regexp
- :group 'eshell-proc)
+ :type 'regexp)
(defcustom eshell-exec-hook nil
"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
executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag').
In contrast, `eshell-mode-hook' is only executed once, when the buffer
is created."
- :type 'hook
- :group 'eshell-proc)
+ :type 'hook)
(defcustom eshell-kill-hook nil
"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
no relevant process. This can be used for displaying help
information, for example."
:version "24.1" ; removed eshell-reset-after-proc
- :type 'hook
- :group 'eshell-proc)
+ :type 'hook)
;;; Internal Variables:
@@ -126,8 +118,7 @@ information, for example."
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter."
;; Was there till 24.1, but it is not optional.
- (if (memq #'eshell-reset-after-proc eshell-kill-hook)
- (setq eshell-kill-hook (delq #'eshell-reset-after-proc
eshell-kill-hook)))
+ (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
(eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
@@ -165,7 +156,7 @@ The signals which will cause this to happen are matched by
eshell-process-wait-milliseconds))))
(setq procs (cdr procs))))
-(defalias 'eshell/wait 'eshell-wait-for-process)
+(defalias 'eshell/wait #'eshell-wait-for-process)
(defun eshell/jobs (&rest _args)
"List processes, if there are any."
@@ -457,8 +448,7 @@ If QUERY is non-nil, query the user with QUERY before
calling FUNC."
(defcustom eshell-kill-process-wait-time 5
"Seconds to wait between sending termination signals to a subprocess."
- :type 'integer
- :group 'eshell-proc)
+ :type 'integer)
(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
"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
killed; if the process is still alive afterwards, Eshell waits a
number of seconds defined by `eshell-kill-process-wait-time', and
tries the next signal in the list."
- :type '(repeat symbol)
- :group 'eshell-proc)
+ :type '(repeat symbol))
(defcustom eshell-kill-processes-on-exit nil
"If non-nil, kill active processes when exiting an Eshell buffer.
@@ -489,8 +478,7 @@ long to delay between signals."
:type '(choice (const :tag "Kill all, don't ask" t)
(const :tag "Ask before killing" ask)
(const :tag "Ask for each process" every)
- (const :tag "Don't kill subprocesses" nil))
- :group 'eshell-proc)
+ (const :tag "Don't kill subprocesses" nil)))
(defun eshell-round-robin-kill (&optional query)
"Kill current process by trying various signals in sequence.
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index a48f626..3010481 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -23,6 +23,7 @@
;;; Code:
+(require 'seq)
(eval-when-compile (require 'cl-lib))
(defgroup eshell-util nil
@@ -37,25 +38,21 @@
If nil, t will be represented only in the exit code of the function,
and not printed as a string. This causes Lisp functions to behave
similarly to external commands, as far as successful result output."
- :type 'boolean
- :group 'eshell-util)
+ :type 'boolean)
(defcustom eshell-group-file "/etc/group"
"If non-nil, the name of the group file on your system."
- :type '(choice (const :tag "No group file" nil) file)
- :group 'eshell-util)
+ :type '(choice (const :tag "No group file" nil) file))
(defcustom eshell-passwd-file "/etc/passwd"
"If non-nil, the name of the passwd file on your system."
- :type '(choice (const :tag "No passwd file" nil) file)
- :group 'eshell-util)
+ :type '(choice (const :tag "No passwd file" nil) file))
(defcustom eshell-hosts-file "/etc/hosts"
"The name of the /etc/hosts file.
Use `pcomplete-hosts-file' instead; this variable is obsolete and
has no effect."
- :type '(choice (const :tag "No hosts file" nil) file)
- :group 'eshell-util)
+ :type '(choice (const :tag "No hosts file" nil) file))
;; Don't make it into an alias, because it doesn't really work with
;; custom and risks creating duplicate entries. Just point users to
;; the other variable, which is less frustrating.
@@ -64,25 +61,21 @@ has no effect."
(defcustom eshell-handle-errors t
"If non-nil, Eshell will handle errors itself.
Setting this to nil is offered as an aid to debugging only."
- :type 'boolean
- :group 'eshell-util)
+ :type 'boolean)
(defcustom eshell-private-file-modes 384 ; umask 177
"The file-modes value to use for creating \"private\" files."
- :type 'integer
- :group 'eshell-util)
+ :type 'integer)
(defcustom eshell-private-directory-modes 448 ; umask 077
"The file-modes value to use for creating \"private\" directories."
- :type 'integer
- :group 'eshell-util)
+ :type 'integer)
(defcustom eshell-tar-regexp
"\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
"Regular expression used to match tar file names."
:version "24.1" ; added xz
- :type 'regexp
- :group 'eshell-util)
+ :type 'regexp)
(defcustom eshell-convert-numeric-arguments t
"If non-nil, converting arguments of numeric form to Lisp numbers.
@@ -99,16 +92,14 @@ following in your init file:
Any function with the property `eshell-no-numeric-conversions' set to
a non-nil value, will be passed strings, not numbers, even when an
argument matches `eshell-number-regexp'."
- :type 'boolean
- :group 'eshell-util)
+ :type 'boolean)
(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?"
"Regular expression used to match numeric arguments.
If `eshell-convert-numeric-arguments' is non-nil, and an argument
matches this regexp, it will be converted to a Lisp number, using the
function `string-to-number'."
- :type 'regexp
- :group 'eshell-util)
+ :type 'regexp)
(defcustom eshell-ange-ls-uids nil
"List of user/host/id strings, used to determine remote ownership."
@@ -116,8 +107,7 @@ function `string-to-number'."
(string :tag "Hostname")
(repeat (cons :tag "User/UID List"
(string :tag "Username")
- (repeat :tag "UIDs" string)))))
- :group 'eshell-util)
+ (repeat :tag "UIDs" string))))))
;;; Internal Variables:
@@ -308,11 +298,11 @@ Prepend remote identification of `default-directory', if
any."
(defsubst eshell-stringify-list (args)
"Convert each element of ARGS into a string value."
- (mapcar 'eshell-stringify args))
+ (mapcar #'eshell-stringify args))
(defsubst eshell-flatten-and-stringify (&rest args)
"Flatten and stringify all of the ARGS into a single string."
- (mapconcat 'eshell-stringify (flatten-tree args) " "))
+ (mapconcat #'eshell-stringify (flatten-tree args) " "))
(defsubst eshell-directory-files (regexp &optional directory)
"Return a list of files in the given DIRECTORY matching REGEXP."
@@ -471,7 +461,7 @@ list."
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
- (mapcar 'concat process-environment))
+ (mapcar #'concat process-environment))
(defun eshell-subgroups (groupsym)
"Return all of the subgroups of GROUPSYM."
@@ -619,70 +609,68 @@ gid format. Valid values are `string' and `integer',
defaulting to
"If the `processp' function does not exist, PROC is not a process."
(and (fboundp 'processp) (processp proc)))
-; (defun eshell-copy-file
-; (file newname &optional ok-if-already-exists keep-date)
-; "Copy FILE to NEWNAME. See docs for `copy-file'."
-; (let (copied)
-; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
-; (let ((front (match-string 1 file))
-; (back (match-string 2 file))
-; buffer)
-; (if (and front (string-match eshell-tar-regexp front)
-; (setq buffer (find-file-noselect front)))
-; (with-current-buffer buffer
-; (goto-char (point-min))
-; (if (re-search-forward (concat " " (regexp-quote back)
-; "$") nil t)
-; (progn
-; (tar-copy (if (file-directory-p newname)
-; (expand-file-name
-; (file-name-nondirectory back) newname)
-; newname))
-; (setq copied t))
-; (error "%s not found in tar file %s" back front))))))
-; (unless copied
-; (copy-file file newname ok-if-already-exists keep-date))))
-
-; (defun eshell-file-attributes (filename)
-; "Return a list of attributes of file FILENAME.
-; See the documentation for `file-attributes'."
-; (let (result)
-; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
-; (let ((front (match-string 1 filename))
-; (back (match-string 2 filename))
-; buffer)
-; (when (and front (string-match eshell-tar-regexp front)
-; (setq buffer (find-file-noselect front)))
-; (with-current-buffer buffer
-; (goto-char (point-min))
-; (when (re-search-forward (concat " " (regexp-quote back)
-; "\\s-*$") nil t)
-; (let* ((descrip (tar-current-descriptor))
-; (tokens (tar-desc-tokens descrip)))
-; (setq result
-; (list
-; (cond
-; ((eq (tar-header-link-type tokens) 5)
-; t)
-; ((eq (tar-header-link-type tokens) t)
-; (tar-header-link-name tokens)))
-; 1
-; (tar-header-uid tokens)
-; (tar-header-gid tokens)
-; (tar-header-date tokens)
-; (tar-header-date tokens)
-; (tar-header-date tokens)
-; (tar-header-size tokens)
-; (concat
-; (cond
-; ((eq (tar-header-link-type tokens) 5) "d")
-; ((eq (tar-header-link-type tokens) t) "l")
-; (t "-"))
-; (tar-grind-file-mode (tar-header-mode tokens)
-; (make-string 9 ? ) 0))
-; nil nil nil))))))))
-; (or result
-; (file-attributes filename))))
+;; (defun eshell-copy-file
+;; (file newname &optional ok-if-already-exists keep-date)
+;; "Copy FILE to NEWNAME. See docs for `copy-file'."
+;; (let (copied)
+;; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
+;; (let ((front (match-string 1 file))
+;; (back (match-string 2 file))
+;; buffer)
+;; (if (and front (string-match eshell-tar-regexp front)
+;; (setq buffer (find-file-noselect front)))
+;; (with-current-buffer buffer
+;; (goto-char (point-min))
+;; (if (re-search-forward (concat " " (regexp-quote back)
+;; "$") nil t)
+;; (progn
+;; (tar-copy (if (file-directory-p newname)
+;; (expand-file-name
+;; (file-name-nondirectory back) newname)
+;; newname))
+;; (setq copied t))
+;; (error "%s not found in tar file %s" back front))))))
+;; (unless copied
+;; (copy-file file newname ok-if-already-exists keep-date))))
+
+;; (defun eshell-file-attributes (filename)
+;; "Return a list of attributes of file FILENAME.
+;; See the documentation for `file-attributes'."
+;; (let (result)
+;; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
+;; (let ((front (match-string 1 filename))
+;; (back (match-string 2 filename))
+;; buffer)
+;; (when (and front (string-match eshell-tar-regexp front)
+;; (setq buffer (find-file-noselect front)))
+;; (with-current-buffer buffer
+;; (goto-char (point-min))
+;; (when (re-search-forward (concat " " (regexp-quote back)
+;; "\\s-*$") nil t)
+;; (let* ((descrip (tar-current-descriptor))
+;; (tokens (tar-desc-tokens descrip)))
+;; (setq result
+;; (list
+;; (cond
+;; ((eq (tar-header-link-type tokens) 5)
+;; t)
+;; ((eq (tar-header-link-type tokens) t)
+;; (tar-header-link-name tokens)))
+;; 1
+;; (tar-header-uid tokens)
+;; (tar-header-gid tokens)
+;; (tar-header-date tokens)
+;; (tar-header-date tokens)
+;; (tar-header-date tokens)
+;; (tar-header-size tokens)
+;; (file-modes-number-to-symbolic
+;; (logior (tar-header-mode tokens)
+;; (cond
+;; ((eq (tar-header-link-type tokens) 5) 16384)
+;; ((eq (tar-header-link-type tokens) t) 32768))))
+;; nil nil nil))))))))
+;; (or result
+;; (file-attributes filename))))
;; Obsolete.
diff --git a/lisp/expand.el b/lisp/expand.el
index d11ae7c..1b72201 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -484,7 +484,6 @@ This is used only in conjunction with `expand-add-abbrevs'."
(provide 'expand)
-;; run load hooks
(run-hooks 'expand-load-hook)
;;; expand.el ends here
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 2d06658..8db1b42 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -539,6 +539,7 @@ filter out the color from the output."
This is installed as a `revert-buffer-function' in the *Colors* buffer."
(list-colors-display nil (buffer-name) list-colors-callback))
+;;;###autoload
(defun list-colors-display (&optional list buffer-name callback)
"Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 67d2939..62184e1 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -674,10 +674,6 @@ match REGEXP."
(insert (nth 1 item) (nth 0 item) "\n"))
(pop-to-buffer buf))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Keybindings
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
(provide 'filecache)
;;; filecache.el ends here
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 07871bb..4fc7f0a 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -505,7 +505,6 @@ DESCRIPTOR should be an object returned by
`file-notify-add-watch'."
;; due to the way events are propagated during idle time. Note: This
;; may be perfectly acceptable.
-;; The end:
(provide 'filenotify)
;;; filenotify.el ends here
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 23e4562..9e19542 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -1,4 +1,4 @@
-;;; files-x.el --- extended file handling commands
+;;; files-x.el --- extended file handling commands -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).")
"Normalize plist CRITERIA according to properties.
Return a reordered plist."
(apply
- 'append
+ #'append
(mapcar
(lambda (property)
(when (and (plist-member criteria property) (plist-get criteria
property))
diff --git a/lisp/files.el b/lisp/files.el
index 60d6034..7440c11 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7633,6 +7633,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0
if omitted)."
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
+ ;; FIXME: These divisions/shifts seem to be right
+ ;; for the `7' part of the #o4700 mask, but not
+ ;; for the `4' part. Same below for `g' and `o'.
(+ uright (/ uright #o10) (/ uright #o100))))
((= char ?g) (let ((gright (logand #o2070 from)))
(+ gright (/ gright #o10) (* gright #o10))))
@@ -7667,11 +7670,28 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
-(defun file-modes-number-to-symbolic (mode)
+(defun file-modes-number-to-symbolic (mode &optional filetype)
+ "Return a string describing a file's MODE.
+For instance, if MODE is #o700, then it produces `-rwx------'.
+FILETYPE if provided should be a character denoting the type of file,
+such as `?d' for a directory, or `?l' for a symbolic link and will override
+the leading `-' char."
(string
- (if (zerop (logand 8192 mode))
- (if (zerop (logand 16384 mode)) ?- ?d)
- ?c) ; completeness
+ (or filetype
+ (pcase (lsh mode -12)
+ ;; POSIX specifies that the file type is included in st_mode
+ ;; and provides names for the file types but values only for
+ ;; the permissions (e.g., S_IWOTH=2).
+
+ ;; (#o017 ??) ;; #define S_IFMT 00170000
+ (#o014 ?s) ;; #define S_IFSOCK 0140000
+ (#o012 ?l) ;; #define S_IFLNK 0120000
+ ;; (8 ??) ;; #define S_IFREG 0100000
+ (#o006 ?b) ;; #define S_IFBLK 0060000
+ (#o004 ?d) ;; #define S_IFDIR 0040000
+ (#o002 ?c) ;; #define S_IFCHR 0020000
+ (#o001 ?p) ;; #define S_IFIFO 0010000
+ (_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
diff --git a/lisp/find-file.el b/lisp/find-file.el
index 8cc9c97..6c3c0f1 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -1,4 +1,4 @@
-;;; find-file.el --- find a file corresponding to this one given a pattern
+;;; find-file.el --- find a file corresponding to this one given a pattern
-*- lexical-binding: t; -*-
;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au>
;; Maintainer: emacs-devel@gnu.org
@@ -39,8 +39,8 @@
;; and just has a different extension as described by the ff-other-file-alist
;; variable:
;;
-;; '(("\\.cc$" (".hh" ".h"))
-;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp")))
+;; '(("\\.cc\\'" (".hh" ".h"))
+;; ("\\.hh\\'" (".cc" ".C" ".CC" ".cxx" ".cpp")))
;;
;; If the current file has a .cc extension, ff-find-other-file will attempt
;; to look for a .hh file, and then a .h file in some directory as described
@@ -55,8 +55,8 @@
;; format above can be changed to include a function to be called when the
;; current file matches the regexp:
;;
-;; '(("\\.cc$" cc--function)
-;; ("\\.hh$" hh-function))
+;; '(("\\.cc\\'" cc--function)
+;; ("\\.hh\\'" hh-function))
;;
;; These functions must return a list consisting of the possible names of the
;; corresponding file, with or without path. There is no real need for more
@@ -64,10 +64,10 @@
;; file-alist:
;;
;; (setq cc-other-file-alist
-;; '(("\\.cc$" ff-cc-hh-converter)
-;; ("\\.hh$" ff-cc-hh-converter)
-;; ("\\.c$" (".h"))
-;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
+;; '(("\\.cc\\'" ff-cc-hh-converter)
+;; ("\\.hh\\'" ff-cc-hh-converter)
+;; ("\\.c\\'" (".h"))
+;; ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
;;
;; ff-cc-hh-converter is included at the end of this file as a reference.
;;
@@ -130,62 +130,51 @@
(defcustom ff-pre-find-hook nil
"List of functions to be called before the search for the file starts."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-pre-load-hook nil
"List of functions to be called before the other file is loaded."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-post-load-hook nil
"List of functions to be called after the other file is loaded."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-not-found-hook nil
"List of functions to be called if the other file could not be found."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-file-created-hook nil
"List of functions to be called if the other file needs to be created."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-case-fold-search nil
"Non-nil means ignore cases in matches (see `case-fold-search').
If you have extensions in different cases, you will want this to be nil."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-always-in-other-window nil
"If non-nil, find the corresponding file in another window by default.
To override this, give an argument to `ff-find-other-file'."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-ignore-include nil
"If non-nil, ignore `#include' lines."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-always-try-to-create t
"If non-nil, always attempt to create the other file if it was not found."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-quiet-mode nil
"If non-nil, trace which directories are being searched."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
;;;###autoload
(defcustom ff-special-constructs
;; C/C++ include, for NeXTstep too
`((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
- (lambda ()
- (buffer-substring (match-beginning 2) (match-end 2)))))
+ ,(lambda () (match-string 2))))
;; We include `ff-treat-as-special' documentation here so that autoload
;; can make it available to be read prior to loading this file.
"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),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
filename that EXTRACT returned."
- :type '(repeat (cons regexp function))
- :group 'ff)
+ :type '(repeat (cons regexp function)))
(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
(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,
a new one is created with the first matching extension (`.cc' yields `.hh').
This alist should be set by the major mode."
:type '(choice (repeat (list regexp (choice (repeat string) function)))
- symbol)
- :group 'ff)
+ symbol))
(defcustom ff-search-directories 'cc-search-directories
"List of directories to search for a specific file.
@@ -231,14 +218,12 @@ not exist, it is replaced (silently) with an empty string.
The stars are *not* wildcards: they are searched for together with
the preceding slash. The star represents all the subdirectories except
`..', and each of these subdirectories will be searched in turn."
- :type '(choice (repeat directory) symbol)
- :group 'ff)
+ :type '(choice (repeat directory) symbol))
(defcustom cc-search-directories
'("." "/usr/include" "/usr/local/include/*")
"See the description of the `ff-search-directories' variable."
- :type '(repeat directory)
- :group 'ff)
+ :type '(repeat directory))
(defcustom cc-other-file-alist
'(("\\.cc\\'" (".hh" ".h"))
@@ -269,17 +254,15 @@ since the search algorithm searches sequentially through
each directory
specified in `ff-search-directories'. If a file is not found, a new one
is created with the first matching extension (`.cc' yields `.hh')."
:version "24.4" ; add .m
- :type '(repeat (list regexp (choice (repeat string) function)))
- :group 'ff)
+ :type '(repeat (list regexp (choice (repeat string) function))))
(defcustom modula2-other-file-alist
'(
- ("\\.mi$" (".md")) ;; Modula-2 module definition
- ("\\.md$" (".mi")) ;; and implementation.
+ ("\\.mi\\'" (".md")) ;; Modula-2 module definition
+ ("\\.md\\'" (".mi")) ;; and implementation.
)
"See the description for the `ff-search-directories' variable."
- :type '(repeat (list regexp (choice (repeat string) function)))
- :group 'ff)
+ :type '(repeat (list regexp (choice (repeat string) function))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -308,16 +291,14 @@ See also the documentation for `ff-find-other-file'.
If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(interactive "P")
- (let ((ignore ff-ignore-include))
- (setq ff-ignore-include t)
- (ff-find-the-other-file in-other-window)
- (setq ff-ignore-include ignore)))
+ (let ((ff-ignore-include t))
+ (ff-find-the-other-file in-other-window)))
;;;###autoload
-(defalias 'ff-find-related-file 'ff-find-other-file)
+(defalias 'ff-find-related-file #'ff-find-other-file)
;;;###autoload
-(defun ff-find-other-file (&optional in-other-window ignore-include)
+(defun ff-find-other-file (&optional in-other-window ignore-include event)
"Find the header or source file corresponding to this file.
Being on a `#include' line pulls in that file.
@@ -369,11 +350,11 @@ Variables of interest include:
- `ff-file-created-hook'
List of functions to be called if the other file has been created."
- (interactive "P")
- (let ((ignore ff-ignore-include))
- (setq ff-ignore-include ignore-include)
- (ff-find-the-other-file in-other-window)
- (setq ff-ignore-include ignore)))
+ (interactive (list current-prefix-arg nil last-nonmenu-event))
+ (save-excursion
+ (posn-set-point (event-end event))
+ (let ((ff-ignore-include ignore-include))
+ (ff-find-the-other-file in-other-window))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support functions
@@ -413,9 +394,9 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in
another window."
(message "Working...")
(setq dirs
- (if (symbolp ff-search-directories)
- (ff-list-replace-env-vars (symbol-value ff-search-directories))
- (ff-list-replace-env-vars ff-search-directories)))
+ (ff-list-replace-env-vars (if (symbolp ff-search-directories)
+ (symbol-value ff-search-directories)
+ ff-search-directories)))
(setq fname (ff-treat-as-special))
@@ -454,11 +435,10 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in
another window."
;; if we have a function to generate new names,
;; invoke it with the name of the current file
(if (and (atom action) (fboundp action))
- (progn
- (setq suffixes (funcall action (ff-buffer-file-name))
- match (cons (car match) (list suffixes))
- stub nil
- default-name (car suffixes)))
+ (setq suffixes (funcall action (ff-buffer-file-name))
+ match (cons (car match) (list suffixes))
+ stub nil
+ default-name (car suffixes))
;; otherwise build our filename stub
(cond
@@ -472,7 +452,8 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in
another window."
(t
(setq format (concat "\\(.+\\)" (car match)))
(string-match format fname)
- (setq stub (substring fname (match-beginning 1) (match-end 1)))
+ ;; FIXME: What if `string-match' failed?
+ (setq stub (match-string 1 fname))
))
;; 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."
found)) ;; return buffer-name or filename
-(defun ff-other-file-name ()
- "Return name of the header or source file corresponding to the current file.
-Being on a `#include' line pulls in that file, but see the help on
-the `ff-ignore-include' variable."
-
- (let (match ;; matching regexp for this file
- suffixes ;; set of replacing regexps for the matching regexp
- action ;; function to generate the names of the other files
- fname ;; basename of this file
- pos ;; where we start matching filenames
- stub ;; name of the file without extension
- alist ;; working copy of the list of file extensions
- pathname ;; the pathname of the file or the #include line
- format ;; what we have to match
- found ;; name of the file or buffer found - nil if none
- dirs) ;; local value of ff-search-directories
-
- (message "Working...")
-
- (setq dirs
- (if (symbolp ff-search-directories)
- (ff-list-replace-env-vars (symbol-value ff-search-directories))
- (ff-list-replace-env-vars ff-search-directories)))
-
- (setq fname (ff-treat-as-special))
-
- (cond
- ((and (not ff-ignore-include) fname)
- (setq found (ff-get-file-name dirs fname nil)))
-
- ;; let's just get the corresponding file
- (t
- (setq alist (if (symbolp ff-other-file-alist)
- (symbol-value ff-other-file-alist)
- ff-other-file-alist)
- pathname (or (ff-buffer-file-name) "/none.none"))
-
- (setq fname (file-name-nondirectory pathname)
- match (car alist))
-
- ;; find the table entry corresponding to this file
- (setq pos (ff-string-match (car match) fname))
- (while (and match (if (and pos (>= pos 0)) nil (not pos)))
- (setq alist (cdr alist))
- (setq match (car alist))
- (setq pos (ff-string-match (car match) fname)))
-
- ;; no point going on if we haven't found anything
- (when match
-
- ;; otherwise, suffixes contains what we need
- (setq suffixes (car (cdr match))
- action (car (cdr match))
- found nil)
-
- ;; if we have a function to generate new names,
- ;; invoke it with the name of the current file
- (if (and (atom action) (fboundp action))
- (progn
- (setq suffixes (funcall action (ff-buffer-file-name))
- match (cons (car match) (list suffixes))
- stub nil))
-
- ;; otherwise build our filename stub
- (cond
-
- ;; get around the problem that 0 and nil both mean false!
- ((= pos 0)
- (setq format "")
- (setq stub "")
- )
-
- (t
- (setq format (concat "\\(.+\\)" (car match)))
- (string-match format fname)
- (setq stub (substring fname (match-beginning 1) (match-end 1)))
- )))
-
- ;; do the real work - find the file
- (setq found
- (ff-get-file-name dirs stub suffixes)))))
- found)) ;; return buffer-name or filename
-
(defun ff-get-file (search-dirs filename &optional suffix-list other-window)
"Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub).
If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search
@@ -709,11 +607,10 @@ name of the first file found."
;; otherwise dir matches the '/*', so search each dir separately
(progn
- (if (match-beginning 2)
- (setq rest (substring dir (match-beginning 2) (match-end 2)))
- (setq rest "")
- )
- (setq dir (substring dir (match-beginning 1) (match-end 1)))
+ (setq rest (if (match-beginning 2)
+ (match-string 2 dir)
+ ""))
+ (setq dir (match-string 1 dir))
(let ((dirlist (ff-all-dirs-under dir '("..")))
this-dir compl-dirs)
@@ -743,8 +640,8 @@ name of the first file found."
(defun ff-string-match (regexp string &optional start)
"Like `string-match', but set `case-fold-search' temporarily.
The value used comes from `ff-case-fold-search'."
- (let ((case-fold-search ff-case-fold-search))
- (if regexp
+ (if regexp
+ (let ((case-fold-search ff-case-fold-search))
(string-match regexp string start))))
(defun ff-list-replace-env-vars (search-list)
@@ -752,12 +649,12 @@ The value used comes from `ff-case-fold-search'."
(let (list
(var (car search-list)))
(while search-list
- (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var)
+ (if (string-match "\\(.*\\)\\$[({]*\\([[:alnum:]_]+\\)[)}]*\\(.*\\)" var)
(setq var
(concat
- (substring var (match-beginning 1) (match-end 1))
- (getenv (substring var (match-beginning 2) (match-end 2)))
- (substring var (match-beginning 3) (match-end 3)))))
+ (match-string 1 var)
+ (getenv (match-string 2 var))
+ (match-string 3 var))))
(setq search-list (cdr search-list))
(setq list (cons var list))
(setq var (car search-list)))
@@ -782,11 +679,7 @@ See variable `ff-special-constructs'."
(setq match (cdr elem)))
fname)))
-(defun ff-basename (string)
- "Return the basename of pathname STRING."
- (setq string (concat "/" string))
- (string-match ".*/\\([^/]+\\)$" string)
- (setq string (substring string (match-beginning 1) (match-end 1))))
+(define-obsolete-function-alias 'ff-basename #'file-name-nondirectory "28.1")
(defun ff-all-dirs-under (here &optional exclude)
"Get all the directory files under directory HERE.
@@ -800,7 +693,7 @@ Exclude all files in the optional EXCLUDE list."
(setq file (car files))
(if (and
(file-directory-p file)
- (not (member (ff-basename file) exclude)))
+ (not (member (file-name-nondirectory file) exclude)))
(setq dirlist (cons file dirlist)))
(setq files (cdr files)))
(setq dirlist (reverse dirlist))))
@@ -820,84 +713,65 @@ or `switch-to-buffer' / `switch-to-buffer-other-window'
function pairs.
If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is
called before `ff-post-load-hook'."
(run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks)
- (if (or
- (and in-other-window (not ff-always-in-other-window))
- (and (not in-other-window) ff-always-in-other-window))
- (funcall f2 file)
- (funcall f1 file))
+ (funcall (if (or
+ (and in-other-window (not ff-always-in-other-window))
+ (and (not in-other-window) ff-always-in-other-window))
+ f2 f1)
+ file)
(if new-file
(run-hooks 'ff-file-created-hook 'ff-file-created-hooks))
(run-hooks 'ff-post-load-hook 'ff-post-load-hooks))
(defun ff-find-file (file &optional in-other-window new-file)
"Like `find-file', but may show the file in another window."
- (ff-switch-file 'find-file
- 'find-file-other-window
+ (ff-switch-file #'find-file
+ #'find-file-other-window
file in-other-window new-file))
(defun ff-switch-to-buffer (buffer-or-name &optional in-other-window)
"Like `switch-to-buffer', but may show the buffer in another window."
- (ff-switch-file 'switch-to-buffer
- 'switch-to-buffer-other-window
+ (ff-switch-file #'switch-to-buffer
+ #'switch-to-buffer-other-window
buffer-or-name in-other-window nil))
;;;###autoload
-(defun ff-mouse-find-other-file (event)
- "Visit the file you click on."
- (interactive "e")
- (save-excursion
- (mouse-set-point event)
- (ff-find-other-file nil)))
+(define-obsolete-function-alias
+ 'ff-mouse-find-other-file #'ff-find-other-file "28.1")
;;;###autoload
-(defun ff-mouse-find-other-file-other-window (event)
- "Visit the file you click on in another window."
- (interactive "e")
- (save-excursion
- (mouse-set-point event)
- (ff-find-other-file t)))
+(define-obsolete-function-alias
+ 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window
"28.1")
+;;;###autoload
+(defun ff-find-other-file-other-window (event)
+ "Visit the file you point at in another window."
+ (interactive (list last-nonmenu-event))
+ (ff-find-other-file t nil event))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This section offers an example of user defined function to select files
-(defun ff-upcase-p (string &optional start end)
- "Return t if STRING is all uppercase.
-Given START and/or END, checks between these characters."
- (let (match str)
- (if (not start)
- (setq start 0))
- (if (not end)
- (setq end (length string)))
- (if (= start end)
- (setq end (1+ end)))
- (setq str (substring string start end))
- (if (and
- (ff-string-match "[A-Z]+" str)
- (setq match (match-data))
- (= (car match) 0)
- (= (car (cdr match)) (length str)))
- t
- nil)))
+(defun ff-upcase-p (string)
+ "Return t if STRING is all uppercase."
+ ;; FIXME: Why `ff-string-match' since `[:upper:]' only makes
+ ;; sense when `case-fold-search' is nil?
+ (ff-string-match "\\`[[:upper:]]*\\'" string))
(defun ff-cc-hh-converter (arg)
"Discriminate file extensions.
Build up a new file list based possibly on part of the directory name
and the name of the file passed in."
(ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg)
- (let ((dire (if (match-beginning 2)
- (substring arg (match-beginning 2) (match-end 2)) nil))
- (file (if (match-beginning 3)
- (substring arg (match-beginning 3) (match-end 3)) nil))
- (extn (if (match-beginning 4)
- (substring arg (match-beginning 4) (match-end 4)) nil))
+ (let ((dire (match-string 2 arg))
+ (file (match-string 3 arg))
+ (extn (match-string 4 arg))
return-list)
(cond
;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h}
((and (string= extn "cc")
- (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file))
- (let ((stub (substring file (match-beginning 2) (match-end 2))))
- (setq dire (upcase (substring file (match-beginning 1) (match-end 1))))
+ (ff-string-match "^\\([[:lower:]]+\\)\\([[:upper:]].+\\)$" file))
+ (let ((stub (match-string 2 file)))
+ (setq dire (upcase (match-string 1 file)))
(setq return-list (list (concat stub ".hh")
(concat stub ".h")
(concat file ".hh")
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 3419d7f..cadf274 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -1,4 +1,4 @@
-;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
+;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
-*- lexical-binding: t -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@@ -33,7 +33,7 @@
;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry)
;; to expose the body or C-c C-i to expose the child (level-2) headings.
;;
-;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body
+;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the
body
;; and child subheadings and narrows the buffer so that only the level-1
;; heading, the body and the level-2 headings are visible. If you now want to
;; look under one of the level-2 headings, position the cursor on it and do C-c
@@ -57,7 +57,7 @@
;; zoomed-in heading. This is useful for restricting changes to a particular
;; chapter or section of your document.
;;
-;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides
+;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides
;; all the text and subheadings under the top-level heading and returns you to
;; the previous view of the buffer. Specifying a numeric argument exits that
;; 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).")
(defvar-local foldout-mode-line-string nil
"Mode line string announcing that we are in an outline fold.")
+;; FIXME: This should be rewritten as a proper minor mode.
+
;; put our minor mode string immediately following outline-minor-mode's
(or (assq 'foldout-mode-line-string minor-mode-alist)
(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).")
(error "Can't find outline-minor-mode in minor-mode-alist"))
;; slip our fold announcement into the list
- (setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))
- ))
+ (setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))))
@@ -275,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg)
changes this:-
((> exposure-value 0)
(outline-show-children exposure-value))
(t
- (outline-show-subtree))
- )
+ (outline-show-subtree)))
;; save the location of the fold we are entering
(setq foldout-fold-list (cons (cons start-marker end-marker)
foldout-fold-list))
;; update the mode line
- (foldout-update-mode-line)
- )))
+ (foldout-update-mode-line))))
(defun foldout-exit-fold (&optional num-folds)
@@ -308,8 +307,7 @@ exited and text is left visible."
;; have we been told not to hide the fold?
((< num-folds 0)
(setq hide-fold nil
- num-folds (- num-folds)))
- )
+ num-folds (- num-folds))))
;; limit the number of folds if we've been told to exit too many
(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."
event)
(defun foldout-mouse-goto-heading (event)
- "Go to the heading where the mouse event started. Signal an error
-if the event didn't occur on a heading."
+ "Go to the heading where the mouse EVENT started.
+Signal an error if the event didn't occur on a heading."
(goto-char (posn-point (event-start event)))
(or (outline-on-heading-p)
;; outline.el sometimes treats beginning-of-buffer as a heading
@@ -505,17 +503,16 @@ M-C-down-mouse-{1,2,3}.
Valid modifiers are shift, control, meta, alt, hyper and super.")
-(if foldout-inhibit-key-bindings
- ()
- (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree)
- (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold)
+(unless foldout-inhibit-key-bindings
+ (define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree)
+ (define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold)
(let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix)))
(unless map
(setq map (make-sparse-keymap))
(define-key outline-minor-mode-map outline-minor-mode-prefix map))
- (define-key map "\C-z" 'foldout-zoom-subtree)
- (define-key map "\C-x" 'foldout-exit-fold))
- (let* ((modifiers (apply 'concat
+ (define-key map "\C-z" #'foldout-zoom-subtree)
+ (define-key map "\C-x" #'foldout-exit-fold))
+ (let* ((modifiers (apply #'concat
(mapcar (lambda (modifier)
(vector
(cond
@@ -525,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and
super.")
((eq modifier 'alt) ?A)
((eq modifier 'hyper) ?H)
((eq modifier 'super) ?s)
- (t (error "invalid mouse modifier %s"
+ (t (error "Invalid mouse modifier %s"
modifier)))
?-))
foldout-mouse-modifiers)))
@@ -533,14 +530,13 @@ Valid modifiers are shift, control, meta, alt, hyper and
super.")
(mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
(mouse-3 (vector (intern (concat modifiers "down-mouse-3")))))
- (define-key outline-mode-map mouse-1 'foldout-mouse-zoom)
- (define-key outline-mode-map mouse-2 'foldout-mouse-show)
- (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit)
+ (define-key outline-mode-map mouse-1 #'foldout-mouse-zoom)
+ (define-key outline-mode-map mouse-2 #'foldout-mouse-show)
+ (define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit)
- (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom)
- (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show)
- (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit)
- ))
+ (define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom)
+ (define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show)
+ (define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit)))
;; Obsolete.
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 4b69542..db06a60 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.
The above is the default behavior of `font-lock-mode'; you may
specify your own function which is called when `font-lock-mode'
is toggled via `font-lock-function'."
- nil nil nil
:after-hook (font-lock-initial-fontify)
;; Don't turn on Font Lock mode if we don't have a display (we're running a
;; 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 b6f78b4..e206313 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -301,7 +301,7 @@ This function runs the abnormal hook
`move-frame-functions'."
(declare-function tool-bar-mode "tool-bar" (&optional arg))
(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
-(defalias 'tool-bar-lines-needed 'tool-bar-height)
+(defalias 'tool-bar-lines-needed #'tool-bar-height)
;; startup.el calls this function after loading the user's init
;; file. Now default-frame-alist and initial-frame-alist contain
@@ -690,8 +690,8 @@ is not considered (see `next-frame')."
0))
(select-frame-set-input-focus (selected-frame)))
-(defalias 'next-multiframe-window 'next-window-any-frame)
-(defalias 'previous-multiframe-window 'previous-window-any-frame)
+(defalias 'next-multiframe-window #'next-window-any-frame)
+(defalias 'previous-multiframe-window #'previous-window-any-frame)
(defun window-system-for-display (display)
"Return the window system for DISPLAY.
@@ -782,7 +782,7 @@ If DISPLAY is nil, that stands for the selected frame's
display."
(format "Delete %s frames? " (length frames))
(format "Delete %s ? " (car frames))))))
(error "Abort!")
- (mapc 'delete-frame frames)
+ (mapc #'delete-frame frames)
(x-close-connection display))))
(defun make-frame-command ()
@@ -1162,8 +1162,8 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
:group 'faces
:set #'(lambda (var value)
(set-default var value)
- (mapc 'frame-set-background-mode (frame-list)))
- :initialize 'custom-initialize-changed
+ (mapc #'frame-set-background-mode (frame-list)))
+ :initialize #'custom-initialize-changed
:type '(choice (const dark)
(const light)
(const :tag "automatic" nil)))
@@ -1176,6 +1176,27 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
(defvar inhibit-frame-set-background-mode nil)
+(defun frame--current-backround-mode (frame)
+ (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
+ (bg-color (frame-parameter frame 'background-color))
+ (tty-type (tty-type frame))
+ (default-bg-mode
+ (if (or (window-system frame)
+ (and tty-type
+ (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+ tty-type)))
+ 'light
+ 'dark)))
+ (cond (frame-default-bg-mode)
+ ((equal bg-color "unspecified-fg") ; inverted colors
+ (if (eq default-bg-mode 'light) 'dark 'light))
+ ((not (color-values bg-color frame))
+ default-bg-mode)
+ ((color-dark-p (mapcar (lambda (c) (/ c 65535.0))
+ (color-values bg-color frame)))
+ 'dark)
+ (t 'light))))
+
(defun frame-set-background-mode (frame &optional keep-face-specs)
"Set up display-dependent faces on FRAME.
Display-dependent faces are those which have different definitions
@@ -1184,30 +1205,8 @@ according to the `background-mode' and `display-type'
frame parameters.
If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
face specs for the new background mode."
(unless inhibit-frame-set-background-mode
- (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
- (bg-color (frame-parameter frame 'background-color))
- (tty-type (tty-type frame))
- (default-bg-mode
- (if (or (window-system frame)
- (and tty-type
- (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
- tty-type)))
- 'light
- 'dark))
- (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
- (bg-mode
- (cond (frame-default-bg-mode)
- ((equal bg-color "unspecified-fg") ; inverted colors
- non-default-bg-mode)
- ((not (color-values bg-color frame))
- default-bg-mode)
- ((>= (apply '+ (color-values bg-color frame))
- ;; Just looking at the screen, colors whose
- ;; values add up to .6 of the white total
- ;; still look dark to me.
- (* (apply '+ (color-values "white" frame)) .6))
- 'light)
- (t 'dark)))
+ (let* ((bg-mode
+ (frame--current-backround-mode frame))
(display-type
(cond ((null (window-system frame))
(if (tty-display-color-p frame) 'color 'mono))
@@ -1273,6 +1272,26 @@ the `background-mode' terminal parameter."
(intern (downcase bg-resource))))
(terminal-parameter frame 'background-mode)))
+;; FIXME: This needs to be significantly improved before we can use it:
+;; - Fix the "scope" to be consistent: the code below is partly per-frame
+;; and partly all-frames :-(
+;; - Make it interact correctly with color themes (e.g. modus-themes).
+;; Maybe automatically disabling color themes that disagree with the
+;; selected value of `dark-mode'.
+;; - Check interaction with "(in|re)verse-video".
+;;
+;; (define-minor-mode dark-mode
+;; "Use light text on dark background."
+;; :global t
+;; :group 'faces
+;; (when (eq dark-mode
+;; (eq 'light (frame--current-backround-mode (selected-frame))))
+;; ;; FIXME: Change the face's SPEC instead?
+;; (set-face-attribute 'default nil
+;; :foreground (face-attribute 'default :background)
+;; :background (face-attribute 'default :foreground))
+;; (frame-set-background-mode (selected-frame))))
+
;;;; Frame configurations
@@ -1357,9 +1376,9 @@ differing font heights."
If FRAME is omitted, describe the currently selected frame."
(cdr (assq 'width (frame-parameters frame))))
-(defalias 'frame-border-width 'frame-internal-border-width)
-(defalias 'frame-pixel-width 'frame-native-width)
-(defalias 'frame-pixel-height 'frame-native-height)
+(defalias 'frame-border-width #'frame-internal-border-width)
+(defalias 'frame-pixel-width #'frame-native-width)
+(defalias 'frame-pixel-height #'frame-native-height)
(defun frame-inner-width (&optional frame)
"Return inner width of FRAME in pixels.
@@ -2009,9 +2028,9 @@ frame's display)."
(fboundp 'image-mask-p)
(fboundp 'image-size)))
-(defalias 'display-blink-cursor-p 'display-graphic-p)
-(defalias 'display-multi-frame-p 'display-graphic-p)
-(defalias 'display-multi-font-p 'display-graphic-p)
+(defalias 'display-blink-cursor-p #'display-graphic-p)
+(defalias 'display-multi-frame-p #'display-graphic-p)
+(defalias 'display-multi-font-p #'display-graphic-p)
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
@@ -2363,13 +2382,15 @@ In the 3rd, 4th, and 6th examples, the returned value
is relative to
the opposite frame edge from the edge indicated in the input spec."
(cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
-(defun delete-other-frames (&optional frame)
+(defun delete-other-frames (&optional frame iconify)
"Delete all frames on FRAME's terminal, except FRAME.
If FRAME uses another frame's minibuffer, the minibuffer frame is
left untouched. Do not delete any of FRAME's child frames. If
FRAME is a child frame, delete its siblings only. FRAME must be
-a live frame and defaults to the selected one."
- (interactive)
+a live frame and defaults to the selected one.
+If the prefix arg ICONIFY is non-nil, just iconify the frames rather than
+deleting them."
+ (interactive "i\nP")
(setq frame (window-normalize-frame frame))
(let ((minibuffer-frame (window-frame (minibuffer-window frame)))
(this (next-frame frame t))
@@ -2384,7 +2405,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
- (delete-frame this))
+ (if iconify (iconify-frame this) (delete-frame this)))
(setq this next))
;; In a second round consider all remaining frames.
(setq this (next-frame frame t))
@@ -2396,7 +2417,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
- (delete-frame this))
+ (if iconify (iconify-frame this) (delete-frame this)))
(setq this next))))
@@ -2422,7 +2443,7 @@ parameters `bottom-divider-width' and
`right-divider-width'."
:type '(choice (const :tag "Bottom only" bottom-only)
(const :tag "Right only" right-only)
(const :tag "Bottom and right" t))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@@ -2443,7 +2464,7 @@ parameter `bottom-divider-width'."
:type '(restricted-sexp
:tag "Default width of bottom dividers"
:match-alternatives (window-divider-width-valid-p))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@@ -2460,7 +2481,7 @@ parameter `right-divider-width'."
:type '(restricted-sexp
:tag "Default width of right dividers"
:match-alternatives (window-divider-width-valid-p))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@@ -2737,14 +2758,14 @@ See also `toggle-frame-maximized'."
;;;; Key bindings
-(define-key ctl-x-5-map "2" 'make-frame-command)
-(define-key ctl-x-5-map "1" 'delete-other-frames)
-(define-key ctl-x-5-map "0" 'delete-frame)
-(define-key ctl-x-5-map "o" 'other-frame)
-(define-key ctl-x-5-map "5" 'other-frame-prefix)
-(define-key global-map [f11] 'toggle-frame-fullscreen)
-(define-key global-map [(meta f10)] 'toggle-frame-maximized)
-(define-key esc-map [f10] 'toggle-frame-maximized)
+(define-key ctl-x-5-map "2" #'make-frame-command)
+(define-key ctl-x-5-map "1" #'delete-other-frames)
+(define-key ctl-x-5-map "0" #'delete-frame)
+(define-key ctl-x-5-map "o" #'other-frame)
+(define-key ctl-x-5-map "5" #'other-frame-prefix)
+(define-key global-map [f11] #'toggle-frame-fullscreen)
+(define-key global-map [(meta f10)] #'toggle-frame-maximized)
+(define-key esc-map [f10] #'toggle-frame-maximized)
;; Misc.
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 0f4e1ae..4505d85 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -32,6 +32,17 @@
;;
;; (require 'generic-x)
;;
+;; You can decide which modes to load by setting the variable
+;; `generic-extras-enable-list'. Its default value is platform-
+;; specific. The recommended way to set this variable is through
+;; customize:
+;;
+;; M-x customize-option RET generic-extras-enable-list RET
+;;
+;; This lets you select generic modes from the list of available
+;; modes. If you manually set `generic-extras-enable-list' in your
+;; .emacs, do it BEFORE loading generic-x with (require 'generic-x).
+;;
;; You can also send in new modes; if the file types are reasonably
;; common, we would like to install them.
;;
@@ -173,7 +184,88 @@ This hook will be installed if the variable
;; Other Generic modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; If you add a generic mode to this file, put it in one of these four
+;; lists as well.
+
+(defconst generic-default-modes
+ '(apache-conf-generic-mode
+ apache-log-generic-mode
+ hosts-generic-mode
+ java-manifest-generic-mode
+ java-properties-generic-mode
+ javascript-generic-mode
+ show-tabs-generic-mode
+ vrml-generic-mode)
+ "List of generic modes that are defined by default.")
+
+(defconst generic-mswindows-modes
+ '(bat-generic-mode
+ inf-generic-mode
+ ini-generic-mode
+ rc-generic-mode
+ reg-generic-mode
+ rul-generic-mode)
+ "List of generic modes that are defined by default on MS-Windows.")
+
+(defconst generic-unix-modes
+ '(alias-generic-mode
+ ansible-inventory-generic-mode
+ etc-fstab-generic-mode
+ etc-modules-conf-generic-mode
+ etc-passwd-generic-mode
+ etc-services-generic-mode
+ etc-sudoers-generic-mode
+ fvwm-generic-mode
+ inetd-conf-generic-mode
+ mailagent-rules-generic-mode
+ mailrc-generic-mode
+ named-boot-generic-mode
+ named-database-generic-mode
+ prototype-generic-mode
+ resolve-conf-generic-mode
+ samba-generic-mode
+ x-resource-generic-mode
+ xmodmap-generic-mode)
+ "List of generic modes that are defined by default on Unix.")
+
+(defconst generic-other-modes
+ '(astap-generic-mode
+ ibis-generic-mode
+ pkginfo-generic-mode
+ spice-generic-mode)
+ "List of generic modes that are not defined by default.")
+
+(defcustom generic-extras-enable-list
+ (append generic-default-modes
+ (if (memq system-type '(windows-nt ms-dos))
+ generic-mswindows-modes
+ generic-unix-modes)
+ nil)
+ "List of generic modes to define.
+Each entry in the list should be a symbol. If you set this variable
+directly, without using customize, you must reload generic-x to put
+your changes into effect."
+ :type (let (list)
+ (dolist (mode
+ (sort (append generic-default-modes
+ generic-mswindows-modes
+ generic-unix-modes
+ generic-other-modes
+ nil)
+ (lambda (a b)
+ (string< (symbol-name b)
+ (symbol-name a))))
+ (cons 'set list))
+ (push `(const ,mode) list)))
+ :set (lambda (s v)
+ (set-default s v)
+ (unless load-in-progress
+ (load "generic-x")))
+ :version "22.1")
+
;;; Apache
+(when (memq 'apache-conf-generic-mode generic-extras-enable-list)
+
(define-generic-mode apache-conf-generic-mode
'(?#)
nil
@@ -186,7 +278,9 @@ This hook will be installed if the variable
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)
("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
- "Generic mode for Apache or HTTPD configuration files.")
+ "Generic mode for Apache or HTTPD configuration files."))
+
+(when (memq 'apache-log-generic-mode generic-extras-enable-list)
(define-generic-mode apache-log-generic-mode
nil
@@ -197,9 +291,11 @@ This hook will be installed if the variable
(2 font-lock-variable-name-face)))
'("access_log\\'")
nil
- "Generic mode for Apache log files.")
+ "Generic mode for Apache log files."))
;;; Samba
+(when (memq 'samba-generic-mode generic-extras-enable-list)
+
(define-generic-mode samba-generic-mode
'(?\; ?#)
nil
@@ -209,11 +305,13 @@ This hook will be installed if the variable
(2 font-lock-type-face)))
'("smb\\.conf\\'")
'(generic-bracket-support)
- "Generic mode for Samba configuration files.")
+ "Generic mode for Samba configuration files."))
;;; Fvwm
;; This is pretty basic. Also, modes for other window managers could
;; be defined as well.
+(when (memq 'fvwm-generic-mode generic-extras-enable-list)
+
(define-generic-mode fvwm-generic-mode
'(?#)
'("AddToMenu"
@@ -232,28 +330,33 @@ This hook will be installed if the variable
nil
'("\\.fvwmrc\\'" "\\.fvwm2rc\\'")
nil
- "Generic mode for FVWM configuration files.")
+ "Generic mode for FVWM configuration files."))
;;; X Resource
;; I'm pretty sure I've seen an actual mode to do this, but I don't
;; think it's standard with Emacs
+(when (memq 'x-resource-generic-mode generic-extras-enable-list)
+
(define-generic-mode x-resource-generic-mode
'(?!)
nil
'(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face))
'("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'")
nil
- "Generic mode for X Resource configuration files.")
+ "Generic mode for X Resource configuration files."))
+(if (memq 'xmodmap-generic-mode generic-extras-enable-list)
(define-generic-mode xmodmap-generic-mode
'(?!)
'("add" "clear" "keycode" "keysym" "remove" "pointer")
nil
'("[xX]modmap\\(rc\\)?\\'")
nil
- "Simple mode for xmodmap files.")
+ "Simple mode for xmodmap files."))
;;; Hosts
+(when (memq 'hosts-generic-mode generic-extras-enable-list)
+
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
@@ -261,20 +364,27 @@ This hook will be installed if the variable
("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
- "Generic mode for HOSTS files.")
+ "Generic mode for HOSTS files."))
;;; Windows INF files
+;; If i-g-m-f-f-h is defined, then so is i-g-m.
+(declare-function ini-generic-mode "generic-x")
+
+(when (memq 'inf-generic-mode generic-extras-enable-list)
+
(define-generic-mode inf-generic-mode
'(?\;)
nil
'(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face))
'("\\.[iI][nN][fF]\\'")
'(generic-bracket-support)
- "Generic mode for MS-Windows INF files.")
+ "Generic mode for MS-Windows INF files."))
;;; Windows INI files
;; Should define escape character as well!
+(when (memq 'ini-generic-mode generic-extras-enable-list)
+
(define-generic-mode ini-generic-mode
'(?\;)
nil
@@ -301,9 +411,13 @@ like an INI file. You can add this hook to
`find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
+(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
+ 'ini-generic-mode-find-file-hook "28.1"))
;;; Windows REG files
;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
+(when (memq 'reg-generic-mode generic-extras-enable-list)
+
(define-generic-mode reg-generic-mode
'(?\;)
'("key" "classes_root" "REGEDIT" "REGEDIT4")
@@ -314,11 +428,19 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
- "Generic mode for MS-Windows Registry files.")
+ "Generic mode for MS-Windows Registry files."))
+
+(declare-function w32-shell-name "w32-fns" ())
+
+;;; DOS/Windows BAT files
+(when (memq 'bat-generic-mode generic-extras-enable-list)
+ (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4"))
;;; Mailagent
;; Mailagent is a Unix mail filtering program. Anyone wanna do a
;; generic mode for procmail?
+(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list)
+
(define-generic-mode mailagent-rules-generic-mode
'(?#)
'("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT")
@@ -329,9 +451,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
- "Generic mode for Mailagent rules files.")
+ "Generic mode for Mailagent rules files."))
;; Solaris/Sys V prototype files
+(when (memq 'prototype-generic-mode generic-extras-enable-list)
+
(define-generic-mode prototype-generic-mode
'(?#)
nil
@@ -350,9 +474,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("prototype\\'")
nil
- "Generic mode for Sys V prototype files.")
+ "Generic mode for Sys V prototype files."))
;; Solaris/Sys V pkginfo files
+(when (memq 'pkginfo-generic-mode generic-extras-enable-list)
+
(define-generic-mode pkginfo-generic-mode
'(?#)
nil
@@ -361,9 +487,17 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("pkginfo\\'")
nil
- "Generic mode for Sys V pkginfo files.")
+ "Generic mode for Sys V pkginfo files."))
+
+;; Javascript mode
+;; Obsolete; defer to js-mode from js.el.
+(when (memq 'javascript-generic-mode generic-extras-enable-list)
+ (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
+ (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3"))
;; VRML files
+(when (memq 'vrml-generic-mode generic-extras-enable-list)
+
(define-generic-mode vrml-generic-mode
'(?#)
'("DEF"
@@ -411,9 +545,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
("*Definitions*"
"DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
1)))))
- "Generic Mode for VRML files.")
+ "Generic Mode for VRML files."))
;; Java Manifests
+(when (memq 'java-manifest-generic-mode generic-extras-enable-list)
+
(define-generic-mode java-manifest-generic-mode
'(?#)
'("Name"
@@ -430,9 +566,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-constant-face)))
'("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'")
nil
- "Generic mode for Java Manifest files.")
+ "Generic mode for Java Manifest files."))
;; Java properties files
+(when (memq 'java-properties-generic-mode generic-extras-enable-list)
+
(define-generic-mode java-properties-generic-mode
'(?! ?#)
nil
@@ -458,9 +596,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
- "Generic mode for Java properties files.")
+ "Generic mode for Java properties files."))
;; C shell alias definitions
+(when (memq 'alias-generic-mode generic-extras-enable-list)
+
(define-generic-mode alias-generic-mode
'(?#)
'("alias" "unalias")
@@ -473,9 +613,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
- "Generic mode for C Shell alias files.")
+ "Generic mode for C Shell alias files."))
;; Ansible inventory files
+(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list)
+
(define-generic-mode ansible-inventory-generic-mode
'(?#)
nil
@@ -494,10 +636,12 @@ like an INI file. You can add this hook to
`find-file-hook'."
(setq imenu-generic-expression
'((nil "^\\s-*\\[\\(.*\\)\\]" 1)
("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
- "Generic mode for Ansible inventory files.")
+ "Generic mode for Ansible inventory files."))
;;; Windows RC files
;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira)
+(when (memq 'rc-generic-mode generic-extras-enable-list)
+
(define-generic-mode rc-generic-mode
;; '(?\/)
'("//")
@@ -577,13 +721,15 @@ like an INI file. You can add this hook to
`find-file-hook'."
'("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-constant-face)
(2 font-lock-variable-name-face nil t))))
- '("\\.[rR][cC]\\'")
- nil
- "Generic mode for MS-Windows Resource files.")
+ '("\\.[rR][cC]\\'")
+ nil
+ "Generic mode for MS-Windows Resource files."))
;; InstallShield RUL files
;; Contributed by Alfred.Correira@Pervasive.Com
;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com>
+(when (memq 'rul-generic-mode generic-extras-enable-list)
+
(eval-when-compile
;;; build the regexp strings using regexp-opt
@@ -1226,9 +1372,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
> "begin" \n
> _ \n
resume:
- > "end;")
+ > "end;"))
;; Additions by ACorreir@pervasive-sw.com (Alfred Correira)
+(when (memq 'mailrc-generic-mode generic-extras-enable-list)
+
(define-generic-mode mailrc-generic-mode
'(?#)
'("alias"
@@ -1250,9 +1398,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.mailrc\\'")
nil
- "Mode for mailrc files.")
+ "Mode for mailrc files."))
;; Inetd.conf
+(when (memq 'inetd-conf-generic-mode generic-extras-enable-list)
+
(define-generic-mode inetd-conf-generic-mode
'(?#)
'("stream"
@@ -1267,9 +1417,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Services
+(when (memq 'etc-services-generic-mode generic-extras-enable-list)
+
(define-generic-mode etc-services-generic-mode
'(?#)
'("tcp"
@@ -1282,9 +1434,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Password and Group files
+(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
+
(define-generic-mode etc-passwd-generic-mode
nil ;; No comment characters
'("root") ;; Only one keyword
@@ -1322,9 +1476,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
;; Fstab
+(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
+
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
@@ -1436,9 +1592,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([^# \t]+\\)\\s-+" 1))))))
+ '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
;; /etc/sudoers
+(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
+
(define-generic-mode etc-sudoers-generic-mode
'(?#)
'("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'."
("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face))
'("/etc/sudoers\\'")
nil
- "Generic mode for sudoers configuration files.")
+ "Generic mode for sudoers configuration files."))
;; From Jacques Duthen <jacques.duthen@sncf.fr>
+(when (memq 'show-tabs-generic-mode generic-extras-enable-list)
+
(eval-when-compile
(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'."
nil ;; no auto-mode-alist
;; '(show-tabs-generic-mode-hook-fun)
nil
- "Generic mode to show tabs and trailing spaces.")
+ "Generic mode to show tabs and trailing spaces."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DNS modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(when (memq 'named-boot-generic-mode generic-extras-enable-list)
+
(define-generic-mode named-boot-generic-mode
;; List of comment characters
'(?\;)
@@ -1510,7 +1672,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/named\\.boot\\'")
;; List of set up functions to call
- nil)
+ nil))
+
+(when (memq 'named-database-generic-mode generic-extras-enable-list)
(define-generic-mode named-database-generic-mode
;; List of comment characters
@@ -1531,7 +1695,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(defun named-database-print-serial ()
"Print a serial number based on the current date."
(interactive)
- (insert (format-time-string named-database-time-string)))
+ (insert (format-time-string named-database-time-string))))
+
+(when (memq 'resolve-conf-generic-mode generic-extras-enable-list)
(define-generic-mode resolve-conf-generic-mode
;; List of comment characters
@@ -1543,12 +1709,14 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional auto-mode-alist expressions
'("/etc/resolve?\\.conf\\'")
;; List of set up functions to call
- nil)
+ nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Modes for spice and common electrical engineering circuit netlist formats
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(when (memq 'spice-generic-mode generic-extras-enable-list)
+
(define-generic-mode spice-generic-mode
nil
'("and"
@@ -1584,7 +1752,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
- "Generic mode for SPICE circuit netlist files.")
+ "Generic mode for SPICE circuit netlist files."))
+
+(when (memq 'ibis-generic-mode generic-extras-enable-list)
(define-generic-mode ibis-generic-mode
'(?|)
@@ -1593,7 +1763,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[iI][bB][sS]\\'")
'(generic-bracket-support)
- "Generic mode for IBIS circuit netlist files.")
+ "Generic mode for IBIS circuit netlist files."))
+
+(when (memq 'astap-generic-mode generic-extras-enable-list)
(define-generic-mode astap-generic-mode
nil
@@ -1627,7 +1799,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
- "Generic mode for ASTAP circuit netlist files.")
+ "Generic mode for ASTAP circuit netlist files."))
+
+(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
(define-generic-mode etc-modules-conf-generic-mode
;; List of comment characters
@@ -1669,98 +1843,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/modules\\.conf" "/etc/conf\\.modules")
;; List of set up functions to call
- nil)
-
-;; Obsolete
-
-(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3")
-(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3")
-
-(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4")
-
-(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
- #'ini-generic-mode-find-file-hook "28.1")
-
-(defconst generic-default-modes
- '(apache-conf-generic-mode
- apache-log-generic-mode
- hosts-generic-mode
- java-manifest-generic-mode
- java-properties-generic-mode
- javascript-generic-mode
- show-tabs-generic-mode
- vrml-generic-mode)
- "List of generic modes that are defined by default.")
-(make-obsolete-variable 'generic-default-modes "no longer used." "28.1")
-
-(defconst generic-mswindows-modes
- '(bat-generic-mode
- inf-generic-mode
- ini-generic-mode
- rc-generic-mode
- reg-generic-mode
- rul-generic-mode)
- "List of generic modes that are defined by default on MS-Windows.")
-(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1")
-
-(defconst generic-unix-modes
- '(alias-generic-mode
- ansible-inventory-generic-mode
- etc-fstab-generic-mode
- etc-modules-conf-generic-mode
- etc-passwd-generic-mode
- etc-services-generic-mode
- etc-sudoers-generic-mode
- fvwm-generic-mode
- inetd-conf-generic-mode
- mailagent-rules-generic-mode
- mailrc-generic-mode
- named-boot-generic-mode
- named-database-generic-mode
- prototype-generic-mode
- resolve-conf-generic-mode
- samba-generic-mode
- x-resource-generic-mode
- xmodmap-generic-mode)
- "List of generic modes that are defined by default on Unix.")
-(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1")
-
-(defconst generic-other-modes
- '(astap-generic-mode
- ibis-generic-mode
- pkginfo-generic-mode
- spice-generic-mode)
- "List of generic modes that are not defined by default.")
-(make-obsolete-variable 'generic-other-modes "no longer used." "28.1")
-
-(defcustom generic-extras-enable-list
- (append generic-default-modes
- (if (memq system-type '(windows-nt ms-dos))
- generic-mswindows-modes
- generic-unix-modes)
- nil)
- "List of generic modes to define.
-Each entry in the list should be a symbol. If you set this variable
-directly, without using customize, you must reload generic-x to put
-your changes into effect."
- :type (let (list)
- (dolist (mode
- (sort (append generic-default-modes
- generic-mswindows-modes
- generic-unix-modes
- generic-other-modes
- nil)
- (lambda (a b)
- (string< (symbol-name b)
- (symbol-name a))))
- (cons 'set list))
- (push `(const ,mode) list)))
- :set (lambda (s v)
- (set-default s v)
- (unless load-in-progress
- (load "generic-x")))
- :version "22.1")
-(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1")
+ nil))
(provide 'generic-x)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 4249b50..34947ce 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."
(define-minor-mode gnus-message-citation-mode
"Minor mode providing more font-lock support for nested citations.
When enabled, it automatically turns on `font-lock-mode'."
- nil ;; init-value
- "" ;; lighter
- nil ;; keymap
+ :lighter ""
(when (derived-mode-p 'message-mode)
;; FIXME: Use font-lock-add-keywords!
(let ((defaults (car font-lock-defaults))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 0852f8e..e7af94f 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1102,8 +1102,6 @@ articles in the thread.
(widget-setup)
(buffer-enable-undo))))
-;;; The End:
-
(provide 'gnus-cus)
;;; gnus-cus.el ends here
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 64eb639..e2cbca9 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -32,11 +32,6 @@
;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is
;; now fully documented in the Gnus manual.
-
-;; Bugs / Todo:
-;; ===========
-
-
;;; Code:
(require 'nndiary)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 6ac646f..11b6f7d 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1298,8 +1298,6 @@ from your existing entries."
(gnus-registry-insert db k newv)))
(registry-reindex db))))
-;; TODO: a few things
-
(provide 'gnus-registry)
;;; gnus-registry.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index fad4ef3..02db387 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -120,12 +120,13 @@
:group 'message-buffers
:type 'integer)
-(defcustom message-send-rename-function nil
+(defcustom message-send-rename-function #'message-default-send-rename-function
"Function called to rename the buffer after sending it."
:group 'message-buffers
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
-(defcustom message-fcc-handler-function 'message-output
+(defcustom message-fcc-handler-function #'message-output
"A function called to save outgoing articles.
This function will be called with the name of the file to store the
article in. The default function is `message-output' which saves in Unix
@@ -186,22 +187,26 @@ Otherwise, most addresses look like `angles', but they
look like
(defcustom message-syntax-checks
(if message-insert-canlock '((sender . disabled)) nil)
- ;; Guess this one shouldn't be easy to customize...
"Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
`(signature . disabled)' to this list.
Don't touch this variable unless you really know what you're doing.
-Checks include `approved', `bogus-recipient', `continuation-headers',
-`control-chars', `empty', `existing-newsgroups', `from', `illegible-text',
-`invisible-text', `long-header-lines', `long-lines', `message-id',
-`multiple-headers', `new-text', `newsgroups', `quoting-style',
-`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
-`shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
-and `valid-newsgroups'."
- :group 'message-news
- :type '(repeat sexp)) ; Fixme: improve this
+See the Message manual for the meanings of the valid syntax check
+types."
+ :group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
+ :type '(alist
+ :key-type symbol
+ :value-type (const disabled)
+ :options (approved bogus-recipient continuation-headers
+ control-chars empty existing-newsgroups from illegible-text
+ invisible-text long-header-lines long-lines message-id
+ multiple-headers new-text newgroups quoting-style
+ repeated-newsgroups reply-to sender sendsys shoot
+ shorten-followup-to signature size subject subject-cmsg
+ valid-newsgroups)))
(defcustom message-required-headers '((optional . References)
From)
@@ -418,7 +423,7 @@ you can explicitly override this setting by calling
:type 'string
:group 'message-various)
-(defcustom message-cross-post-note-function 'message-cross-post-insert-note
+(defcustom message-cross-post-note-function #'message-cross-post-insert-note
"Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
@@ -756,7 +761,7 @@ See also `send-mail-function'."
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
-(defcustom message-send-news-function 'message-send-news
+(defcustom message-send-news-function #'message-send-news
"Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'."
@@ -765,29 +770,32 @@ variable `mail-header-separator'."
:link '(custom-manual "(message)News Variables")
:type 'function)
-(defcustom message-reply-to-function nil
+(defcustom message-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Reply")
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
-(defcustom message-wide-reply-to-function nil
+(defcustom message-wide-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Wide Reply")
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
-(defcustom message-followup-to-function nil
+(defcustom message-followup-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Followup")
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
(defcustom message-extra-wide-headers nil
"If non-nil, a list of additional address headers.
@@ -1021,7 +1029,7 @@ the signature is inserted."
:version "22.1"
:group 'message-various)
-(defcustom message-citation-line-function 'message-insert-citation-line
+(defcustom message-citation-line-function #'message-insert-citation-line
"Function called to insert the \"Whomever writes:\" line.
Predefined functions include `message-insert-citation-line' and
@@ -1103,7 +1111,7 @@ Used by `message-yank-original' via `message-yank-cite'."
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
-(defcustom message-cite-function 'message-cite-original-without-signature
+(defcustom message-cite-function #'message-cite-original-without-signature
"Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
@@ -1116,7 +1124,7 @@ Note that these functions use `mail-citation-hook' if
that is non-nil."
:version "22.3" ;; Gnus 5.10.12 (changed default)
:group 'message-insertion)
-(defcustom message-indent-citation-function 'message-indent-citation
+(defcustom message-indent-citation-function #'message-indent-citation
"Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave
@@ -2847,79 +2855,79 @@ Consider adding this function to
`message-header-setup-hook'"
(unless message-mode-map
(setq message-mode-map (make-keymap))
(set-keymap-parent message-mode-map text-mode-map)
- (define-key message-mode-map "\C-c?" 'describe-mode)
-
- (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
- (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
- (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
- (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
- (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
- (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
- (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
- (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
- (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
- (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
- (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+ (define-key message-mode-map "\C-c?" #'describe-mode)
+
+ (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to)
+ (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from)
+ (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc)
+ (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc)
+ (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc)
+ (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject)
+ (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to)
+ (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups)
+ (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution)
+ (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords)
+ (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-i"
- 'message-insert-or-toggle-importance)
+ #'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-f\C-a"
- 'message-generate-unsubscribed-mail-followup-to)
+ #'message-generate-unsubscribed-mail-followup-to)
;; modify headers (and insert notes in body)
- (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
+ (define-key message-mode-map "\C-c\C-fs" #'message-change-subject)
;;
- (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
+ (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to)
;; prefix+message-cross-post-followup-to = same w/o cross-post
- (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
- (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
+ (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc)
+ (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header)
;; mark inserted text
- (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
- (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
+ (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region)
+ (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file)
- (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
- (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+ (define-key message-mode-map "\C-c\C-b" #'message-goto-body)
+ (define-key message-mode-map "\C-c\C-i" #'message-goto-signature)
- (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
- (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
- (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
- (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
- (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
+ (define-key message-mode-map "\C-c\C-t" #'message-insert-to)
+ (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply)
+ (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups)
+ (define-key message-mode-map "\C-c\C-l" #'message-to-list-only)
+ (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires)
- (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\C-u"
#'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\M-n"
- 'message-insert-disposition-notification-to)
-
- (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
- (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
- (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
- (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
- (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
- (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
- (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
- (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
-
- (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
- (define-key message-mode-map "\C-c\C-s" 'message-send)
- (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
- (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
- (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
-
- (define-key message-mode-map "\C-c\M-k" 'message-kill-address)
- (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
- (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
- (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
- (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- (define-key message-mode-map [remap split-line] 'message-split-line)
-
- (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
- (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot)
-
- (define-key message-mode-map "\C-a" 'message-beginning-of-line)
- (define-key message-mode-map "\t" 'message-tab)
-
- (define-key message-mode-map "\M-n" 'message-display-abbrev))
+ #'message-insert-disposition-notification-to)
+
+ (define-key message-mode-map "\C-c\C-y" #'message-yank-original)
+ (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer)
+ (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message)
+ (define-key message-mode-map "\C-c\C-w" #'message-insert-signature)
+ (define-key message-mode-map "\C-c\M-h" #'message-insert-headers)
+ (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body)
+ (define-key message-mode-map "\C-c\C-o" #'message-sort-headers)
+ (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer)
+
+ (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit)
+ (define-key message-mode-map "\C-c\C-s" #'message-send)
+ (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer)
+ (define-key message-mode-map "\C-c\C-d" #'message-dont-send)
+ (define-key message-mode-map "\C-c\n" #'gnus-delay-article)
+
+ (define-key message-mode-map "\C-c\M-k" #'message-kill-address)
+ (define-key message-mode-map "\C-c\C-e" #'message-elide-region)
+ (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region)
+ (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature)
+ (define-key message-mode-map "\M-\r" #'message-newline-and-reformat)
+ (define-key message-mode-map [remap split-line] #'message-split-line)
+
+ (define-key message-mode-map "\C-c\C-a" #'mml-attach-file)
+ (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot)
+
+ (define-key message-mode-map "\C-a" #'message-beginning-of-line)
+ (define-key message-mode-map "\t" #'message-tab)
+
+ (define-key message-mode-map "\M-n" #'message-display-abbrev))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
@@ -3169,14 +3177,13 @@ Like `text-mode', but with these additional commands:
;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts.
;;
- (setq-local syntax-propertize-function 'message--syntax-propertize)
+ (setq-local syntax-propertize-function #'message--syntax-propertize)
(setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables ()
"Setup message fill variables."
(setq-local fill-paragraph-function #'message-fill-paragraph)
- (make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
@@ -3287,7 +3294,7 @@ Like `text-mode', but with these additional commands:
(push-mark)
(message-position-on-field "Summary" "Subject"))
-(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1")
+(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body
"27.1")
(defun message-goto-body (&optional interactive)
"Move point to the beginning of the message body.
Returns point."
@@ -6662,9 +6669,8 @@ moved to the beginning "
(not (buffer-modified-p buffer)))
(kill-buffer buffer))))
;; Rename the buffer.
- (if message-send-rename-function
- (funcall message-send-rename-function)
- (message-default-send-rename-function))
+ (funcall (or message-send-rename-function
+ #'message-default-send-rename-function))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
@@ -6763,8 +6769,9 @@ are not included."
(defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions)
(condition-case nil
+ ;; FIXME: Use functions rather than expressions!
(add-to-list 'message-send-actions
- `(apply ',(car action) ',(cdr action)))))
+ `(apply #',(car action) ',(cdr action)))))
(setq message-return-action return-action)
(setq message-reply-buffer
(if (and (consp yank-action)
@@ -6903,7 +6910,7 @@ are not included."
;;;###autoload
(defun message-mail (&optional to subject other-headers continue
switch-function yank-action send-actions
- return-action &rest ignored)
+ return-action &rest _)
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
@@ -7127,15 +7134,12 @@ want to get rid of this query permanently.")))
;; specific, and just Cc-in the rest.
(setq follow-to (list
(cons 'To
- (mapconcat
- (lambda (addr)
- (cdr addr)) recipients ", "))))
+ (mapconcat #'cdr recipients ", "))))
;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc.
(when recipients
- (setq recipients (mapconcat
- (lambda (addr) (cdr addr)) recipients ", "))
+ (setq recipients (mapconcat #'cdr recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))))
@@ -7862,7 +7866,7 @@ is for the internal use."
(interactive)
(setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function
- 'message-forward-rmail-make-body))
+ #'message-forward-rmail-make-body))
;;;###autoload
(defun message-resend (address)
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 56ca2e1..76a7e21 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,4 +1,3 @@
-
;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index e314e1d..5ac4c3a 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -968,7 +968,6 @@ Pass NO-PARSE on to the search engine."
(gnus-group-make-search-group no-parse spec)))
-;; The end.
(provide 'nnselect)
;;; nnselect.el ends here
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 4d02023..cbb69b2 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -1,4 +1,4 @@
-;;; hippie-exp.el --- expand text trying various ways to find its expansion
+;;; hippie-exp.el --- expand text trying various ways to find its expansion
-*- lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@@ -58,7 +58,7 @@
;; The variable `hippie-expand-dabbrev-as-symbol' controls whether
;; characters of syntax '_' is considered part of the words to expand
;; dynamically.
-;; See also the macro `make-hippie-expand-function' below.
+;; See also the function `make-hippie-expand-function' below.
;;
;; A short description of the current try-functions in this file:
;; `try-complete-file-name' : very convenient to have in any buffer,
@@ -215,50 +215,42 @@
"The list of expansion functions tried in order by `hippie-expand'.
To change the behavior of `hippie-expand', remove, change the order of,
or insert functions in this list."
- :type '(repeat function)
- :group 'hippie-expand)
+ :type '(repeat function))
(defcustom hippie-expand-verbose t
"Non-nil makes `hippie-expand' output which function it is trying."
- :type 'boolean
- :group 'hippie-expand)
+ :type 'boolean)
(defcustom hippie-expand-dabbrev-skip-space nil
"Non-nil means tolerate trailing spaces in the abbreviation to expand."
- :group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-dabbrev-as-symbol t
"Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
- :group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-no-restriction t
"Non-nil means that narrowed buffers are widened during search."
- :group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-max-buffers ()
"The maximum number of buffers (apart from the current) searched.
If nil, all buffers are searched."
:type '(choice (const :tag "All" nil)
- integer)
- :group 'hippie-expand)
+ integer))
(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
"A list specifying which buffers not to search (if not current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms)."
- :type '(repeat (choice regexp (symbol :tag "Major Mode")))
- :group 'hippie-expand)
+ :type '(repeat (choice regexp (symbol :tag "Major Mode"))))
(defcustom hippie-expand-only-buffers ()
"A list specifying the only buffers to search (in addition to current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms). If non-nil, this variable overrides the variable
`hippie-expand-ignore-buffers'."
- :type '(repeat (choice regexp (symbol :tag "Major Mode")))
- :group 'hippie-expand)
+ :type '(repeat (choice regexp (symbol :tag "Major Mode"))))
;;;###autoload
(defun hippie-expand (arg)
@@ -407,18 +399,19 @@ undoes the expansion."
;; try-expand-line-all-buffers)))
;;
;;;###autoload
-(defmacro make-hippie-expand-function (try-list &optional verbose)
+(defun make-hippie-expand-function (try-list &optional verbose)
"Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose."
- `(lambda (arg)
- ,(concat
- "Try to expand text before point, using the following functions: \n"
- (mapconcat 'prin1-to-string (eval try-list) ", "))
- (interactive "P")
- (let ((hippie-expand-try-functions-list ,try-list)
- (hippie-expand-verbose ,verbose))
- (hippie-expand arg))))
+ (lambda (arg)
+ (:documentation
+ (concat
+ "Try to expand text before point, using the following functions: \n"
+ (mapconcat #'prin1-to-string try-list ", ")))
+ (interactive "P")
+ (let ((hippie-expand-try-functions-list try-list)
+ (hippie-expand-verbose verbose))
+ (hippie-expand arg))))
;;; Here follows the try-functions and their requisites:
@@ -434,7 +427,8 @@ string). It returns t if a new completion is found, nil
otherwise."
(he-init-string (he-file-name-beg) (point))
(let ((name-part (file-name-nondirectory he-search-string))
(dir-part (expand-file-name (or (file-name-directory
- he-search-string) ""))))
+ he-search-string)
+ ""))))
(if (not (he-string-member name-part he-tried-table))
(setq he-tried-table (cons name-part he-tried-table)))
(if (and (not (equal he-search-string ""))
@@ -442,7 +436,7 @@ string). It returns t if a new completion is found, nil
otherwise."
(setq he-expand-list (sort (file-name-all-completions
name-part
dir-part)
- 'string-lessp))
+ #'string-lessp))
(setq he-expand-list ())))))
(while (and he-expand-list
@@ -538,7 +532,7 @@ string). It returns t if a new completion is found, nil
otherwise."
(or (boundp sym)
(fboundp sym)
(symbol-plist sym))))
- 'string-lessp)))))
+ #'string-lessp)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
(setq he-expand-list (cdr he-expand-list)))
@@ -822,9 +816,10 @@ string). It returns t if a new expansion is found, nil
otherwise."
(setq he-expand-list
(and (not (equal he-search-string ""))
(mapcar (lambda (sym)
- (if (and (boundp sym) (vectorp (eval sym)))
+ (if (and (boundp sym)
+ (abbrev-table-p (symbol-value sym)))
(abbrev-expansion (downcase he-search-string)
- (eval sym))))
+ (symbol-value sym))))
(append '(local-abbrev-table
global-abbrev-table)
abbrev-table-name-list))))))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 44574ab..1dc8acb 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -402,7 +402,7 @@ format. See `ibuffer-update-saved-filters-format' and
;;;###autoload
(define-minor-mode ibuffer-auto-mode
"Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)."
- nil nil nil
+ :lighter nil
(unless (derived-mode-p 'ibuffer-mode)
(error "This buffer is not in Ibuffer mode"))
(cond (ibuffer-auto-mode
@@ -687,8 +687,8 @@ specifications with the same structure as
`ibuffer-filtering-qualifiers'."
(not
(memq nil ;; a filter will return nil if it failed
- (mapcar #'(lambda (filter)
- (ibuffer-included-in-filter-p buf filter))
+ (mapcar (lambda (filter)
+ (ibuffer-included-in-filter-p buf filter))
filters))))
(defun ibuffer-unary-operand (filter)
@@ -724,8 +724,8 @@ specification, with the same structure as an element of the
list
;; (dolist (filter-spec (cdr filter) nil)
;; (when (ibuffer-included-in-filter-p buf filter-spec)
;; (throw 'has-match t))))
- (memq t (mapcar #'(lambda (x)
- (ibuffer-included-in-filter-p buf x))
+ (memq t (mapcar (lambda (x)
+ (ibuffer-included-in-filter-p buf x))
(cdr filter))))
('and
(catch 'no-match
@@ -1589,8 +1589,8 @@ to move by. The default is `ibuffer-marked-char'."
(message "No buffers marked; use `m' to mark a buffer")
(let ((count
(ibuffer-map-marked-lines
- #'(lambda (_buf _mark)
- 'kill))))
+ (lambda (_buf _mark)
+ 'kill))))
(message "Killed %s lines" count))))
;;;###autoload
@@ -1609,8 +1609,8 @@ a prefix argument reverses the meaning of that variable."
(when current-prefix-arg
(setq only-visible (not only-visible)))
(if only-visible
- (let ((table (mapcar #'(lambda (x)
- (buffer-name (car x)))
+ (let ((table (mapcar (lambda (x)
+ (buffer-name (car x)))
(ibuffer-current-state-list))))
(when (null table)
(error "No buffers!"))
@@ -1621,10 +1621,10 @@ a prefix argument reverses the meaning of that
variable."
(let (buf-point)
;; Blindly search for our buffer: it is very likely that it is
;; not in a hidden filter group.
- (ibuffer-map-lines #'(lambda (buf _marks)
- (when (string= (buffer-name buf) name)
- (setq buf-point (point))
- nil))
+ (ibuffer-map-lines (lambda (buf _marks)
+ (when (string= (buffer-name buf) name)
+ (setq buf-point (point))
+ nil))
t nil)
(when (and
(null buf-point)
@@ -1635,10 +1635,10 @@ a prefix argument reverses the meaning of that
variable."
(dolist (group ibuffer-hidden-filter-groups)
(ibuffer-jump-to-filter-group group)
(ibuffer-toggle-filter-group)
- (ibuffer-map-lines #'(lambda (buf _marks)
- (when (string= (buffer-name buf) name)
- (setq buf-point (point))
- nil))
+ (ibuffer-map-lines (lambda (buf _marks)
+ (when (string= (buffer-name buf) name)
+ (setq buf-point (point))
+ nil))
t group)
(if buf-point
(throw 'found nil)
@@ -1775,11 +1775,11 @@ You can then feed the file name(s) to other commands
with \\[yank]."
(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark
group)
(let ((count
(ibuffer-map-lines
- #'(lambda (buf _mark)
- (when (funcall func buf)
- (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
- ibuffer-marked-char))
- t))
+ (lambda (buf _mark)
+ (when (funcall func buf)
+ (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
+ ibuffer-marked-char))
+ t))
nil
group)))
(ibuffer-redisplay t)
@@ -1791,8 +1791,8 @@ You can then feed the file name(s) to other commands with
\\[yank]."
"Mark all buffers whose name matches REGEXP."
(interactive "sMark by name (regexp): ")
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (string-match regexp (buffer-name buf)))))
+ (lambda (buf)
+ (string-match regexp (buffer-name buf)))))
(defun ibuffer-locked-buffer-p (&optional buf)
"Return non-nil if BUF is locked.
@@ -1816,9 +1816,9 @@ When BUF nil, default to the buffer at current line."
"Mark all buffers whose major mode matches REGEXP."
(interactive "sMark by major mode (regexp): ")
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (string-match regexp (format-mode-line mode-name nil nil buf))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (string-match regexp (format-mode-line mode-name nil nil buf))))))
;;;###autoload
(defun ibuffer-mark-by-file-name-regexp (regexp)
@@ -1840,21 +1840,21 @@ Otherwise buffers whose name matches an element of
(interactive (let ((reg (read-string "Mark by content (regexp): ")))
(list reg current-prefix-arg)))
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (let ((mode (with-current-buffer buf major-mode))
- res)
- (cond ((and (not all-buffers)
- (or
- (memq mode ibuffer-never-search-content-mode)
- (cl-dolist (x ibuffer-never-search-content-name nil)
- (when-let ((found (string-match x (buffer-name buf))))
- (cl-return found)))))
- (setq res nil))
- (t
- (with-current-buffer buf
- (save-mark-and-excursion
- (goto-char (point-min))
- (setq res (re-search-forward regexp nil t)))))) res))))
+ (lambda (buf)
+ (let ((mode (with-current-buffer buf major-mode))
+ res)
+ (cond ((and (not all-buffers)
+ (or
+ (memq mode ibuffer-never-search-content-mode)
+ (cl-dolist (x ibuffer-never-search-content-name nil)
+ (when-let ((found (string-match x (buffer-name buf))))
+ (cl-return found)))))
+ (setq res nil))
+ (t
+ (with-current-buffer buf
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (setq res (re-search-forward regexp nil t)))))) res))))
;;;###autoload
(defun ibuffer-mark-by-mode (mode)
@@ -1869,92 +1869,92 @@ Otherwise buffers whose name matches an element of
(format-prompt "Mark by major mode" default)
(ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (eq (buffer-local-value 'major-mode buf) mode))))
+ (lambda (buf)
+ (eq (buffer-local-value 'major-mode buf) mode))))
;;;###autoload
(defun ibuffer-mark-modified-buffers ()
"Mark all modified buffers."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (buffer-modified-p buf))))
+ (lambda (buf) (buffer-modified-p buf))))
;;;###autoload
(defun ibuffer-mark-unsaved-buffers ()
"Mark all modified buffers that have an associated file."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
- (buffer-modified-p buf)))))
+ (lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
+ (buffer-modified-p buf)))))
;;;###autoload
(defun ibuffer-mark-dissociated-buffers ()
"Mark all buffers whose associated file does not exist."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (or
- (and buffer-file-name
- (not (file-exists-p buffer-file-name)))
- (and (eq major-mode 'dired-mode)
- (boundp 'dired-directory)
- (stringp dired-directory)
- (not (file-exists-p (file-name-directory dired-directory)))))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (or
+ (and buffer-file-name
+ (not (file-exists-p buffer-file-name)))
+ (and (eq major-mode 'dired-mode)
+ (boundp 'dired-directory)
+ (stringp dired-directory)
+ (not (file-exists-p (file-name-directory dired-directory)))))))))
;;;###autoload
(defun ibuffer-mark-help-buffers ()
"Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (memq major-mode ibuffer-help-buffer-modes)))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (memq major-mode ibuffer-help-buffer-modes)))))
;;;###autoload
(defun ibuffer-mark-compressed-file-buffers ()
"Mark buffers whose associated file is compressed."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (and buffer-file-name
- (string-match ibuffer-compressed-file-name-regexp
- buffer-file-name))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (and buffer-file-name
+ (string-match ibuffer-compressed-file-name-regexp
+ buffer-file-name))))))
;;;###autoload
(defun ibuffer-mark-old-buffers ()
"Mark buffers which have not been viewed in `ibuffer-old-time' hours."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (when buffer-display-time
- (time-less-p
- (* 60 60 ibuffer-old-time)
- (time-since buffer-display-time)))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (when buffer-display-time
+ (time-less-p
+ (* 60 60 ibuffer-old-time)
+ (time-since buffer-display-time)))))))
;;;###autoload
(defun ibuffer-mark-special-buffers ()
"Mark all buffers whose name begins and ends with `*'."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (string-match "^\\*.+\\*$"
- (buffer-name buf)))))
+ (lambda (buf) (string-match "^\\*.+\\*$"
+ (buffer-name buf)))))
;;;###autoload
(defun ibuffer-mark-read-only-buffers ()
"Mark all read-only buffers."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
+ (lambda (buf) (buffer-local-value 'buffer-read-only buf))))
;;;###autoload
(defun ibuffer-mark-dired-buffers ()
"Mark all `dired' buffers."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
+ (lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
;;;###autoload
(defun ibuffer-do-occur (regexp &optional nlines)
@@ -1970,8 +1970,8 @@ defaults to one."
(let ((ibuffer-do-occur-bufs nil))
;; Accumulate a list of marked buffers
(ibuffer-map-marked-lines
- #'(lambda (buf _mark)
- (push buf ibuffer-do-occur-bufs)))
+ (lambda (buf _mark)
+ (push buf ibuffer-do-occur-bufs)))
(occur-1 regexp nlines ibuffer-do-occur-bufs)))
(provide 'ibuf-ext)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index be09c65..fcc4f9e 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."
(ibuffer-redisplay-engine
;; Get rid of dead buffers
(delq nil
- (mapcar #'(lambda (e) (when (buffer-live-p (car e))
- e))
+ (mapcar (lambda (e) (when (buffer-live-p (car e))
+ e))
ibuffer-save-marks-tmp-mark-list)))
(ibuffer-redisplay t))))))
@@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'.
(ibuffer-redisplay t)
(setq ibuffer-last-sorting-mode ',name))
(push (list ',name ,description
- #'(lambda (a b)
- ,@body))
+ (lambda (a b)
+ ,@body))
ibuffer-sorting-functions-alist)
:autoload-end))
@@ -259,18 +259,18 @@ buffer object.
'ibuffer-map-deletion-lines)
(_
'ibuffer-map-marked-lines))
- #'(lambda (buf mark)
- ;; Silence warning for code that doesn't
- ;; use `mark'.
- (ignore mark)
- ,(if (eq modifier-p :maybe)
- `(let
((ibuffer-tmp-previous-buffer-modification
- (buffer-modified-p buf)))
- (prog1 ,inner-body
- (when (not (eq
ibuffer-tmp-previous-buffer-modification
- (buffer-modified-p
buf)))
- (setq ibuffer-did-modification
t))))
- inner-body)))))
+ (lambda (buf mark)
+ ;; Silence warning for code that doesn't
+ ;; use `mark'.
+ (ignore mark)
+ ,(if (eq modifier-p :maybe)
+ `(let
((ibuffer-tmp-previous-buffer-modification
+ (buffer-modified-p buf)))
+ (prog1 ,inner-body
+ (when (not (eq
ibuffer-tmp-previous-buffer-modification
+ (buffer-modified-p
buf)))
+ (setq ibuffer-did-modification
t))))
+ inner-body)))))
,finish)))
(if dangerous
`(when (ibuffer-confirm-operation-on ,active-opstring
marked-names)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index da589c0..91bbb60 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -562,6 +562,37 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(completion--cache-all-sorted-completions beg end (cons comp
all))))
finally return all)))
+(defvar icomplete-vertical-mode-minibuffer-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-n") 'icomplete-forward-completions)
+ (define-key map (kbd "C-p") 'icomplete-backward-completions)
+ map)
+ "Keymap used by `icomplete-vertical-mode' in the minibuffer.")
+
+(defun icomplete--vertical-minibuffer-setup ()
+ "Setup the minibuffer for vertical display of completion candidates."
+ (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map
+ (current-local-map)))
+ (setq-local icomplete-separator "\n"
+ icomplete-hide-common-prefix nil
+ ;; Ask `icomplete-completions' to return enough completions
candidates.
+ icomplete-prospects-height 25
+ redisplay-adhoc-scroll-in-resize-mini-windows nil))
+
+;;;###autoload
+(define-minor-mode icomplete-vertical-mode
+ "Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
+
+As many completion candidates as possible are displayed, depending on
+the value of `max-mini-window-height', and the way the mini-window is
+resized depends on `resize-mini-windows'."
+ :global t
+ (remove-hook 'icomplete-minibuffer-setup-hook
+ #'icomplete--vertical-minibuffer-setup)
+ (when icomplete-vertical-mode
+ (add-hook 'icomplete-minibuffer-setup-hook
+ #'icomplete--vertical-minibuffer-setup)))
+
@@ -784,10 +815,13 @@ matches exist."
(if last (setcdr last base-size))
(if prospects
(concat determ
- "{"
- (mapconcat 'identity prospects icomplete-separator)
- (and limit (concat icomplete-separator ellipsis))
- "}")
+ (if icomplete-vertical-mode " \n" "{")
+ (mapconcat 'identity prospects (if icomplete-vertical-mode
+ "\n"
+ icomplete-separator))
+ (unless icomplete-vertical-mode
+ (concat (and limit (concat icomplete-separator ellipsis))
+ "}")))
(concat determ " [Matched]"))))))
;;; Iswitchb compatibility
@@ -803,7 +837,6 @@ matches exist."
;;;###autoload (make-obsolete 'iswitchb-mode
;;;###autoload "use `icomplete-mode' or `ido-mode' instead." "24.4"))
-;;;_* Provide
(provide 'icomplete)
;;_* Local emacs vars.
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 2de16cb..69ef701 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -713,8 +713,7 @@ Key bindings:
Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
to switch back to `image-mode' and display an image file as the
actual image."
- nil (:eval (if image-type (format " Image[%s]" image-type) " Image"))
- image-minor-mode-map
+ :lighter (:eval (if image-type (format " Image[%s]" image-type) " Image"))
:group 'image
:version "22.1"
(if image-minor-mode
@@ -732,8 +731,9 @@ displays an image file as text."
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
(image-minor-mode 1)
- ;; Show the image file as text.
- (image-toggle-display-text)))
+ (unless (image-get-display-property)
+ ;; Show the image file as text.
+ (image-toggle-display-text))))
(defun image-mode-as-hex ()
"Set a non-image mode as major mode in combination with image minor mode.
diff --git a/lisp/informat.el b/lisp/informat.el
index 3da2351..bac0975 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,4 +1,4 @@
-;;; informat.el --- info support functions package for Emacs
+;;; informat.el --- info support functions package for Emacs -*-
lexical-binding: t; -*-
;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc.
@@ -140,7 +140,7 @@
(or (bolp)
(newline))
(insert "\^_\f\nTag table:\n")
- (if (eq major-mode 'info-mode)
+ (if (derived-mode-p 'info-mode)
(move-marker Info-tag-table-marker (point)))
(setq tag-list (nreverse tag-list))
(while tag-list
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 3be7849..793508ca 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -323,11 +323,9 @@
(insert ")\n\n")))
(defun skkdic-convert (filename &optional dirname)
- "Generate Emacs Lisp file form Japanese dictionary file FILENAME.
+ "Generate Emacs Lisp file from Japanese dictionary file FILENAME.
The format of the dictionary file should be the same as SKK dictionaries.
-Optional argument DIRNAME if specified is the directory name under which
-the generated Emacs Lisp is saved.
-The name of generated file is specified by the variable `ja-dic-filename'."
+Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
(interactive "FSKK dictionary file: ")
(let* ((skkbuf (get-buffer-create " *skkdic-unannotated*"))
(buf (get-buffer-create "*skkdic-work*")))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 943e24a..69fdc9d 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -172,6 +172,29 @@ This allows you to resume earlier Isearch sessions through
the
command history."
:type 'boolean)
+(defcustom isearch-wrap-pause t
+ "Define the behavior of wrapping when there are no more matches.
+When `t' (by default), signal an error when no more matches are found.
+Then after repeating the search, wrap with `isearch-wrap-function'.
+When `no', wrap immediately after reaching the last match.
+When `no-ding', wrap immediately without flashing the screen.
+When `nil', never wrap, just stop at the last match."
+ :type '(choice (const :tag "Pause before wrapping" t)
+ (const :tag "No pause before wrapping" no)
+ (const :tag "No pause and no flashing" no-ding)
+ (const :tag "Disable wrapping" nil))
+ :version "28.1")
+
+(defcustom isearch-repeat-on-direction-change nil
+ "Whether a direction change should move to another match.
+When `nil', the default, a direction change moves point to the other
+end of the current search match.
+When `t', a direction change moves to another search match, if there
+is one."
+ :type '(choice (const :tag "Remain on the same match" nil)
+ (const :tag "Move to another match" t))
+ :version "28.1")
+
(defvar isearch-mode-hook nil
"Function(s) to call after starting up an incremental search.")
@@ -1827,14 +1850,15 @@ Use `isearch-exit' to quit without signaling."
;; After taking the last element, adjust ring to previous one.
(isearch-ring-adjust1 nil))
;; If already have what to search for, repeat it.
- (or isearch-success
- (progn
- ;; Set isearch-wrapped before calling isearch-wrap-function
- (setq isearch-wrapped t)
- (if isearch-wrap-function
- (funcall isearch-wrap-function)
- (goto-char (if isearch-forward (point-min) (point-max)))))))
+ (unless (or isearch-success (null isearch-wrap-pause))
+ ;; Set isearch-wrapped before calling isearch-wrap-function
+ (setq isearch-wrapped t)
+ (if isearch-wrap-function
+ (funcall isearch-wrap-function)
+ (goto-char (if isearch-forward (point-min) (point-max))))))
;; C-s in reverse or C-r in forward, change direction.
+ (if (and isearch-other-end isearch-repeat-on-direction-change)
+ (goto-char isearch-other-end))
(setq isearch-forward (not isearch-forward)
isearch-success t))
@@ -1844,7 +1868,8 @@ Use `isearch-exit' to quit without signaling."
(setq isearch-success t)
;; For the case when count > 1, don't keep intermediate states
;; added to isearch-cmds by isearch-push-state in this loop.
- (let ((isearch-cmds isearch-cmds))
+ (let ((isearch-cmds isearch-cmds)
+ (was-success isearch-success))
(while (<= 0 (setq count (1- (or count 1))))
(if (and isearch-success
(equal (point) isearch-other-end)
@@ -1859,13 +1884,26 @@ Use `isearch-exit' to quit without signaling."
(forward-char (if isearch-forward 1 -1))
(isearch-search))
(isearch-search))
- (when (> count 0)
- ;; Update isearch-cmds, so if isearch-search fails later,
- ;; it can restore old successful state from isearch-cmds.
- (isearch-push-state))
- ;; Stop looping on failure.
- (when (or (not isearch-success) isearch-error)
- (setq count 0)))))
+ (when (> count 0)
+ ;; Update isearch-cmds, so if isearch-search fails later,
+ ;; it can restore old successful state from isearch-cmds.
+ (isearch-push-state))
+ (cond
+ ;; Wrap immediately and repeat the search again
+ ((memq isearch-wrap-pause '(no no-ding))
+ (if isearch-success
+ (setq was-success isearch-success)
+ ;; If failed this time after succeeding last time
+ (when was-success
+ (setq was-success nil)
+ (setq count (1+ count)) ;; Increment to force repeat
+ (setq isearch-wrapped t)
+ (if isearch-wrap-function
+ (funcall isearch-wrap-function)
+ (goto-char (if isearch-forward (point-min) (point-max)))))))
+ ;; Stop looping on failure
+ (t (when (or (not isearch-success) isearch-error)
+ (setq count 0)))))))
(isearch-push-state)
(isearch-update))
@@ -1884,10 +1922,12 @@ of the buffer, type \\[isearch-beginning-of-buffer]
with a numeric argument."
(cond ((< count 0)
(isearch-repeat-backward (abs count))
;; Reverse the direction back
- (isearch-repeat 'forward))
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat 'forward)))
(t
;; Take into account one iteration to reverse direction
- (when (not isearch-forward) (setq count (1+ count)))
+ (unless isearch-repeat-on-direction-change
+ (when (not isearch-forward) (setq count (1+ count))))
(isearch-repeat 'forward count))))
(isearch-repeat 'forward)))
@@ -1905,10 +1945,12 @@ of the buffer, type \\[isearch-end-of-buffer] with a
numeric argument."
(cond ((< count 0)
(isearch-repeat-forward (abs count))
;; Reverse the direction back
- (isearch-repeat 'backward))
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat 'backward)))
(t
;; Take into account one iteration to reverse direction
- (when isearch-forward (setq count (1+ count)))
+ (unless isearch-repeat-on-direction-change
+ (when isearch-forward (setq count (1+ count))))
(isearch-repeat 'backward count))))
(isearch-repeat 'backward)))
@@ -2519,7 +2561,9 @@ Otherwise invoke whatever the calling mouse-2 command
sequence
is bound to outside of Isearch."
(interactive "e")
(let ((w (posn-window (event-start click)))
- (binding (let ((overriding-terminal-local-map nil))
+ (binding (let ((overriding-terminal-local-map nil)
+ ;; Key search depends on mode (bug#47755)
+ (isearch-mode nil))
(key-binding (this-command-keys-vector) t))))
(if (and (window-minibuffer-p w)
(not (minibuffer-window-active-p w))) ; in echo area
@@ -3012,6 +3056,10 @@ See more for options in `search-exit-option'."
(goto-char isearch-pre-move-point))
(isearch-search-and-update)))
(setq isearch-pre-move-point nil))
+ ;; Terminate the search if point has moved to another buffer.
+ (unless (eq isearch--current-buffer (current-buffer))
+ (when (buffer-live-p isearch--current-buffer)
+ (with-current-buffer isearch--current-buffer (isearch-exit))))
(force-mode-line-update))
(defun isearch-quote-char (&optional count)
@@ -3488,10 +3536,10 @@ Optional third argument, if t, means if fail just
return nil (no error).
;; stack overflow in regexp search.
(setq isearch-error (format "%s" lossage))))
- (if isearch-success
- nil
+ (unless isearch-success
;; Ding if failed this time after succeeding last time.
(and (isearch--state-success (car isearch-cmds))
+ (not (eq isearch-wrap-pause 'no-ding))
(ding))
(if (functionp (isearch--state-pop-fun (car isearch-cmds)))
(funcall (isearch--state-pop-fun (car isearch-cmds))
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 8aebcd0..a622364 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,7 +1,6 @@
-;;; jka-compr.el --- reading/writing/loading compressed files
+;;; jka-compr.el --- reading/writing/loading compressed files -*-
lexical-binding: t; -*-
-;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
;; Author: Jay K. Adams <jka@ece.cmu.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -120,7 +119,7 @@ data appears to be compressed already.")
(widen) (erase-buffer)
(insert (format "Error while executing \"%s %s < %s\"\n\n"
prog
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
infile))
(and errfile
@@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning."
(format
"%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s"
prog
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
err-file
jka-compr-dd-program
jka-compr-dd-blocksize
@@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning."
"-c"
(format "%s %s 2> %s %s"
prog
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
err-file
(if (stringp output)
(concat "> " output)
@@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning."
(jka-compr-error prog args infile message err-file))
(delete-file err-file)))
(or (eq 0
- (apply 'call-process
+ (apply #'call-process
prog infile (if (stringp output) temp output)
nil args))
(jka-compr-error prog args infile message))
@@ -622,12 +621,12 @@ There should be no more than seven characters after the
final `/'."
(substring file 0 (string-match (jka-compr-info-regexp info) file)))
file)))
-(put 'write-region 'jka-compr 'jka-compr-write-region)
-(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
-(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
-(put 'load 'jka-compr 'jka-compr-load)
+(put 'write-region 'jka-compr #'jka-compr-write-region)
+(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents)
+(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy)
+(put 'load 'jka-compr #'jka-compr-load)
(put 'byte-compiler-base-file-name 'jka-compr
- 'jka-compr-byte-compiler-base-file-name)
+ #'jka-compr-byte-compiler-base-file-name)
;;;###autoload
(defvar jka-compr-inhibit nil
@@ -649,7 +648,7 @@ It is not recommended to set this variable permanently to
anything but nil.")
;; to prevent the primitive from calling our handler again.
(defun jka-compr-run-real-handler (operation args)
(let ((inhibit-file-name-handlers
- (cons 'jka-compr-handler
+ (cons #'jka-compr-handler
(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
@@ -674,7 +673,7 @@ by `jka-compr-installed'."
(last fnha))
(while (cdr last)
- (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
+ (if (eq (cdr (car (cdr last))) #'jka-compr-handler)
(setcdr last (cdr (cdr last)))
(setq last (cdr last))))
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index ff1e802..7a09bc3 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -11074,4 +11074,4 @@ With argument, do this that many times."
;; coding: utf-8
;; End:
-;; end of thai-word.el
+;; thai-word.el ends here
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 59c002d..0b12bda 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,4 +1,4 @@
-;;; loadhist.el --- lisp functions for working with feature groups
+;;; loadhist.el --- lisp functions for working with feature groups -*-
lexical-binding: t -*-
;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc.
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 617d29c..cbd740a 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,4 +1,4 @@
-;;; loadup.el --- load up standardly loaded Lisp files for Emacs
+;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*-
lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -112,7 +112,7 @@
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
- (setq purify-flag (make-hash-table :test 'equal :size 80000)))
+ (setq purify-flag (make-hash-table :test #'equal :size 80000)))
(message "Using load-path %s" load-path)
@@ -134,7 +134,7 @@
;; Do it after subr, since both after-load-functions and add-hook are
;; implemented in subr.el.
-(add-hook 'after-load-functions (lambda (f) (garbage-collect)))
+(add-hook 'after-load-functions (lambda (_) (garbage-collect)))
(load "version")
@@ -151,7 +151,7 @@
;; variable its advertised default value (it starts as nil, see
;; xdisp.c).
(setq resize-mini-windows 'grow-only)
-(setq load-source-file-function 'load-with-code-conversion)
+(setq load-source-file-function #'load-with-code-conversion)
(load "files")
;; Load-time macro-expansion can only take effect after setting
@@ -186,7 +186,7 @@
;; In case loaddefs hasn't been generated yet.
(file-error (load "ldefs-boot.el")))
-(let ((new (make-hash-table :test 'equal)))
+(let ((new (make-hash-table :test #'equal)))
;; Now that loaddefs has populated definition-prefixes, purify its contents.
(maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
definition-prefixes)
@@ -406,7 +406,7 @@ lost after dumping")))
emacs-repository-branch (ignore-errors
(emacs-repository-get-branch)))
;; A constant, so we shouldn't change it with `setq'.
(defconst emacs-build-number
- (if versions (1+ (apply 'max versions)) 1))))
+ (if versions (1+ (apply #'max versions)) 1))))
(message "Finding pointers to doc strings...")
@@ -436,11 +436,11 @@ lost after dumping")))
;; We keep the load-history data in PURE space.
;; Make sure that the spine of the list is not in pure space because it can
;; be destructively mutated in lread.c:build_load_history.
-(setq load-history (mapcar 'purecopy load-history))
+(setq load-history (mapcar #'purecopy load-history))
(set-buffer-modified-p nil)
-(remove-hook 'after-load-functions (lambda (f) (garbage-collect)))
+(remove-hook 'after-load-functions (lambda (_) (garbage-collect)))
(if (boundp 'load--prefer-newer)
(progn
@@ -547,7 +547,7 @@ lost after dumping")))
;; Otherwise, it breaks a lot of code which does things like
;; (or load-file-name byte-compile-current-file).
(setq load-file-name nil)
-(eval top-level)
+(eval top-level t)
;; Local Variables:
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 3721e86..24d49ea 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -28,7 +28,7 @@
;; OVERVIEW ==========================================================
;; This file advises the function `insert-directory' to implement it
-;; directly from Emacs lisp, without running ls in a subprocess.
+;; directly from Emacs Lisp, without running ls in a subprocess.
;; This is useful if you don't have ls installed (ie, on MS Windows).
;; This function can use regexps instead of shell wildcards. If you
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index cdb994a..e08500a 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'.
By default, this displays text and multipart messages, and offers to
download attachments as specified by `rmail-mime-attachment-dirs-alist'.
The arguments ARG and STATE have no effect in this case."
- (interactive (list current-prefix-arg nil))
+ (interactive)
(if rmail-enable-mime
(with-current-buffer rmail-buffer
(if (or (rmail-mime-message-p)
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index dd953ee..8fdcf3c 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -36,8 +36,6 @@
;; because it's pointless to compile a file full of macros. But we
;; kept the name.
-;;; Change Log:
-
;;; Code:
(require 'cl-lib)
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 67c019a..415e984 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index a32f61c..ef21fdb 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
;; The names of ephemeral buffers have a " *mh-" prefix (so that they
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index c1cd6c1..b64bbfb 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -29,8 +29,6 @@
;; that are used to send the mail. Other that those, functions that
;; are needed in mh-letter.el should be found there.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 0363c5a..ade80e8 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -23,8 +23,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
;; This is a good place to gather code that is used for compatibility
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 2e28806..ce77f9c 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -25,8 +25,6 @@
;; Mode for browsing folders
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 38ba431..0e5ffc9 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -30,8 +30,6 @@
;; small support routines are needed, place them with the function;
;; otherwise, create a separate section for them.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index ac46cc6..cc60f7b 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index aeab049..ceede0d 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -33,8 +33,6 @@
;; in MH-Letter mode. The command `mh-insert-identity' can be used
;; to manually insert an identity.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 6a29195..83cfe4f 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -28,8 +28,6 @@
;; inc can also be used to incorporate mail from multiple spool files
;; into separate folders. See "C-h v mh-inc-spool-list".
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 5a40794..e50bf8d 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -26,8 +26,6 @@
;; Spam handling in MH-E.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 5979018..ae5b80d 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -31,8 +31,6 @@
;; mh-utils.el. That will help prevent the loading of this file until
;; a message is actually composed.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index 08f1b40..39cf7c5 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -25,8 +25,6 @@
;; "Poor man's threading" by psg.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index fec2293..ef70252 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -36,8 +36,6 @@
;; MIME option to mh-forward command to move to content-description
;; insertion point.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index d084cf6..2074ff6 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index f00ab22..1504979 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -27,8 +27,6 @@
;; This file contains constants and a few functions for interpreting
;; scan lines.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index aece03e..9df7c32 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -39,8 +39,6 @@
;; documentation will direct you to the specific instructions for
;; your particular searcher.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -274,23 +272,23 @@ folder containing the index search results."
t)))
;; Copy the search results over.
- (maphash #'(lambda (folder msgs)
- (let ((cur (car (mh-translate-range folder "cur")))
- (msgs (sort (cl-loop
- for msg being the hash-keys of msgs
- collect msg)
- #'<)))
- (mh-exec-cmd "refile" msgs "-src" folder
- "-link" index-folder)
- ;; Restore cur to old value, that refile changed
- (when cur
- (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
- "-sequence"
- "cur" (format "%s" cur)))
- (cl-loop for msg in msgs
- do (cl-incf result-count)
- (setf (gethash result-count origin-map)
- (cons folder msg)))))
+ (maphash (lambda (folder msgs)
+ (let ((cur (car (mh-translate-range folder "cur")))
+ (msgs (sort (cl-loop
+ for msg being the hash-keys of msgs
+ collect msg)
+ #'<)))
+ (mh-exec-cmd "refile" msgs "-src" folder
+ "-link" index-folder)
+ ;; Restore cur to old value, that refile changed
+ (when cur
+ (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
+ "-sequence"
+ "cur" (format "%s" cur)))
+ (cl-loop for msg in msgs
+ do (cl-incf result-count)
+ (setf (gethash result-count origin-map)
+ (cons folder msg)))))
folder-results-map)
;; Vist the results folder.
@@ -1136,10 +1134,10 @@ REGEXP-LIST is an alist of fields and values."
((atom (cadr expr)) `(or (and ,expr)))
((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
- `(or ,@(mapcar #'(lambda (x) `(not ,x))
+ `(or ,@(mapcar (lambda (x) `(not ,x))
(cdadr expr)))))
((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
- `(and ,@(mapcar #'(lambda (x) `(not ,x))
+ `(and ,@(mapcar (lambda (x) `(not ,x))
(cdadr expr)))))
(t (error "Unreachable: %s" expr))))
@@ -1620,7 +1618,7 @@ garbled."
(cl-loop for seq in seq-list
do (apply #'mh-exec-cmd "mark" mh-current-folder
"-sequence" (symbol-name (car seq)) "-add"
- (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
+ (mapcar (lambda (x) (format "%s" x)) (cdr seq))))))
;;;###mh-autoload
(defun mh-create-sequence-map (seq-list)
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 9b9675c..9cdf39f 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -26,8 +26,6 @@
;; Sequences are stored in the alist `mh-seq-list' in the form:
;; ((seq-name msgs ...) (seq-name msgs ...) ...)
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index cb9819f..aa97f5c 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -26,8 +26,6 @@
;; Mode for showing messages.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -187,7 +185,7 @@ Sets the current buffer to the show buffer."
(set-buffer folder)
;; When Gnus uses external displayers it has to keep handles longer. So
;; we will delete these handles when mh-quit is called on the folder. It
- ;; would be nicer if there are weak pointers in emacs lisp, then we could
+ ;; would be nicer if there are weak pointers in Emacs Lisp, then we could
;; get the garbage collector to do this for us.
(unless (mh-buffer-data)
(setf (mh-buffer-data) (mh-make-buffer-data)))
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index b2deacf..3af840c 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -26,8 +26,6 @@
;; Future versions should only use flists.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index a7878aa..89b0dbd 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -69,8 +69,6 @@
;; (5) Better canonicalizing for message identifier and subject
;; strings.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -233,7 +231,7 @@ sibling."
(push index msg-list)))
(forward-line))
(mh-scan-folder mh-current-folder
- (mapcar #'(lambda (x) (format "%s" x))
+ (mapcar (lambda (x) (format "%s" x))
(mh-coalesce-msg-list msg-list))
t))
(when mh-index-data
@@ -591,7 +589,7 @@ Only information about messages in MSG-LIST are added to
the tree."
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
"-width" "10000" "-format"
"%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
- folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
+ folder (mapcar (lambda (x) (format "%s" x)) msg-list)))
(goto-char (point-min))
(let ((roots ())
(case-fold-search t))
@@ -635,9 +633,9 @@ Only information about messages in MSG-LIST are added to
the tree."
(mh-thread-remove-parent-link id)
(mh-thread-add-link (car ancestors) id)))
(mh-thread-add-link (car ancestors) (cadr ancestors)))))))
- (maphash #'(lambda (_k v)
- (when (null (mh-container-parent v))
- (push v roots)))
+ (maphash (lambda (_k v)
+ (when (null (mh-container-parent v))
+ (push v roots)))
mh-thread-id-table)
(setq roots (mh-thread-prune-containers roots))
(prog1 (setq roots (mh-thread-group-by-subject roots))
@@ -720,25 +718,25 @@ For now it will take the last string inside angles."
mh-thread-history)
(mh-thread-remove-parent-link node)))))
(let ((results ()))
- (maphash #'(lambda (_k v)
- (when (and (null (mh-container-parent v))
- (gethash (mh-message-id (mh-container-message v))
- mh-thread-id-index-map))
- (push v results)))
+ (maphash (lambda (_k v)
+ (when (and (null (mh-container-parent v))
+ (gethash (mh-message-id (mh-container-message v))
+ mh-thread-id-index-map))
+ (push v results)))
mh-thread-id-table)
(mh-thread-sort-containers results))))
(defun mh-thread-sort-containers (containers)
"Sort a list of message CONTAINERS to be in ascending order wrt index."
(sort containers
- #'(lambda (x y)
- (when (and (mh-container-message x) (mh-container-message y))
- (let* ((id-x (mh-message-id (mh-container-message x)))
- (id-y (mh-message-id (mh-container-message y)))
- (index-x (gethash id-x mh-thread-id-index-map))
- (index-y (gethash id-y mh-thread-id-index-map)))
- (and (integerp index-x) (integerp index-y)
- (< index-x index-y)))))))
+ (lambda (x y)
+ (when (and (mh-container-message x) (mh-container-message y))
+ (let* ((id-x (mh-message-id (mh-container-message x)))
+ (id-y (mh-message-id (mh-container-message y)))
+ (index-x (gethash id-x mh-thread-id-index-map))
+ (index-y (gethash id-y mh-thread-id-index-map)))
+ (and (integerp index-x) (integerp index-y)
+ (< index-x index-y)))))))
(defvar mh-thread-last-ancestor)
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 40a430b..94aa8dd 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index be66e62..8e900dc 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -544,8 +542,8 @@ nested folders within them."
(mh-sub-folders-actual folder)))
(t match))))
(if add-trailing-slash-flag
- (mapcar #'(lambda (x)
- (if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
+ (mapcar (lambda (x)
+ (if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
sub-folders)
sub-folders)))
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 0b53829..d4d5c5c 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -23,8 +23,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5f59467..c900b0d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -488,8 +488,17 @@ for use at QPOS."
(qsuffix (cdr action))
(ufull (if (zerop (length qsuffix)) ustring
(funcall unquote (concat string qsuffix))))
- (_ (cl-assert (string-prefix-p ustring ufull)))
- (usuffix (substring ufull (length ustring)))
+ ;; If (not (string-prefix-p ustring ufull)) we have a problem:
+ ;; the unquoting the qfull gives something "unrelated" to ustring.
+ ;; E.g. "~/" and "/" where "~//" gets unquoted to just "/" (see
+ ;; bug#47678).
+ ;; In that case we can't even tell if we're right before the
+ ;; "/" or right after it (aka if this "/" is from qstring or
+ ;; from qsuffix), which which usuffix to use is very unclear.
+ (usuffix (if (string-prefix-p ustring ufull)
+ (substring ufull (length ustring))
+ ;; FIXME: Maybe "" is preferable/safer?
+ qsuffix))
(boundaries (completion-boundaries ustring table pred usuffix))
(qlboundary (car (funcall requote (car boundaries) string)))
(qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 668c711..1f0dd31 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -1,4 +1,4 @@
-;;; misearch.el --- isearch extensions for multi-buffer search
+;;; misearch.el --- isearch extensions for multi-buffer search -*-
lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -28,6 +28,8 @@
;;; Code:
+(require 'cl-lib)
+
;;; Search multiple buffers
;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup)
@@ -40,8 +42,7 @@
(defcustom multi-isearch-search t
"Non-nil enables searching multiple related buffers, in certain modes."
:type 'boolean
- :version "23.1"
- :group 'multi-isearch)
+ :version "23.1")
(defcustom multi-isearch-pause t
"A choice defining where to pause the search.
@@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string."
(const :tag "Don't pause" nil)
(const :tag "Only in initial buffer" initial)
(const :tag "All buffers" t))
- :version "23.1"
- :group 'multi-isearch)
+ :version "23.1")
;;;###autoload
(defvar multi-isearch-next-buffer-function nil
@@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'."
(default-value 'isearch-wrap-function)
multi-isearch-orig-push-state
(default-value 'isearch-push-state-function))
- (setq-default isearch-search-fun-function 'multi-isearch-search-fun
- isearch-wrap-function 'multi-isearch-wrap
- isearch-push-state-function 'multi-isearch-push-state)
- (add-hook 'isearch-mode-end-hook 'multi-isearch-end)))
+ (setq-default isearch-search-fun-function #'multi-isearch-search-fun
+ isearch-wrap-function #'multi-isearch-wrap
+ isearch-push-state-function #'multi-isearch-push-state)
+ (add-hook 'isearch-mode-end-hook #'multi-isearch-end)))
(defun multi-isearch-end ()
"Clean up the multi-buffer search after terminating isearch."
@@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'."
(setq-default isearch-search-fun-function multi-isearch-orig-search-fun
isearch-wrap-function multi-isearch-orig-wrap
isearch-push-state-function multi-isearch-orig-push-state)
- (remove-hook 'isearch-mode-end-hook 'multi-isearch-end))
+ (remove-hook 'isearch-mode-end-hook #'multi-isearch-end))
(defun multi-isearch-search-fun ()
"Return the proper search function, for isearch in multiple buffers."
@@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or
`multi-isearch-buffers-regexp'."
(while (not (string-equal
(setq buf (read-buffer (multi-occur--prompt) nil t))
""))
- (add-to-list 'bufs buf)
+ (cl-pushnew buf bufs :test #'equal)
(setq ido-ignore-item-temp-list bufs))
(nreverse bufs)))
@@ -322,7 +322,7 @@ Every next/previous file in the defined sequence is visited
by
default-directory
default-directory))
default-directory))
- (add-to-list 'files file))
+ (cl-pushnew file files :test #'equal))
(nreverse files)))
;; 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."
(defun multi-isearch-unload-function ()
"Remove autoloaded variables from `unload-function-defs-list'.
Also prevent the feature from being reloaded via `isearch-mode-hook'."
- (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
+ (remove-hook 'isearch-mode-hook #'multi-isearch-setup)
(let ((defs (list (car unload-function-defs-list)))
(auto '(multi-isearch-next-buffer-function
multi-isearch-next-buffer-current-function
@@ -395,7 +395,7 @@ Also prevent the feature from being reloaded via
`isearch-mode-hook'."
;; .
nil))
-(defalias 'misearch-unload-function 'multi-isearch-unload-function)
+(defalias 'misearch-unload-function #'multi-isearch-unload-function)
(provide 'multi-isearch)
diff --git a/lisp/msb.el b/lisp/msb.el
index 14209d9..1064f94 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,4 +1,4 @@
-;;; msb.el --- customizable buffer-selection with multiple menus
+;;; msb.el --- customizable buffer-selection with multiple menus -*-
lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc.
@@ -252,14 +252,12 @@ error every time you do \\[msb]."
:type `(choice (const :tag "long" :value ,msb--very-many-menus)
(const :tag "short" :value ,msb--few-menus)
(sexp :tag "user"))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-modes-key 4000
"The sort key for files sorted by mode."
:type 'integer
- :set 'msb-custom-set
- :group 'msb
+ :set #'msb-custom-set
:version "20.3")
(defcustom msb-separator-diff 100
@@ -267,8 +265,7 @@ error every time you do \\[msb]."
The separators will appear between all menus that have a sorting key
that differs by this value or more."
:type '(choice integer (const nil))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defvar msb-files-by-directory-sort-key 0
"The sort key for files sorted by directory.")
@@ -278,8 +275,7 @@ that differs by this value or more."
If this variable is set to 15 for instance, then the submenu will be
split up in minor parts, 15 items each. A value of nil means no limit."
:type '(choice integer (const nil))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-max-file-menu-items 10
"The maximum number of items from different directories.
@@ -293,27 +289,23 @@ them together.
If the value is not a number, then the value 10 is used."
:type 'integer
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-most-recently-used-sort-key -1010
"Where should the menu with the most recently used buffers be placed?"
:type 'integer
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-display-most-recently-used 15
"How many buffers should be in the most-recently-used menu.
No buffers at all if less than 1 or nil (or any non-number)."
:type 'integer
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-most-recently-used-title "Most recently used (%d)"
"The title for the most-recently-used menu."
:type 'string
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defvar msb-horizontal-shift-function (lambda () 0)
"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)."
Non-nil means that the buffer menu should include buffers that have
names that starts with a space character."
:type 'boolean
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defvar msb-item-handling-function 'msb-item-handler
"The appearance of a buffer menu.
@@ -354,15 +345,13 @@ Set this to nil or t if you don't want any sorting
(faster)."
:type '(choice (const msb-sort-by-name)
(const :tag "Newest first" t)
(const :tag "Oldest first" nil))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-files-by-directory nil
"Non-nil means that files should be sorted by directory.
This is instead of the groups in `msb-menu-cond'."
:type 'boolean
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(define-obsolete-variable-alias 'msb-after-load-hooks
'msb-after-load-hook "24.1")
@@ -370,8 +359,7 @@ This is instead of the groups in `msb-menu-cond'."
(defcustom msb-after-load-hook nil
"Hook run after the msb package has been loaded."
:type 'hook
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(make-obsolete-variable 'msb-after-load-hook
"use `with-eval-after-load' instead." "28.1")
@@ -458,10 +446,10 @@ An item look like (NAME . BUFFER)."
;;;
;;; msb
-;;;
-;;; This function can be used instead of (mouse-buffer-menu EVENT)
-;;; function in "mouse.el".
-;;;
+;;
+;; This function can be used instead of (mouse-buffer-menu EVENT)
+;; function in "mouse.el".
+;;
(defun msb (event)
"Pop up several menus of buffers for selection with the mouse.
This 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."
(cl-loop for fi
across function-info-vector
if (and (setq result
- (eval (aref fi 1))) ;Test CONDITION
+ (eval (aref fi 1) t)) ;Test CONDITION
(not (and (eq result 'no-multi)
multi-flag))
(progn (when (eq result 'multi)
@@ -727,12 +715,11 @@ All side-effects. Adds an element of form (BUFFER-TITLE
. BUFFER)
to the buffer-list variable in FUNCTION-INFO."
(let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
;; Here comes the hairy side-effect!
- (set list-symbol
- (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER
- buffer
- max-buffer-name-length)
- buffer)
- (eval list-symbol)))))
+ (push (cons (funcall (aref function-info 4) ;ITEM-HANDLER
+ buffer
+ max-buffer-name-length)
+ buffer)
+ (symbol-value list-symbol))))
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
"Select the appropriate menu for BUFFER."
@@ -754,7 +741,7 @@ to the buffer-list variable in FUNCTION-INFO."
(defun msb--create-sort-item (function-info)
"Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
- (let ((buffer-list (eval (aref function-info 0))))
+ (let ((buffer-list (symbol-value (aref function-info 0))))
(when buffer-list
(let ((sorter (aref function-info 5)) ;SORTER
(sort-key (aref function-info 2))) ;MENU-SORT-KEY
@@ -925,7 +912,7 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
for value = (msb--create-sort-item elt)
if value collect value))))
(setq menu
- (mapcar 'cdr ;Remove the SORT-KEY
+ (mapcar #'cdr ;Remove the SORT-KEY
;; Sort the menus - not the items.
(msb--add-separators
(sort
@@ -1113,8 +1100,8 @@ variable `msb-menu-cond'."
(nconc
(list (frame-parameter frame 'name)
(frame-parameter frame 'name))
- `(lambda ()
- (interactive) (menu-bar-select-frame ,frame))))
+ (lambda ()
+ (interactive) (menu-bar-select-frame frame))))
frames)))))
(setcdr global-buffers-menu-map
(if (and buffers-menu frames-menu)
@@ -1128,7 +1115,7 @@ variable `msb-menu-cond'."
;; C-down-mouse-1).
(defvar msb-mode-map
(let ((map (make-sparse-keymap "Msb")))
- (define-key map [remap mouse-buffer-menu] 'msb)
+ (define-key map [remap mouse-buffer-menu] #'msb)
map))
;;;###autoload
@@ -1137,14 +1124,14 @@ variable `msb-menu-cond'."
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'."
- :global t :group 'msb
+ :global t
(if msb-mode
(progn
- (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
- (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
+ (add-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
+ (remove-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
(msb-menu-bar-update-buffers t))
- (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
- (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
+ (remove-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
+ (add-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
(menu-bar-update-buffers t)))
(defun msb-unload-function ()
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 86b5d44..04ea809 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -6258,10 +6258,6 @@ be recognized automatically (they are all valid BS2000
hosts too)."
;; ange-ftp-bs2000-file-name-as-directory
;; ange-ftp-bs2000-make-compressed-filename
;; ange-ftp-bs2000-file-name-sans-versions
-
-;;;; ------------------------------------------------------------
-;;;; Finally provide package.
-;;;; ------------------------------------------------------------
(provide 'ange-ftp)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index fa10fb1..5f97027 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -987,6 +987,7 @@ the like."
(define-key map "F" 'eww-toggle-fonts)
(define-key map "D" 'eww-toggle-paragraph-direction)
(define-key map [(meta C)] 'eww-toggle-colors)
+ (define-key map [(meta I)] 'eww-toggle-images)
(define-key map "b" 'eww-add-bookmark)
(define-key map "B" 'eww-list-bookmarks)
@@ -1015,6 +1016,7 @@ the like."
["List cookies" url-cookie-list t]
["Toggle fonts" eww-toggle-fonts t]
["Toggle colors" eww-toggle-colors t]
+ ["Toggle images" eww-toggle-images t]
["Character Encoding" eww-set-character-encoding]
["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
map))
@@ -1893,6 +1895,14 @@ If CHARSET is nil then use UTF-8."
"off"))
(eww-reload))
+(defun eww-toggle-images ()
+ "Toggle whether or not to display images."
+ (interactive nil eww-mode)
+ (setq shr-inhibit-images (not shr-inhibit-images))
+ (eww-reload)
+ (message "Images are now %s"
+ (if shr-inhibit-images "off" "on")))
+
;;; Bookmarks code
(defvar eww-bookmarks nil)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index af12f69..8992ef7 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
;;;###autoload
(define-minor-mode goto-address-mode
"Minor mode to buttonize URLs and e-mail addresses in the current buffer."
- nil
- ""
- nil
+ :lighter ""
(if goto-address-mode
(jit-lock-register #'goto-address-fontify-region)
(jit-lock-unregister #'goto-address-fontify-region)
@@ -285,9 +283,7 @@ Also fontifies the buffer appropriately (see
`goto-address-fontify-p' and
;;;###autoload
(define-minor-mode goto-address-prog-mode
"Like `goto-address-mode', but only for comments and strings."
- nil
- ""
- nil
+ :lighter ""
(if goto-address-prog-mode
(jit-lock-register #'goto-address-fontify-region)
(jit-lock-unregister #'goto-address-fontify-region)
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 3a561a0..24f2aba 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -857,9 +857,14 @@ and `network-connection-service-alist', which see."
;; FIXME: modern whois clients include a much better tld <-> whois server
;; list, Emacs should probably avoid specifying the server as the client
;; will DTRT anyway... -rfr
+;; I'm not sure about the above FIXME. It seems to me that we should
+;; just check the Root Zone Database maintained at:
+;; https://www.iana.org/domains/root/db
+;; For example: whois -h whois.iana.org .se | grep whois
(defcustom whois-server-tld
- '(("rs.internic.net" . "com")
- ("whois.publicinterestregistry.net" . "org")
+ '(("whois.verisign-grs.com" . "com")
+ ("whois.verisign-grs.com" . "net")
+ ("whois.pir.org" . "org")
("whois.ripe.net" . "be")
("whois.ripe.net" . "de")
("whois.ripe.net" . "dk")
@@ -867,10 +872,13 @@ and `network-connection-service-alist', which see."
("whois.ripe.net" . "fi")
("whois.ripe.net" . "fr")
("whois.ripe.net" . "uk")
+ ("whois.iis.se" . "se")
+ ("whois.iis.nu" . "nu")
("whois.apnic.net" . "au")
("whois.apnic.net" . "ch")
("whois.apnic.net" . "hk")
("whois.apnic.net" . "jp")
+ ("whois.eu" . "eu")
("whois.nic.gov" . "gov")
("whois.nic.mil" . "mil"))
"Alist to map top level domains to whois servers."
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 938fadf..7bb8ca6 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -196,7 +196,7 @@ If nil, no maximum is applied."
Uninteresting lines are those whose responses are listed in
`rcirc-omit-responses'."
- nil " Omit" nil
+ :lighter " Omit"
(if rcirc-omit-mode
(progn
(add-to-invisibility-spec '(rcirc-omit . nil))
@@ -1359,9 +1359,7 @@ Create the buffer if it doesn't exist."
(define-minor-mode rcirc-multiline-minor-mode
"Minor mode for editing multiple lines in rcirc."
- :init-value nil
:lighter " rcirc-mline"
- :keymap rcirc-multiline-minor-mode-map
:global nil
(setq fill-column rcirc-max-message-length))
@@ -1863,9 +1861,6 @@ This function does not alter the INPUT string."
;;;###autoload
(define-minor-mode rcirc-track-minor-mode
"Global minor mode for tracking activity in rcirc buffers."
- :init-value nil
- :lighter ""
- :keymap rcirc-track-minor-mode-map
:global t
(or global-mode-string (setq global-mode-string '("")))
;; toggle the mode-line channel indicator
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index c122a19..cbdeb65 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -183,8 +183,10 @@ temporarily blinks with this face."
"Face for <abbr> elements."
:version "27.1")
-(defvar shr-inhibit-images nil
- "If non-nil, inhibit loading images.")
+(defcustom shr-inhibit-images nil
+ "If non-nil, inhibit loading images."
+ :version "28.1"
+ :type 'boolean)
(defvar shr-external-rendering-functions nil
"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
(* (frame-char-width) 2))
1))))
(max-specpdl-size max-specpdl-size)
+ ;; `bidi-display-reordering' is supposed to be only used for
+ ;; debugging purposes, but Shr's naïve filling algorithm
+ ;; cannot cope with the complexity of RTL text in an LTR
+ ;; paragraph, when a long line has been continued, and for
+ ;; most scripts the character metrics don't change when they
+ ;; are reordered, so... this is the best we could do :-(
bidi-display-reordering)
;; Adjust for max width specification.
(when (and shr-max-width
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index c3e1745..df64d13 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -103,12 +103,12 @@ detected as prompt when being sent on echoing hosts,
therefore.")
(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
"String used to recognize end of heredoc strings.")
-(defcustom tramp-use-ssh-controlmaster-options t
+(defcustom tramp-use-ssh-controlmaster-options (not (eq system-type
'windows-nt))
"Whether to use `tramp-ssh-controlmaster-options'.
Set it to nil, if you use Control* or Proxy* options in your ssh
configuration."
:group 'tramp
- :version "24.4"
+ :version "28.1"
:type 'boolean)
(defvar tramp-ssh-controlmaster-options nil
@@ -169,7 +169,8 @@ The string is used in `tramp-methods'.")
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("-t" "-t")
- ("-o" "RemoteCommand='%l'")
("%h")))
+ ("-o" "RemoteCommand=\"%l\"")
+ ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@@ -225,7 +226,8 @@ The string is used in `tramp-methods'.")
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("-t" "-t")
- ("-o" "RemoteCommand='%l'")
("%h")))
+ ("-o" "RemoteCommand=\"%l\"")
+ ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@@ -399,16 +401,34 @@ The string is used in `tramp-methods'.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-ssh
- '((tramp-parse-rhosts "/etc/hosts.equiv")
+ `((tramp-parse-rhosts "/etc/hosts.equiv")
(tramp-parse-rhosts "/etc/shosts.equiv")
- (tramp-parse-shosts "/etc/ssh_known_hosts")
- (tramp-parse-sconfig "/etc/ssh_config")
+ ;; On W32 systems, the ssh directory is located somewhere else.
+ (tramp-parse-shosts ,(expand-file-name
+ "ssh/ssh_known_hosts"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "ProgramData"))
+ "/etc/")))
+ (tramp-parse-sconfig ,(expand-file-name
+ "ssh/ssh_config"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "ProgramData"))
+ "/etc/")))
(tramp-parse-shostkeys "/etc/ssh2/hostkeys")
(tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
(tramp-parse-rhosts "~/.rhosts")
(tramp-parse-rhosts "~/.shosts")
- (tramp-parse-shosts "~/.ssh/known_hosts")
- (tramp-parse-sconfig "~/.ssh/config")
+ ;; On W32 systems, the .ssh directory is located somewhere else.
+ (tramp-parse-shosts ,(expand-file-name
+ ".ssh/known_hosts"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "USERPROFILE"))
+ "~/")))
+ (tramp-parse-sconfig ,(expand-file-name
+ ".ssh/config"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "USERPROFILE"))
+ "~/")))
(tramp-parse-shostkeys "~/.ssh2/hostkeys")
(tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
"Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
@@ -431,7 +451,7 @@ The string is used in `tramp-methods'.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-putty
`((tramp-parse-putty
- ,(if (memq system-type '(windows-nt))
+ ,(if (eq system-type 'windows-nt)
"HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
"~/.putty/sessions")))
"Default list of (FUNCTION REGISTRY) pairs to be examined for putty
sessions.")
@@ -941,7 +961,7 @@ Format specifiers \"%s\" are replaced before the script is
used.")
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p)
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
@@ -1549,49 +1569,6 @@ ID-FORMAT valid values are `string' and `integer'."
(or (tramp-check-cached-permissions v ?r)
(tramp-run-test "-r" filename)))))
-;; When the remote shell is started, it looks for a shell which groks
-;; tilde expansion. Here, we assume that all shells which grok tilde
-;; expansion will also provide a `test' command which groks `-nt' (for
-;; newer than). If this breaks, tell me about it and I'll try to do
-;; something smarter about it.
-(defun tramp-sh-handle-file-newer-than-file-p (file1 file2)
- "Like `file-newer-than-file-p' for Tramp files."
- (cond ((not (file-exists-p file1)) nil)
- ((not (file-exists-p file2)) t)
- (t ;; We are sure both files exist at this point. We try to
- ;; get the mtime of both files. If they are not equal to
- ;; the "dont-know" value, then we subtract the times and
- ;; obtain the result.
- (let ((fa1 (file-attributes file1))
- (fa2 (file-attributes file2)))
- (if (and
- (not
- (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time fa1)
- tramp-time-dont-know))
- (not
- (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time fa2)
- tramp-time-dont-know)))
- (time-less-p
- (tramp-compat-file-attribute-modification-time fa2)
- (tramp-compat-file-attribute-modification-time fa1))
- ;; If one of them is the dont-know value, then we can
- ;; still try to run a shell command on the remote host.
- ;; However, this only works if both files are Tramp
- ;; files and both have the same method, same user, same
- ;; host.
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p file1) file1 file2) nil
- (tramp-error
- v 'file-error
- "Files %s and %s must have same method, user, host"
- file1 file2)))
- (with-parsed-tramp-file-name file1 nil
- (tramp-run-test2
- (tramp-get-test-nt-command v) file1 file2)))))))
-
;; Functions implemented using the basic functions above.
(defun tramp-sh-handle-file-directory-p (filename)
@@ -2241,7 +2218,7 @@ The method used must be an out-of-band method."
(t2 (tramp-tramp-file-p newname))
(orig-vec (tramp-dissect-file-name (if t1 filename newname)))
copy-program copy-args copy-env copy-keep-date listener spec
- options source target remote-copy-program remote-copy-args)
+ options source target remote-copy-program remote-copy-args p)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(if (and t1 t2)
@@ -2276,10 +2253,10 @@ The method used must be an out-of-band method."
#'identity)
(if t1
(tramp-make-copy-program-file-name v)
- (tramp-unquote-shell-quote-argument filename)))
+ (tramp-compat-file-name-unquote filename)))
target (if t2
(tramp-make-copy-program-file-name v)
- (tramp-unquote-shell-quote-argument newname)))
+ (tramp-compat-file-name-unquote newname)))
;; Check for user. There might be an interactive setting.
(setq user (or (tramp-file-name-user v)
@@ -2311,6 +2288,13 @@ The method used must be an out-of-band method."
;; keep-date argument is non-nil), or a replacement for
;; the whole keep-date sublist.
(delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ ;; `tramp-ssh-controlmaster-options' is a string instead
+ ;; of a list. Unflatten it.
+ copy-args
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x) (if (string-match-p " " x) (split-string x) x))
+ copy-args))
copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
remote-copy-program
(tramp-get-method-parameter v 'tramp-remote-copy-program)
@@ -2372,31 +2356,26 @@ The method used must be an out-of-band method."
copy-args
(if remote-copy-program
(list (if t1 (concat ">" target) (concat "<" source)))
- (list source target))))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled. We don't set a timeout, because the
- ;; copying of large files can last longer than 60 secs.
- (let* ((command
- (mapconcat
- #'identity (append (list copy-program) copy-args)
- " "))
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- command))))
- (tramp-message orig-vec 6 "%s" command)
- (process-put p 'vector orig-vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
-
- ;; We must adapt `tramp-local-end-of-line' for
- ;; sending the password.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band))))
+ (list source target)))
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled. We don't set a timeout, because
+ ;; the copying of large files can last longer than 60
+ ;; secs.
+ p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program copy-args))
+ (tramp-message orig-vec 6 "%s" (string-join (process-command p)
" "))
+ (process-put p 'vector orig-vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; We must adapt `tramp-local-end-of-line' for
+ ;; sending the password.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band)))
;; Reset the transfer process properties.
(tramp-flush-connection-property v "process-name")
@@ -2944,15 +2923,19 @@ alternative implementation will be used."
;; until the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
- (insert-file-contents-literally remote-tmpstderr))
+ ;; There's a mysterious error, see
+ ;; <https://github.com/joaotavora/eglot/issues/662>.
+ (ignore-errors
+ (insert-file-contents-literally
remote-tmpstderr)))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(when (file-exists-p remote-tmpstderr)
(with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr nil nil nil 'replace))
+ (ignore-errors
+ (insert-file-contents-literally
+ remote-tmpstderr nil nil nil 'replace)))
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
@@ -3951,24 +3934,6 @@ Returns the exit code of the `test' program."
switch
(tramp-shell-quote-argument localname)))))
-(defun tramp-run-test2 (format-string file1 file2)
- "Run `test'-like program on the remote system, given FILE1, FILE2.
-FORMAT-STRING contains the program name, switches, and place holders.
-Returns the exit code of the `test' program. Barfs if the methods,
-hosts, or files, disagree."
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2)
nil
- (tramp-error
- v 'file-error
- "tramp-run-test2 only implemented for same method, user, host")))
- (with-parsed-tramp-file-name file1 v1
- (with-parsed-tramp-file-name file1 v2
- (tramp-send-command-and-check
- v1
- (format format-string
- (tramp-shell-quote-argument v1-localname)
- (tramp-shell-quote-argument v2-localname))))))
-
(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
@@ -4974,11 +4939,7 @@ connection if a previous connection has died for some
reason."
?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
?c (format-spec options (format-spec-make ?t tmpfile))
?l (concat remote-shell " " extra-args " -i"))
- ;; Local shell could be a Windows COMSPEC. It
- ;; doesn't know the ";" syntax, but we must
- ;; exit always for `start-file-process'. It
- ;; could also be a restricted shell, which does
- ;; not allow "exec".
+ ;; A restricted shell does not allow "exec".
(when r-shell '("&&" "exit" "||" "exit")))
" "))
@@ -5266,15 +5227,17 @@ Return ATTR."
(directory-file-name (tramp-file-name-unquote-localname vec))))
(when (string-match-p tramp-ipv6-regexp host)
(setq host (format "[%s]" host)))
+ ;; This does not work yet for MS Windows scp, if there are
+ ;; characters to be quoted. Win32 OpenSSH 7.9 is said to support
+ ;; this, see
+ ;;
<https://github.com/PowerShell/Win32-OpenSSH/releases/tag/v7.9.0.0p1-Beta>
(unless (string-match-p "ftp$" method)
(setq localname (tramp-shell-quote-argument localname)))
(cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
localname)
- ((not (zerop (length user)))
- (format
- "%s@%s:%s" user host (tramp-unquote-shell-quote-argument localname)))
- (t (format "%s:%s" host (tramp-unquote-shell-quote-argument
localname))))))
+ ((zerop (length user)) (format "%s:%s" host localname))
+ (t (format "%s@%s:%s" user host localname)))))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
@@ -5827,7 +5790,7 @@ function cell is returned to be applied on a buffer."
;; slashes as directory separators.
(cond
((and (string-match-p "local" prop)
- (memq system-type '(windows-nt)))
+ (eq system-type 'windows-nt))
"(%s | \"%s\")")
((string-match-p "local" prop) "(%s | %s)")
(t "(%s | %s >%%s)"))
@@ -5838,7 +5801,7 @@ function cell is returned to be applied on a buffer."
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
(if (and (string-match-p "local" prop)
- (memq system-type '(windows-nt)))
+ (eq system-type 'windows-nt))
"(%s <%%s | \"%s\")"
"(%s <%%s | %s)")
compress coding))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8141f02..a411aaf 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -354,12 +354,13 @@ Notes:
All these arguments can be overwritten by connection properties.
See Info node `(tramp) Predefined connection information'.
-When using `su' or `sudo' the phrase \"open connection to a remote
-host\" sounds strange, but it is used nevertheless, for consistency.
-No connection is opened to a remote host, but `su' or `sudo' is
-started on the local host. You should specify a remote host
-`localhost' or the name of the local host. Another host name is
-useful only in combination with `tramp-default-proxies-alist'.")
+When using `su', `sudo' or `doas' the phrase \"open connection to
+a remote host\" sounds strange, but it is used nevertheless, for
+consistency. No connection is opened to a remote host, but `su',
+`sudo' or `doas' is started on the local host. You should
+specify a remote host `localhost' or the name of the local host.
+Another host name is useful only in combination with
+`tramp-default-proxies-alist'.")
(defcustom tramp-default-method
;; An external copy method seems to be preferred, because it performs
@@ -487,7 +488,7 @@ interpreted as a regular expression which always matches."
;; either lower case or upper case letters. See
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
- (when (memq system-type '(windows-nt))
+ (when (eq system-type 'windows-nt)
(list (format "\\`\\(%s\\|%s\\)\\'"
(regexp-quote (downcase tramp-system-name))
(regexp-quote (upcase tramp-system-name)))))
@@ -557,7 +558,7 @@ usually suffice.")
the remote shell.")
(defcustom tramp-local-end-of-line
- (if (memq system-type '(windows-nt)) "\r\n" "\n")
+ (if (eq system-type 'windows-nt) "\r\n" "\n")
"String used for end of line in local processes."
:version "24.1"
:type 'string)
@@ -1077,7 +1078,13 @@ initial value is overwritten by the car of
`tramp-file-name-structure'.")
(defconst tramp-completion-file-name-regexp-default
(concat
- "\\`/\\("
+ "\\`"
+ ;; `file-name-completion' uses absolute paths for matching. This
+ ;; means that on W32 systems, something like "/ssh:host:~/path"
+ ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'.
+ (when (eq system-type 'windows-nt)
+ "\\(?:[[:alpha:]]:\\)?")
+ "/\\("
;; Optional multi hop.
"\\([^/|:]+:[^/|:]*|\\)*"
;; Last hop.
@@ -1096,7 +1103,13 @@ On W32 systems, the volume letter must be ignored.")
(defconst tramp-completion-file-name-regexp-simplified
(concat
- "\\`/\\("
+ "\\`"
+ ;; Allow the volume letter at the beginning of the path. See the
+ ;; comment in `tramp-completion-file-name-regexp-default' for more
+ ;; details.
+ (when (eq system-type 'windows-nt)
+ "\\(?:[[:alpha:]]:\\)?")
+ "/\\("
;; Optional multi hop.
"\\([^/|:]*|\\)*"
;; Last hop.
@@ -1112,7 +1125,14 @@ See `tramp-file-name-structure' for more explanations.
On W32 systems, the volume letter must be ignored.")
(defconst tramp-completion-file-name-regexp-separate
- "\\`/\\(\\[[^]]*\\)?\\'"
+ (concat
+ "\\`"
+ ;; Allow the volume letter at the beginning of the path. See the
+ ;; comment in `tramp-completion-file-name-regexp-default' for more
+ ;; details.
+ (when (eq system-type 'windows-nt)
+ "\\(?:[[:alpha:]]:\\)?")
+ "/\\(\\[[^]]*\\)?\\'")
"Value for `tramp-completion-file-name-regexp' for separate remoting.
See `tramp-file-name-structure' for more explanations.")
@@ -1808,6 +1828,7 @@ The outline level is equal to the verbosity of the Tramp
message."
"Get the debug buffer for VEC."
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
+ (set-buffer-file-coding-system 'utf-8)
(setq buffer-undo-list t)
;; Activate `outline-mode'. This runs `text-mode-hook' and
;; `outline-mode-hook'. We must prevent that local processes
@@ -1848,7 +1869,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(when (bobp)
(insert
(format
- ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
+ ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-"
emacs-version tramp-version))
(when (>= tramp-verbose 10)
(let ((tramp-verbose 0))
@@ -3117,7 +3138,7 @@ User may be nil."
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- (if (memq system-type '(windows-nt))
+ (if (eq system-type 'windows-nt)
(with-tramp-connection-property nil "parse-putty"
(with-temp-buffer
(when (zerop (tramp-call-process
@@ -3867,8 +3888,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(or (not (stringp stderr)) (not (tramp-tramp-file-p stderr))))))
(defun tramp-handle-make-process (&rest args)
- "An alternative `make-process' implementation for Tramp files.
-It does not support `:stderr'."
+ "An alternative `make-process' implementation for Tramp files."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((default-directory (tramp-compat-temporary-file-directory))
@@ -4969,7 +4989,7 @@ VEC is used for tracing."
(let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
locale)
(with-temp-buffer
- (unless (or (memq system-type '(windows-nt))
+ (unless (or (eq system-type 'windows-nt)
(not (zerop (tramp-call-process
nil "locale" nil t nil "-a"))))
(while candidates
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 8f89598..9824eeb 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -324,8 +324,8 @@ and VALUE-END, otherwise a STRING giving the value."
(setq strs (cons (car arg) strs))
(setq names (cons (cdr arg) names)))
(setq args (cdr args))))
- (cons (apply 'concat (nreverse strs))
- (apply 'append (nreverse names))))))
+ (cons (apply #'concat (nreverse strs))
+ (apply #'append (nreverse names))))))
(eval-when-compile
;; Make a symbolic group named NAME from the regexp R.
@@ -338,7 +338,7 @@ and VALUE-END, otherwise a STRING giving the value."
(cons (concat "\\(" (car ,sym) "\\)") (cons ',name (cdr ,sym)))))))
(defun xmltok-p (&rest r) (xmltok+ "\\(?:"
- (apply 'xmltok+ r)
+ (apply #'xmltok+ r)
"\\)"))
;; Get the group index of ELEM in a LIST of symbols.
@@ -372,22 +372,23 @@ and VALUE-END, otherwise a STRING giving the value."
(defmacro xmltok-defregexp (sym r)
`(defalias ',sym
(let ((r ,r))
- `(macro lambda (action &optional group-name)
- (cond ((eq action 'regexp)
- ,(car r))
- ((or (eq action 'start) (eq action 'beginning))
- (list 'match-beginning (xmltok-get-index group-name
- ',(cdr r))))
- ((eq action 'end)
- (list 'match-end (xmltok-get-index group-name
- ',(cdr r))))
- ((eq action 'string)
- (list 'match-string
- (xmltok-get-index group-name ',(cdr r))))
- ((eq action 'string-no-properties)
- (list 'match-string-no-properties
- (xmltok-get-index group-name ',(cdr r))))
- (t (error "Invalid action: %s" action))))))))
+ `(macro
+ . ,(lambda (action &optional group-name)
+ (cond ((eq action 'regexp)
+ (car r))
+ ((or (eq action 'start) (eq action 'beginning))
+ (list 'match-beginning (xmltok-get-index group-name
+ (cdr r))))
+ ((eq action 'end)
+ (list 'match-end (xmltok-get-index group-name
+ (cdr r))))
+ ((eq action 'string)
+ (list 'match-string
+ (xmltok-get-index group-name (cdr r))))
+ ((eq action 'string-no-properties)
+ (list 'match-string-no-properties
+ (xmltok-get-index group-name (cdr r))))
+ (t (error "Invalid action: %s" action)))))))))
(eval-when-compile
@@ -878,7 +879,7 @@ and VALUE-END, otherwise a STRING giving the value."
(cons " " value-parts)))))
(< (point) end))))
(when well-formed
- (aset att 5 (apply 'concat (nreverse value-parts))))
+ (aset att 5 (apply #'concat (nreverse value-parts))))
(aset att 6 (nreverse refs))))
(defun xmltok-scan-after-amp (entity-handler)
@@ -1333,7 +1334,7 @@ If LIMIT is non-nil, then do not consider characters
beyond LIMIT."
t))))
(if (not well-formed)
nil
- (apply 'concat
+ (apply #'concat
(nreverse (cons (buffer-substring-no-properties start lim)
value-parts))))))
@@ -1358,7 +1359,7 @@ If LIMIT is non-nil, then do not consider characters
beyond LIMIT."
(defun xmltok-require-next-token (&rest types)
(xmltok-next-prolog-token)
- (apply 'xmltok-require-token types))
+ (apply #'xmltok-require-token types))
(defun xmltok-require-token (&rest types)
;; XXX Generate a more helpful error message
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index baed8be..960233d 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -752,8 +752,6 @@ See `fast-lock-get-face-properties'."
(unless (assq 'fast-lock-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil)))))
-;; Provide ourselves:
-
(provide 'fast-lock)
;;; fast-lock.el ends here
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 7ffee76..a630baf 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1336,7 +1336,7 @@ See the variable `iswitchb-case' for details."
Iswitchb mode is a global minor mode that enables switching
between buffers using substrings. See `iswitchb' for details."
- nil nil iswitchb-global-map :global t
+ :keymap iswitchb-global-map :global t
(if iswitchb-mode
(add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)
(remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index 34bf85f..13f14aa 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -1016,8 +1016,6 @@ verbosity is controlled via the variable
`lazy-lock-stealth-verbose'."
(unless (assq 'lazy-lock-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil)))))
-;; Provide ourselves:
-
(provide 'lazy-lock)
;; Local Variables:
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index f2ea5c6..40a8ec5 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -1339,7 +1339,6 @@ Query for the specs, or use SPECS."
(define-obsolete-function-alias 'nnir-get-active #'gnus-server-get-active
"28.1")
-;; The end.
(provide 'nnir)
;;; nnir.el ends here
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 5982875..f999f50 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -314,8 +314,6 @@ but before calling PC Selection mode):
C-BACKSPACE backward-kill-word
M-BACKSPACE undo"
;; FIXME: bring pc-bindings-mode here ?
- nil nil nil
-
:global t
(if pc-selection-mode
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
index 96d6b7a..371dcbf 100644
--- a/lisp/obsolete/sregex.el
+++ b/lisp/obsolete/sregex.el
@@ -208,7 +208,7 @@
;; This is a "trapdoor" for including ordinary regular expression
;; strings in the result. Some regular expressions are clearer when
;; written the old way: "[a-z]" vs. (sregexq (char (?a . ?z))), for
-;; instance. However, see the note under "Bugs," below.
+;; instance.
;; Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
;; has one of the following forms:
@@ -236,8 +236,6 @@
;; - add support for non-greedy operators *? and +?
;; - bug: (sregexq (opt (opt ?a))) returns "a??" which is a non-greedy "a?"
-;;; Bugs:
-
;;; Code:
(eval-when-compile (require 'cl-lib))
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index d23068a..5ae0a65 100644
--- a/lisp/obsolete/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -69,7 +69,7 @@
;;;###autoload
(defun tpu-mapper ()
- "Create an Emacs lisp file defining the TPU-edt keypad for X-windows.
+ "Create an Emacs Lisp file defining the TPU-edt keypad for X-windows.
This command displays an instruction screen showing the TPU-edt keypad
and asks you to press the TPU-edt editing keys. It uses the keys you
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index f40f2b3..7ae8fae 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -521,7 +521,7 @@ for a capture buffer.")
"Minor mode for special key bindings in a capture buffer.
Turning on this mode runs the normal hook `org-capture-mode-hook'."
- nil " Cap" org-capture-mode-map
+ :lighter " Cap"
(setq-local
header-line-format
(substitute-command-keys
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index c6bf416..3475cad 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.
The process is synchronous. Though, initial indentation of
buffer, which can take a few seconds on large buffers, is done
during idle time."
- nil " Ind" nil
+ :lighter " Ind"
(cond
(org-indent-mode
;; mode was turned on.
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 39122e7..f97164e 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
;;;###autoload
(define-minor-mode org-list-checkbox-radio-mode
"When turned on, use list checkboxes as radio buttons."
- nil " CheckBoxRadio" nil
+ :lighter " CheckBoxRadio"
(unless (eq major-mode 'org-mode)
(user-error "Cannot turn this mode outside org-mode buffers")))
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 20acee4..cabedec 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:
\\{org-src-mode-map}
See also `org-src-mode-hook'."
- nil " OrgSrc" nil
+ :lighter " OrgSrc"
(when org-edit-src-persistent-message
(setq header-line-format
(substitute-command-keys
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 1248efa..0e93fb2 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."
;;;###autoload
(define-minor-mode org-table-header-line-mode
"Display the first row of the table at point in the header line."
- nil " TblHeader" nil
+ :lighter " TblHeader"
(unless (eq major-mode 'org-mode)
(user-error "Cannot turn org table header mode outside org-mode buffers"))
(if org-table-header-line-mode
@@ -1976,7 +1976,7 @@ lines."
When this mode is active, the field editor window will always show the
current field. The mode exits automatically when the cursor leaves the
table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
- nil " TblFollow" nil
+ :lighter " TblFollow"
(if org-table-follow-field-mode
(add-hook 'post-command-hook 'org-table-follow-fields-with-editor
'append 'local)
@@ -5149,7 +5149,7 @@ When LOCAL is non-nil, show references for the table at
point."
;;;###autoload
(define-minor-mode orgtbl-mode
"The Org mode table editor as a minor mode for use in other modes."
- :lighter " OrgTbl" :keymap orgtbl-mode-map
+ :lighter " OrgTbl"
(org-load-modules-maybe)
(cond
((derived-mode-p 'org-mode)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index cebe173..f560c65 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
This mode supports entering LaTeX environment and math in LaTeX fragments
in Org mode.
\\{org-cdlatex-mode-map}"
- nil " OCDL" nil
+ :lighter " OCDL"
(when org-cdlatex-mode
(require 'cdlatex)
(run-hooks 'cdlatex-mode-hook)
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 1a1732b..6ed95e8 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -895,14 +895,16 @@ holding export options."
;;; Minor Mode
-(defvar org-beamer-mode-map (make-sparse-keymap)
+(defvar org-beamer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-b" 'org-beamer-select-environment)
+ map)
"The keymap for `org-beamer-mode'.")
-(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
;;;###autoload
(define-minor-mode org-beamer-mode
"Support for editing Beamer oriented Org mode files."
- nil " Bm" 'org-beamer-mode-map)
+ :lighter " Bm")
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords
diff --git a/lisp/outline.el b/lisp/outline.el
index 79029a6..bce9c6b 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -374,8 +374,9 @@ faces to major mode's faces."
"Toggle Outline minor mode.
See the command `outline-mode' for more information on this mode."
- nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
- (cons outline-minor-mode-prefix outline-mode-prefix-map))
+ :lighter " Outl"
+ :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
+ (cons outline-minor-mode-prefix outline-mode-prefix-map))
(if outline-minor-mode
(progn
(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 4d4becf..e467d98 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -440,9 +440,6 @@ and set it if applicable."
;;;###autoload
(define-minor-mode bug-reference-mode
"Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
- nil
- ""
- nil
:after-hook (bug-reference--run-auto-setup)
(if bug-reference-mode
(jit-lock-register #'bug-reference-fontify)
@@ -454,9 +451,6 @@ and set it if applicable."
;;;###autoload
(define-minor-mode bug-reference-prog-mode
"Like `bug-reference-mode', but only buttonize in comments and strings."
- nil
- ""
- nil
:after-hook (bug-reference--run-auto-setup)
(if bug-reference-prog-mode
(jit-lock-register #'bug-reference-fontify)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 51d51de..9234d0b 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1,4 +1,4 @@
-;;; cc-align.el --- custom indentation functions for CC Mode
+;;; cc-align.el --- custom indentation functions for CC Mode -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -44,6 +44,9 @@
(cc-require 'cc-vars)
(cc-require 'cc-engine)
+(defvar c-syntactic-context)
+(defvar c-syntactic-element)
+
;; Standard line-up functions
;;
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 3228944..84cc5b1 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1,4 +1,4 @@
-;;; cc-awk.el --- AWK specific code within cc-mode.
+;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*-
;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 3f7caf3..b3f7020 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -1,4 +1,4 @@
-;;; cc-bytecomp.el --- compile time setup for proper compilation
+;;; cc-bytecomp.el --- compile time setup for proper compilation -*-
lexical-binding: t -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -85,8 +85,8 @@
(defvar cc-bytecomp-environment-set nil)
-(defmacro cc-bytecomp-debug-msg (&rest args)
- (ignore args)
+(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed.
+ ;; (declare (debug t))
;;`(message ,@args)
)
@@ -297,6 +297,7 @@ during compilation, but compile in a `require'. Don't use
within
Having cyclic cc-require's will result in infinite recursion. That's
somewhat intentional."
+ (declare (debug t))
`(progn
(eval-when-compile
(cc-bytecomp-load (symbol-name ,cc-part)))
@@ -309,6 +310,7 @@ time, (ii) generate code to load the file at load time.
CC-PART will normally be a quoted name such as \\='cc-fix.
CONDITION should not be quoted."
+ (declare (debug t))
(if (eval condition)
(progn
(cc-bytecomp-load (symbol-name (eval cc-part)))
@@ -323,6 +325,7 @@ after the loading of FILE.
CC-PART will normally be a quoted name such as \\='cc-fix. FILE
should be a string. CONDITION should not be quoted."
+ (declare (debug t))
(if (eval condition)
(progn
(cc-bytecomp-load (symbol-name (eval cc-part)))
@@ -333,6 +336,7 @@ should be a string. CONDITION should not be quoted."
(defmacro cc-provide (feature)
"A replacement for the `provide' form that restores the environment
after the compilation. Don't use within `eval-when-compile'."
+ (declare (debug t))
`(progn
(eval-when-compile (cc-bytecomp-restore-environment))
(provide ,feature)))
@@ -344,6 +348,7 @@ during compilation. Don't use outside `eval-when-compile'
or
Having cyclic cc-load's will result in infinite recursion. That's
somewhat intentional."
+ (declare (debug t))
`(or (and (featurep 'cc-bytecomp)
(cc-bytecomp-load ,cc-part))
(load ,cc-part nil t nil)))
@@ -352,6 +357,7 @@ somewhat intentional."
"Force loading of the corresponding .el file in the current directory
during compilation, but do a compile time `require' otherwise. Don't
use within `eval-when-compile'."
+ (declare (debug t))
`(eval-when-compile
(if (and (fboundp 'cc-bytecomp-is-compiling)
(cc-bytecomp-is-compiling))
@@ -363,6 +369,7 @@ use within `eval-when-compile'."
"Do a `require' of an external package.
This restores and sets up the compilation environment before and
afterwards. Don't use within `eval-when-compile'."
+ (declare (debug t))
`(progn
(eval-when-compile (cc-bytecomp-restore-environment))
(require ,feature)
@@ -371,6 +378,7 @@ afterwards. Don't use within `eval-when-compile'."
(defmacro cc-bytecomp-defvar (var)
"Binds the symbol as a variable during compilation of the file,
to silence the byte compiler. Don't use within `eval-when-compile'."
+ (declare (debug nil))
`(eval-when-compile
(if (boundp ',var)
(cc-bytecomp-debug-msg
@@ -398,6 +406,7 @@ definition. That means that this macro will not shut up
warnings
about incorrect number of arguments. It's dangerous to try to replace
existing functions since the byte compiler might need the definition
at compile time, e.g. for macros and inline functions."
+ (declare (debug nil))
`(eval-when-compile
(if (fboundp ',fun)
(cc-bytecomp-debug-msg
@@ -419,6 +428,7 @@ at compile time, e.g. for macros and inline functions."
(defmacro cc-bytecomp-put (symbol propname value)
"Set a property on a symbol during compilation (and evaluation) of
the file. Don't use outside `eval-when-compile'."
+ (declare (debug t))
`(eval-when-compile
(if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties))
(progn
@@ -439,6 +449,7 @@ the file. Don't use outside `eval-when-compile'."
the compilation. This is the same as using `boundp' but additionally
exclude any variables that have been bound during compilation with
`cc-bytecomp-defvar'."
+ (declare (debug t))
(if (and (cc-bytecomp-is-compiling)
(memq (car (cdr symbol)) cc-bytecomp-unbound-variables))
nil
@@ -449,6 +460,7 @@ exclude any variables that have been bound during
compilation with
the compilation. This is the same as using `fboundp' but additionally
exclude any functions that have been bound during compilation with
`cc-bytecomp-defun'."
+ (declare (debug t))
(let (fun-elem)
(if (and (cc-bytecomp-is-compiling)
(setq fun-elem (assq (car (cdr symbol))
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 1754436..bdfdf17 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1,4 +1,4 @@
-;;; cc-cmds.el --- user level commands for CC Mode
+;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -49,12 +49,11 @@
; which looks at this.
(cc-bytecomp-defun electric-pair-post-self-insert-function)
(cc-bytecomp-defvar c-indent-to-body-directives)
+(defvar c-syntactic-context)
;; Indentation / Display syntax functions
(defvar c-fix-backslashes t)
-(defvar c-syntactic-context)
-
(defun c-indent-line (&optional syntax quiet ignore-point-pos)
"Indent the current line according to the syntactic context,
if `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."
(self-insert-command (prefix-numeric-value arg)))
(setq final-pos (point))
-;;;; 2010-01-31: There used to be code here to put a syntax-table text
-;;;; property on the new < or > and its mate (if any) when they are template
-;;;; parens. This is now done in an after-change function.
+;;;; 2010-01-31: There used to be code here to put a syntax-table text
+;;;; property on the new < or > and its mate (if any) when they are template
+;;;; parens. This is now done in an after-change function.
(when (and (not arg) (not literal))
;; Have we got a delimiter on a #include directive?
@@ -1640,7 +1639,7 @@ No indentation or other \"electric\" behavior is
performed."
;; This function might do hidden buffer changes.
(save-excursion
(let* (knr-start knr-res
- decl-result brace-decl-p
+ decl-result
(start (point))
(paren-state (c-parse-state))
(least-enclosing (c-least-enclosing-brace paren-state)))
@@ -1670,12 +1669,19 @@ No indentation or other \"electric\" behavior is
performed."
(not (looking-at c-defun-type-name-decl-key))))))
'at-function-end)
(t
+ ;; Kluge so that c-beginning-of-decl-1 won't go back if we're already
+ ;; at a declaration.
+ (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>"
+ (not (c-looking-at-non-alphnumspace)))
+ (forward-char))
+
(if (and least-enclosing
(eq (char-after least-enclosing) ?\())
(c-go-list-forward least-enclosing))
(c-forward-syntactic-ws)
(setq knr-start (point))
- (if (c-syntactic-re-search-forward "{" nil t t)
+ (if (and (c-syntactic-re-search-forward "[;{]" nil t t)
+ (eq (char-before) ?\{))
(progn
(backward-char)
(cond
@@ -1689,19 +1695,27 @@ No indentation or other \"electric\" behavior is
performed."
((and knr-res
(goto-char knr-res)
(c-backward-syntactic-ws))) ; Always returns nil.
- ((and (eq (char-before) ?\))
- (c-go-list-backward))
- (c-syntactic-skip-backward "^;" start t)
- (if (eq (point) start)
- (if (progn (c-backward-syntactic-ws)
- (memq (char-before) '(?\; ?} nil)))
- (if (progn (c-forward-syntactic-ws)
- (eq (point) start))
- 'at-header
- 'outwith-function)
- 'in-header)
- 'outwith-function))
- (t 'outwith-function)))
+ (t
+ (when (eq (char-before) ?\))
+ ;; The `c-go-list-backward' is a precaution against
+ ;; `c-beginning-of-decl-1' spuriously finding a C++ lambda
+ ;; function inside the parentheses.
+ (c-go-list-backward))
+ (setq decl-result
+ (car (c-beginning-of-decl-1
+ (and least-enclosing
+ (c-safe-position
+ least-enclosing paren-state)))))
+ (cond
+ ((> (point) start)
+ 'outwith-function)
+ ((eq decl-result 'same)
+ (if (eq (point) start)
+ 'at-header
+ 'in-header))
+ (t (error
+ "c-where-wrt-brace-construct: c-beginning-of-decl-1
returned %s"
+ decl-result))))))
'outwith-function))))))
(defun c-backward-to-nth-BOF-{ (n where)
@@ -1810,15 +1824,18 @@ No indentation or other \"electric\" behavior is
performed."
nil)))
(eval-and-compile
- (defmacro c-while-widening-to-decl-block (condition)
+ (defmacro c-while-widening-to-decl-block (condition &optional no-where)
;; Repeatedly evaluate CONDITION until it returns nil. After each
;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards
;; of the next enclosing declaration block (e.g. namespace, class), or the
;; buffer's original restriction.
;;
+ ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'.
+ ;;
;; This is a very special purpose macro, which assumes the existence of
;; several variables. It is for use only in c-beginning-of-defun and
;; c-end-of-defun.
+ (declare (debug t))
`(while
(and ,condition
(eq c-defun-tactic 'go-outward)
@@ -1826,7 +1843,8 @@ No indentation or other \"electric\" behavior is
performed."
(setq paren-state (c-whack-state-after lim paren-state))
(setq lim (c-widen-to-enclosing-decl-scope
paren-state orig-point-min orig-point-max))
- (setq where 'in-block))))
+ ,@(if (not no-where)
+ `((setq where 'in-block))))))
(def-edebug-spec c-while-widening-to-decl-block t)
@@ -2307,11 +2325,11 @@ with a brace block, at the outermost level of nesting."
(c-save-buffer-state ((paren-state (c-parse-state))
(orig-point-min (point-min))
(orig-point-max (point-max))
- lim name limits where)
+ lim name limits)
(setq lim (c-widen-to-enclosing-decl-scope
paren-state orig-point-min orig-point-max))
(and lim (setq lim (1- lim)))
- (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))))
+ (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t)
(when name
(setq limits (c-declaration-limits-1 near))
(cons name limits)))
@@ -2927,10 +2945,13 @@ function does not require the declaration to contain a
brace block."
(c-looking-at-special-brace-list)))
(or allow-early-stop (/= here last))
(save-excursion ; Is this a check that we're NOT at top level?
-;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii)
The next enclosing
-;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense.
-;;;; 2003/8/8 This might have something to do with the GCC extension
"Statement Expressions", e.g.
-;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement
Expressions.
+;;;; NO! This seems to check that (i) EITHER we're at the top level;
+;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM.
+;;;; Doesn't seem to make sense.
+;;;; 2003/8/8 This might have something to do with the GCC extension
+;;;; "Statement Expressions", e.g.
+;;;; while ({stmt1 ; stmt2 ; exp ;}).
+;;;; This form excludes such Statement Expressions.
(or (not (c-safe (up-list -1) t))
(= (char-after) ?{))))
(goto-char last)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 536e676..4f79fa9 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1,4 +1,4 @@
-;;; cc-defs.el --- compile time definitions for CC Mode
+;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t
-*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -125,7 +125,7 @@ The result of the body appears to the compiler as a quoted
constant.
This variant works around bugs in `eval-when-compile' in various
\(X)Emacs versions. See cc-defs.el for details."
-
+ (declare (indent 0) (debug t))
(if c-inside-eval-when-compile
;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it
;; evaluates its body at macro expansion time if it's nested
@@ -170,9 +170,7 @@ This variant works around bugs in `eval-when-compile' in
various
;; constant that we eval. That otoh introduce a problem in
;; that a returned lambda expression doesn't get byte
;; compiled (even if `function' is used).
- (eval '(let ((c-inside-eval-when-compile t)) ,@body)))))
-
- (put 'cc-eval-when-compile 'lisp-indent-hook 0))
+ (eval '(let ((c-inside-eval-when-compile t)) ,@body))))))
;;; Macros.
@@ -181,6 +179,7 @@ This variant works around bugs in `eval-when-compile' in
various
;; between the host [X]Emacsen."
;; The motivation for this macro is to avoid the irritating message
;; "function `mapcan' from cl package called at runtime" produced by Emacs.
+ (declare (debug t))
(cond
((and (fboundp 'mapcan)
(subrp (symbol-function 'mapcan)))
@@ -196,18 +195,21 @@ This variant works around bugs in `eval-when-compile' in
various
(defmacro c--set-difference (liszt1 liszt2 &rest other-args)
;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3.
+ (declare (debug (form form &rest [symbolp form])))
(if (eq c--cl-library 'cl-lib)
`(cl-set-difference ,liszt1 ,liszt2 ,@other-args)
`(set-difference ,liszt1 ,liszt2 ,@other-args)))
(defmacro c--intersection (liszt1 liszt2 &rest other-args)
;; Macro to smooth out the renaming of `intersection' in Emacs 24.3.
+ (declare (debug (form form &rest [symbolp form])))
(if (eq c--cl-library 'cl-lib)
`(cl-intersection ,liszt1 ,liszt2 ,@other-args)
`(intersection ,liszt1 ,liszt2 ,@other-args)))
(eval-and-compile
(defmacro c--macroexpand-all (form &optional environment)
+ (declare (debug t))
;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3.
(if (fboundp 'macroexpand-all)
`(macroexpand-all ,form ,environment)
@@ -215,6 +217,7 @@ This variant works around bugs in `eval-when-compile' in
various
(defmacro c--delete-duplicates (cl-seq &rest cl-keys)
;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3.
+ (declare (debug (form &rest [symbolp form])))
(if (eq c--cl-library 'cl-lib)
`(cl-delete-duplicates ,cl-seq ,@cl-keys)
`(delete-duplicates ,cl-seq ,@cl-keys))))
@@ -222,6 +225,7 @@ This variant works around bugs in `eval-when-compile' in
various
(defmacro c-font-lock-flush (beg end)
"Declare the region BEG...END's fontification as out-of-date.
On XEmacs and older Emacsen, this refontifies that region immediately."
+ (declare (debug t))
(if (fboundp 'font-lock-flush)
`(font-lock-flush ,beg ,end)
`(font-lock-fontify-region ,beg ,end)))
@@ -249,6 +253,7 @@ one of the following symbols:
If the referenced position doesn't exist, the closest accessible point
to it is returned. This function does not modify the point or the mark."
+ (declare (debug t))
(if (eq (car-safe position) 'quote)
(let ((position (eval position)))
(cond
@@ -417,6 +422,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-is-escaped (pos)
;; Are there an odd number of backslashes before POS?
+ (declare (debug t))
`(save-excursion
(goto-char ,pos)
(not (zerop (logand (skip-chars-backward "\\\\") 1)))))
@@ -424,6 +430,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-will-be-escaped (pos beg end)
;; Will the character after POS be escaped after the removal of (BEG END)?
;; It is assumed that (>= POS END).
+ (declare (debug t))
`(save-excursion
(let ((-end- ,end)
count)
@@ -436,6 +443,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-will-be-unescaped (beg)
;; Would the character after BEG be unescaped?
+ (declare (debug t))
`(save-excursion
(let (count)
(goto-char ,beg)
@@ -446,6 +454,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-next-single-property-change (position prop &optional object limit)
;; See the doc string for either of the defuns expanded to.
+ (declare (debug t))
(if (and c-use-extents
(fboundp 'next-single-char-property-change))
;; XEmacs >= 2005-01-25
@@ -455,6 +464,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-previous-single-property-change (position prop &optional object
limit)
;; See the doc string for either of the defuns expanded to.
+ (declare (debug t))
(if (and c-use-extents
(fboundp 'previous-single-char-property-change))
;; XEmacs >= 2005-01-25
@@ -474,6 +484,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-set-region-active (activate)
;; Activate the region if ACTIVE is non-nil, deactivate it
;; otherwise. Covers the differences between Emacs and XEmacs.
+ (declare (debug t))
(if (fboundp 'zmacs-activate-region)
;; XEmacs.
`(if ,activate
@@ -483,6 +494,7 @@ to it is returned. This function does not modify the point
or the mark."
`(setq mark-active ,activate)))
(defmacro c-set-keymap-parent (map parent)
+ (declare (debug t))
(cond
;; XEmacs
((cc-bytecomp-fboundp 'set-keymap-parents)
@@ -495,6 +507,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-delete-and-extract-region (start end)
"Delete the text between START and END and return it."
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'delete-and-extract-region)
;; Emacs 21.1 and later
`(delete-and-extract-region ,start ,end)
@@ -505,15 +518,16 @@ to it is returned. This function does not modify the
point or the mark."
(defmacro c-safe (&rest body)
;; safely execute BODY, return nil if an error occurred
+ (declare (indent 0) (debug t))
`(condition-case nil
(progn ,@body)
(error nil)))
-(put 'c-safe 'lisp-indent-function 0)
(defmacro c-int-to-char (integer)
;; In Emacs, a character is an integer. In XEmacs, a character is a
;; type distinct from an integer. Sometimes we need to convert integers to
;; characters. `c-int-to-char' makes this conversion, if necessary.
+ (declare (debug t))
(if (fboundp 'int-to-char)
`(int-to-char ,integer)
integer))
@@ -521,6 +535,7 @@ to it is returned. This function does not modify the point
or the mark."
(defmacro c-characterp (arg)
;; Return t when ARG is a character (XEmacs) or integer (Emacs), otherwise
;; return nil.
+ (declare (debug t))
(if (integerp ?c)
`(integerp ,arg)
`(characterp ,arg)))
@@ -567,6 +582,7 @@ to it is returned. This function does not modify the point
or the mark."
;; string opener, or after the introductory R of one. The match data is
;; overwritten. On success the opener's identifier will be (match-string
;; 1). Text properties on any characters are ignored.
+ (declare (debug t))
(if pos
`(save-excursion
(goto-char ,pos)
@@ -628,6 +644,7 @@ If BODY makes a change that unconditionally is undone then
wrap this
macro inside `c-save-buffer-state'. That way the change can be done
even when the buffer is read-only, and without interference from
various buffer change hooks."
+ (declare (indent 0) (debug t))
`(let (-tnt-chng-keep
-tnt-chng-state)
(unwind-protect
@@ -638,7 +655,6 @@ various buffer change hooks."
-tnt-chng-state (c-tnt-chng-record-state)
-tnt-chng-keep (progn ,@body))
(c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state))))
-(put 'c-tentative-buffer-changes 'lisp-indent-function 0)
(defun c-tnt-chng-record-state ()
;; Used internally in `c-tentative-buffer-changes'.
@@ -696,6 +712,7 @@ on the wrong side of LIMIT, it stays unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
+ (declare (debug t))
(if limit
`(when (< (point) (or ,limit (point-max)))
(save-restriction
@@ -717,6 +734,7 @@ starts on the wrong side of LIMIT, it stays unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
+ (declare (debug t))
(if limit
`(when (> (point) (or ,limit (point-min)))
(save-restriction
@@ -733,11 +751,13 @@ This is like `forward-sexp' except that it isn't
interactive and does
not do any user friendly adjustments of the point and that it isn't
susceptible to user configurations such as disabling of signals in
certain situations."
+ (declare (debug t))
(or count (setq count 1))
`(goto-char (scan-sexps (point) ,count)))
(defmacro c-backward-sexp (&optional count)
"See `c-forward-sexp' and reverse directions."
+ (declare (debug t))
(or count (setq count 1))
`(c-forward-sexp ,(if (numberp count) (- count) `(- ,count))))
@@ -747,6 +767,7 @@ for unbalanced parens.
A limit for the search may be given. FROM is assumed to be on the
right side of it."
+ (declare (debug t))
(let ((res (if (featurep 'xemacs)
`(scan-lists ,from ,count ,depth nil t)
`(c-safe (scan-lists ,from ,count ,depth)))))
@@ -774,6 +795,7 @@ leave point unmoved.
A LIMIT for the search may be given. The start position is assumed to be
before it."
+ (declare (debug t))
`(let ((dest (c-safe-scan-lists ,(or pos '(point)) 1 0 ,limit)))
(when dest (goto-char dest) dest)))
@@ -784,6 +806,7 @@ leave point unmoved.
A LIMIT for the search may be given. The start position is assumed to be
after it."
+ (declare (debug t))
`(let ((dest (c-safe-scan-lists ,(or pos '(point)) -1 0 ,limit)))
(when dest (goto-char dest) dest)))
@@ -793,6 +816,7 @@ or nil if no such position exists. The point is used if
POS is left out.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) 1 1 ,limit))
(defmacro c-up-list-backward (&optional pos limit)
@@ -801,6 +825,7 @@ or nil if no such position exists. The point is used if
POS is left out.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) -1 1 ,limit))
(defmacro c-down-list-forward (&optional pos limit)
@@ -809,6 +834,7 @@ or nil if no such position exists. The point is used if
POS is left out.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) 1 -1 ,limit))
(defmacro c-down-list-backward (&optional pos limit)
@@ -817,6 +843,7 @@ or nil if no such position exists. The point is used if
POS is left out.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) -1 -1 ,limit))
(defmacro c-go-up-list-forward (&optional pos limit)
@@ -826,6 +853,7 @@ position exists, otherwise nil is returned and the point
isn't moved.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(let ((dest (c-up-list-forward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -836,6 +864,7 @@ position exists, otherwise nil is returned and the point
isn't moved.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(let ((dest (c-up-list-backward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -846,6 +875,7 @@ exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(let ((dest (c-down-list-forward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -856,6 +886,7 @@ exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(let ((dest (c-down-list-backward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -967,6 +998,7 @@ be after it."
;; point)? Always returns nil for languages which don't have Virtual
;; semicolons.
;; This macro might do hidden buffer changes.
+ (declare (debug t))
`(if c-at-vsemi-p-fn
(funcall c-at-vsemi-p-fn ,@(if pos `(,pos)))))
@@ -984,6 +1016,7 @@ be after it."
(defmacro c-benign-error (format &rest args)
;; Formats an error message for the echo area and dings, i.e. like
;; `error' but doesn't abort.
+ (declare (debug t))
`(progn
(message ,format ,@args)
(ding)))
@@ -993,18 +1026,19 @@ be after it."
;; way to execute code.
;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call
;; any forms inside this that call `c-parse-state'. !!!!
+ (declare (indent 1) (debug t))
`(let ((c-with-syntax-table-orig-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ,table)
,@code)
(set-syntax-table c-with-syntax-table-orig-table))))
-(put 'c-with-syntax-table 'lisp-indent-function 1)
(defmacro c-skip-ws-forward (&optional limit)
"Skip over any whitespace following point.
This function skips over horizontal and vertical whitespace and line
continuations."
+ (declare (debug t))
(if limit
`(let ((limit (or ,limit (point-max))))
(while (progn
@@ -1026,6 +1060,7 @@ continuations."
"Skip over any whitespace preceding point.
This function skips over horizontal and vertical whitespace and line
continuations."
+ (declare (debug t))
(if limit
`(let ((limit (or ,limit (point-min))))
(while (progn
@@ -1048,6 +1083,7 @@ continuations."
"Return non-nil if the current CC Mode major mode is MODE.
MODE is either a mode symbol or a list of mode symbols."
+ (declare (debug t))
(if c-langs-are-parametric
;; Inside a `c-lang-defconst'.
`(c-lang-major-mode-is ,mode)
@@ -1130,6 +1166,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; 21) then it's assumed that the property is present on it.
;;
;; This macro does a hidden buffer change.
+ (declare (debug t))
(setq property (eval property))
(if (or c-use-extents
(not (cc-bytecomp-boundp 'text-property-default-nonsticky)))
@@ -1147,6 +1184,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; Get the value of the given property on the character at POS if
;; it's been put there by `c-put-char-property'. PROPERTY is
;; assumed to be constant.
+ (declare (debug t))
(setq property (eval property))
(if c-use-extents
;; XEmacs.
@@ -1177,6 +1215,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; constant.
;;
;; This macro does a hidden buffer change.
+ (declare (debug t))
(setq property (eval property))
(cond (c-use-extents
;; XEmacs.
@@ -1199,6 +1238,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; Return the first position in the range [FROM to) where the text property
;; PROPERTY is set, or `most-positive-fixnum' if there is no such position.
;; PROPERTY should be a quoted constant.
+ (declare (debug t))
`(let ((-from- ,from) (-to- ,to) pos)
(cond
((and (< -from- -to-)
@@ -1220,6 +1260,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; `syntax-table'.
;;
;; This macro does hidden buffer changes.
+ (declare (debug t))
(setq property (eval property))
(if c-use-extents
;; XEmacs.
@@ -1239,6 +1280,7 @@ MODE is either a mode symbol or a list of mode symbols."
(defmacro c-clear-syn-tab-properties (from to)
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
;; properties between FROM and TO.
+ (declare (debug t))
`(let ((-from- ,from) (-to- ,to))
(when (and
c-min-syn-tab-mkr c-max-syn-tab-mkr
@@ -1260,6 +1302,7 @@ LIMIT bounds the search. The comparison is done with
`equal'.
Leave point just after the character, and set the match data on
this character, and return point. If VALUE isn't found, Return
nil; point is then left undefined."
+ (declare (debug t))
`(let ((place (point)))
(while
(and
@@ -1279,6 +1322,7 @@ LIMIT bounds the search. The comparison is done with
`equal'.
Leave point just before the character, set the match data on this
character, and return point. If VALUE isn't found, Return nil;
point is then left undefined."
+ (declare (debug t))
`(let ((place (point)))
(while
(and
@@ -1322,6 +1366,7 @@ been put there by c-put-char-property. POINT remains
unchanged."
which have the value VALUE, as tested by `equal'. These
properties are assumed to be over individual characters, having
been put there by c-put-char-property. POINT remains unchanged."
+ (declare (debug t))
(if c-use-extents
;; XEmacs
`(let ((-property- ,property))
@@ -1342,6 +1387,7 @@ PROPERTY must be a constant.
Leave point just after the character, and set the match data on
this character, and return point. If the search fails, return
nil; point is then left undefined."
+ (declare (debug t))
`(let ((char-skip (concat "^" (char-to-string ,char)))
(-limit- (or ,limit (point-max)))
(-value- ,value))
@@ -1365,6 +1411,7 @@ PROPERTY must be a constant.
Leave point just before the character, and set the match data on
this character, and return point. If the search fails, return
nil; point is then left undefined."
+ (declare (debug t))
`(let ((char-skip (concat "^" (char-to-string ,char)))
(-limit- (or ,limit (point-min)))
(-value- ,value))
@@ -1388,6 +1435,7 @@ PROPERTY must be a constant.
Leave point just after the character, and set the match data on
this character, and return point. If the search fails, return
nil; point is then left undefined."
+ (declare (debug t))
`(let ((char-skip (concat "^" (char-to-string ,char)))
(-limit- (or ,limit (point-max)))
(-value- ,value))
@@ -1436,6 +1484,7 @@ by `equal'. These properties are assumed to be over
individual
characters, having been put there by c-put-char-property. POINT
remains unchanged. Return the position of the first removed
property, or nil."
+ (declare (debug t))
(if c-use-extents
;; XEmacs
`(let ((-property- ,property)
@@ -1459,6 +1508,7 @@ property, or nil."
;; `c-put-char-property' must be a constant.
"Put the text property PROPERTY with value VALUE on characters
with value CHAR in the region [FROM to)."
+ (declare (debug t))
`(let ((skip-string (concat "^" (list ,char)))
(-to- ,to))
(save-excursion
@@ -1481,6 +1531,7 @@ with value CHAR in the region [FROM to)."
;; Put an overlay/extent covering the given range in the current
;; buffer. It's currently undefined whether it's front/end sticky
;; or not. The overlay/extent object is returned.
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'make-overlay)
;; Emacs.
`(let ((ol (make-overlay ,from ,to)))
@@ -1494,6 +1545,7 @@ with value CHAR in the region [FROM to)."
(defmacro c-delete-overlay (overlay)
;; Deletes an overlay/extent object previously retrieved using
;; `c-put-overlay'.
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'make-overlay)
;; Emacs.
`(delete-overlay ,overlay)
@@ -1501,80 +1553,6 @@ with value CHAR in the region [FROM to)."
`(delete-extent ,overlay)))
-;; Make edebug understand the macros.
-;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '(progn
-(def-edebug-spec cc-eval-when-compile (&rest def-form))
-(def-edebug-spec c-font-lock-flush t)
-(def-edebug-spec c--mapcan t)
-(def-edebug-spec c--set-difference (form form &rest [symbolp form]))
-(def-edebug-spec c--intersection (form form &rest [symbolp form]))
-(def-edebug-spec c--delete-duplicates (form &rest [symbolp form]))
-(def-edebug-spec c-point t)
-(def-edebug-spec c-is-escaped t)
-(def-edebug-spec c-will-be-escaped t)
-(def-edebug-spec c-next-single-property-change t)
-(def-edebug-spec c-delete-and-extract-region t)
-(def-edebug-spec c-set-region-active t)
-(def-edebug-spec c-set-keymap-parent t)
-(def-edebug-spec c-safe t)
-(def-edebug-spec c-int-to-char t)
-(def-edebug-spec c-characterp t)
-(def-edebug-spec c-save-buffer-state let*)
-(def-edebug-spec c-tentative-buffer-changes t)
-(def-edebug-spec c-forward-syntactic-ws t)
-(def-edebug-spec c-backward-syntactic-ws t)
-(def-edebug-spec c-forward-sexp t)
-(def-edebug-spec c-backward-sexp t)
-(def-edebug-spec c-safe-scan-lists t)
-(def-edebug-spec c-go-list-forward t)
-(def-edebug-spec c-go-list-backward t)
-(def-edebug-spec c-up-list-forward t)
-(def-edebug-spec c-up-list-backward t)
-(def-edebug-spec c-down-list-forward t)
-(def-edebug-spec c-down-list-backward t)
-(def-edebug-spec c-go-up-list-forward t)
-(def-edebug-spec c-go-up-list-backward t)
-(def-edebug-spec c-go-down-list-forward t)
-(def-edebug-spec c-go-down-list-backward t)
-(def-edebug-spec c-at-vsemi-p t)
-(def-edebug-spec c-add-syntax t)
-(def-edebug-spec c-add-class-syntax t)
-(def-edebug-spec c-benign-error t)
-(def-edebug-spec c-with-syntax-table t)
-(def-edebug-spec c-skip-ws-forward t)
-(def-edebug-spec c-skip-ws-backward t)
-(def-edebug-spec c-major-mode-is t)
-(def-edebug-spec c-search-forward-char-property t)
-(def-edebug-spec c-search-backward-char-property t)
-(def-edebug-spec c-put-char-property t)
-(def-edebug-spec c-put-syn-tab t)
-(def-edebug-spec c-get-char-property t)
-(def-edebug-spec c-clear-char-property t)
-(def-edebug-spec c-clear-syn-tab t)
-;;(def-edebug-spec c-min-property-position nil) ; invoked only by macros
-(def-edebug-spec c-min-property-position t) ; Now invoked from functions
(2019-07)
-(def-edebug-spec c-clear-char-property-with-value t)
-(def-edebug-spec c-clear-char-property-with-value-on-char t)
-(def-edebug-spec c-put-char-properties-on-char t)
-(def-edebug-spec c-clear-char-properties t)
-(def-edebug-spec c-clear-syn-tab-properties t)
-(def-edebug-spec c-with-extended-string-fences (form form body))
-(def-edebug-spec c-put-overlay t)
-(def-edebug-spec c-delete-overlay t)
-(def-edebug-spec c-mark-<-as-paren t)
-(def-edebug-spec c-mark->-as-paren t)
-(def-edebug-spec c-unmark-<->-as-paren t)
-(def-edebug-spec c-with-<->-as-parens-suppressed (body))
-(def-edebug-spec c-self-bind-state-cache (body))
-(def-edebug-spec c-sc-scan-lists-no-category+1+1 t)
-(def-edebug-spec c-sc-scan-lists-no-category+1-1 t)
-(def-edebug-spec c-sc-scan-lists-no-category-1+1 t)
-(def-edebug-spec c-sc-scan-lists-no-category-1-1 t)
-(def-edebug-spec c-sc-scan-lists t)
-(def-edebug-spec c-sc-parse-partial-sexp t);))
-
-
;;; Functions.
;; Note: All these after the macros, to be on safe side in avoiding
@@ -1604,6 +1582,7 @@ with value CHAR in the region [FROM to)."
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
+ (declare (debug t))
(if c-use-category
`(c-put-char-property ,pos 'category 'c-<-as-paren-syntax)
`(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax)))
@@ -1618,6 +1597,7 @@ with value CHAR in the region [FROM to)."
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
+ (declare (debug t))
(if c-use-category
`(c-put-char-property ,pos 'category 'c->-as-paren-syntax)
`(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax)))
@@ -1631,6 +1611,7 @@ with value CHAR in the region [FROM to)."
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
+ (declare (debug t))
`(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table)))
(defsubst c-suppress-<->-as-parens ()
@@ -1651,50 +1632,13 @@ with value CHAR in the region [FROM to)."
;; Like progn, except that the paren property is suppressed on all
;; template brackets whilst they are running. This macro does a hidden
;; buffer change.
+ (declare (debug (body)))
`(unwind-protect
(progn
(c-suppress-<->-as-parens)
,@forms)
(c-restore-<->-as-parens)))
-;;;;;;;;;;;;;;;
-
-(defmacro c-self-bind-state-cache (&rest forms)
- ;; Bind the state cache to itself and execute the FORMS. Return the result
- ;; of the last FORM executed. It is assumed that no buffer changes will
- ;; happen in FORMS, and no hidden buffer changes which could affect the
- ;; parsing will be made by FORMS.
- `(let* ((c-state-cache (copy-tree c-state-cache))
- (c-state-cache-good-pos c-state-cache-good-pos)
- ;(c-state-nonlit-pos-cache (copy-tree c-state-nonlit-pos-cache))
- ;(c-state-nonlit-pos-cache-limit c-state-nonlit-pos-cache-limit)
- ;(c-state-semi-nonlit-pos-cache (copy-tree
c-state-semi-nonlit-pos-cache))
- ;(c-state-semi-nonlit-pos-cache-limit c-state-semi-nonlit-pos-cache)
- (c-state-brace-pair-desert (copy-tree c-state-brace-pair-desert))
- (c-state-point-min c-state-point-min)
- (c-state-point-min-lit-type c-state-point-min-lit-type)
- (c-state-point-min-lit-start c-state-point-min-lit-start)
- (c-state-min-scan-pos c-state-min-scan-pos)
- (c-state-old-cpp-beg-marker (if (markerp c-state-old-cpp-beg-marker)
- (copy-marker
c-state-old-cpp-beg-marker)
- c-state-old-cpp-beg-marker))
- (c-state-old-cpp-beg (if (markerp c-state-old-cpp-beg)
- c-state-old-cpp-beg-marker
- c-state-old-cpp-beg))
- (c-state-old-cpp-end-marker (if (markerp c-state-old-cpp-end-marker)
- (copy-marker
c-state-old-cpp-end-marker)
- c-state-old-cpp-end-marker))
- (c-state-old-cpp-end (if (markerp c-state-old-cpp-end)
- c-state-old-cpp-end-marker
- c-state-old-cpp-end))
- (c-parse-state-state c-parse-state-state))
- (prog1
- (progn ,@forms)
- (if (markerp c-state-old-cpp-beg-marker)
- (move-marker c-state-old-cpp-beg-marker nil))
- (if (markerp c-state-old-cpp-end-marker)
- (move-marker c-state-old-cpp-end-marker nil)))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following macros are to be used only in `c-parse-state' and its
;; subroutines. Their main purpose is to simplify the handling of C++/Java
@@ -1708,6 +1652,7 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is
;; determined by and angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ (declare (debug t))
`(let ((here (point))
(pos (scan-lists ,from 1 1)))
(while (eq (char-before pos) ?>)
@@ -1718,6 +1663,7 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is
;; determined by an angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ (declare (debug t))
`(let ((here (point))
(pos (scan-lists ,from 1 -1)))
(while (eq (char-before pos) ?<)
@@ -1729,6 +1675,7 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is
;; determined by and angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ (declare (debug t))
`(let ((here (point))
(pos (scan-lists ,from -1 1)))
(while (eq (char-after pos) ?<)
@@ -1739,6 +1686,7 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is
;; determined by and angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ (declare (debug t))
`(let ((here (point))
(pos (scan-lists ,from -1 -1)))
(while (eq (char-after pos) ?>)
@@ -1747,6 +1695,7 @@ with value CHAR in the region [FROM to)."
pos))
(defmacro c-sc-scan-lists (from count depth)
+ (declare (debug t))
(if c-use-category
`(scan-lists ,from ,count ,depth)
(cond
@@ -1794,6 +1743,7 @@ with value CHAR in the region [FROM to)."
(defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore
oldstate)
+ (declare (debug t))
(if c-use-category
`(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate)
`(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore
@@ -2354,6 +2304,7 @@ system."
"Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
immediately, i.e. at the same time as the `c-lang-defconst' form
itself is evaluated."
+ (declare (debug t))
;; Evaluate at macro expansion time, i.e. in the
;; `c--macroexpand-all' inside `c-lang-defconst'.
(eval form))
@@ -2396,7 +2347,8 @@ one `c-lang-defconst' for each NAME is permitted per
file. If there
already is one it will be completely replaced; the value in the
earlier definition will not affect `c-lang-const' on the same
constant. A file is identified by its base name."
-
+ (declare (indent 1)
+ (debug (&define name [&optional stringp] [&rest sexp def-form])))
(let* ((sym (intern (symbol-name name) c-lang-constants))
;; Make `c-lang-const' expand to a straightforward call to
;; `c-get-lang-constant' in `c--macroexpand-all' below.
@@ -2487,12 +2439,6 @@ constant. A file is identified by its base name."
(c-define-lang-constant ',name ,bindings
,@(and pre-files `(',pre-files))))))
-(put 'c-lang-defconst 'lisp-indent-function 1)
-;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '
-(def-edebug-spec c-lang-defconst
- (&define name [&optional stringp] [&rest sexp def-form]))
-
(defun c-define-lang-constant (name bindings &optional pre-files)
;; Used by `c-lang-defconst'.
@@ -2548,6 +2494,7 @@ LANG is the name of the language, i.e. the mode name
without the
language. NAME and LANG are not evaluated so they should not be
quoted."
+ (declare (debug (name &optional symbolp)))
(or (symbolp name)
(error "Not a symbol: %S" name))
(or (symbolp lang)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index cc9833a..622d951 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,4 +1,4 @@
-;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8
-*-
+;;; cc-engine.el --- core syntax guessing engine for CC mode -*-
lexical-binding:t; coding: utf-8 -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -163,6 +163,8 @@
(defvar c-doc-line-join-re)
(defvar c-doc-bright-comment-start-re)
(defvar c-doc-line-join-end-ch)
+(defvar c-syntactic-context)
+(defvar c-syntactic-element)
(cc-bytecomp-defvar c-min-syn-tab-mkr)
(cc-bytecomp-defvar c-max-syn-tab-mkr)
(cc-bytecomp-defun c-clear-syn-tab)
@@ -735,6 +737,7 @@ comment at the start of cc-engine.el for more info."
'(setq stack (cons (cons state saved-pos)
stack)))
(defmacro c-bos-pop-state (&optional do-if-done)
+ (declare (debug t))
`(if (setq state (car (car stack))
saved-pos (cdr (car stack))
stack (cdr stack))
@@ -759,6 +762,7 @@ comment at the start of cc-engine.el for more info."
(goto-char pos)
(setq sym nil)))
(defmacro c-bos-save-error-info (missing got)
+ (declare (debug t))
`(setq saved-pos (vector pos ,missing ,got)))
(defmacro c-bos-report-error ()
'(unless noerror
@@ -1869,51 +1873,51 @@ comment at the start of cc-engine.el for more info."
; (setq in-face (point)))
; (not (eobp)))))))
-(defmacro c-debug-sws-msg (&rest args)
- (ignore args)
+(defmacro c-debug-sws-msg (&rest _args)
+ ;; (declare (debug t))
;;`(message ,@args)
)
(defmacro c-put-is-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(put-text-property beg end 'c-is-sws t)
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-add-face beg end 'c-debug-is-sws-face)))))
-(def-edebug-spec c-put-is-sws t)
(defmacro c-put-in-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(put-text-property beg end 'c-in-sws t)
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-add-face beg end 'c-debug-in-sws-face)))))
-(def-edebug-spec c-put-in-sws t)
(defmacro c-remove-is-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(remove-text-properties beg end '(c-is-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-is-sws-face)))))
-(def-edebug-spec c-remove-is-sws t)
(defmacro c-remove-in-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(remove-text-properties beg end '(c-in-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-in-sws-face)))))
-(def-edebug-spec c-remove-in-sws t)
(defmacro c-remove-is-and-in-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(remove-text-properties beg end '(c-is-sws nil c-in-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-is-sws-face)
(c-debug-remove-face beg end 'c-debug-in-sws-face)))))
-(def-edebug-spec c-remove-is-and-in-sws t)
;; The type of literal position `end' is in a `before-change-functions'
;; function - one of `c', `c++', `pound', `noise', `attribute' or nil (but NOT
@@ -2717,9 +2721,9 @@ comment at the start of cc-engine.el for more info."
;; two char construct (such as a comment opener or an escaped character).)
(if (and (consp elt) (>= (length elt) 3))
;; Inside a string or comment
- (let ((depth 0) (containing nil) (last nil)
+ (let ((depth 0) (containing nil)
in-string in-comment
- (min-depth 0) com-style com-str-start (intermediate nil)
+ (min-depth 0) com-style com-str-start
(char-1 (nth 3 elt)) ; first char of poss. 2-char construct
(pos (car elt))
(type (cadr elt)))
@@ -2736,14 +2740,13 @@ comment at the start of cc-engine.el for more info."
(1- pos)
pos))
(if (memq 'pps-extended-state c-emacs-features)
- (list depth containing last
+ (list depth containing nil
in-string in-comment nil
min-depth com-style com-str-start
- intermediate nil)
- (list depth containing last
+ nil nil)
+ (list depth containing nil
in-string in-comment nil
- min-depth com-style com-str-start
- intermediate)))
+ min-depth com-style com-str-start nil)))
;; Not in a string or comment.
(if (memq 'pps-extended-state c-emacs-features)
@@ -3516,6 +3519,7 @@ mhtml-mode."
(defmacro c-state-cache-top-lparen (&optional cache)
;; Return the address of the top left brace/bracket/paren recorded in CACHE
;; (default `c-state-cache') (or nil).
+ (declare (debug t))
(let ((cash (or cache 'c-state-cache)))
`(if (consp (car ,cash))
(caar ,cash)
@@ -3524,6 +3528,7 @@ mhtml-mode."
(defmacro c-state-cache-top-paren (&optional cache)
;; Return the address of the latest brace/bracket/paren (whether left or
;; right) recorded in CACHE (default `c-state-cache') or nil.
+ (declare (debug t))
(let ((cash (or cache 'c-state-cache)))
`(if (consp (car ,cash))
(cdar ,cash)
@@ -3532,6 +3537,7 @@ mhtml-mode."
(defmacro c-state-cache-after-top-paren (&optional cache)
;; Return the position just after the latest brace/bracket/paren (whether
;; left or right) recorded in CACHE (default `c-state-cache') or nil.
+ (declare (debug t))
(let ((cash (or cache 'c-state-cache)))
`(if (consp (car ,cash))
(cdar ,cash)
@@ -4486,6 +4492,7 @@ mhtml-mode."
(defmacro c-state-maybe-marker (place marker)
;; If PLACE is non-nil, return a marker marking it, otherwise nil.
;; We (re)use MARKER.
+ (declare (debug (form symbolp)))
`(let ((-place- ,place))
(and -place-
(or ,marker (setq ,marker (make-marker)))
@@ -5972,6 +5979,7 @@ comment at the start of cc-engine.el for more info."
; spots and the preceding token end.")
(defmacro c-debug-put-decl-spot-faces (match-pos decl-pos)
+ (declare (debug t))
(when (facep 'c-debug-decl-spot-face)
`(c-save-buffer-state ((match-pos ,match-pos) (decl-pos ,decl-pos))
(c-debug-add-face (max match-pos (point-min)) decl-pos
@@ -5979,6 +5987,7 @@ comment at the start of cc-engine.el for more info."
(c-debug-add-face decl-pos (min (1+ decl-pos) (point-max))
'c-debug-decl-spot-face))))
(defmacro c-debug-remove-decl-spot-faces (beg end)
+ (declare (debug t))
(when (facep 'c-debug-decl-spot-face)
`(c-save-buffer-state ()
(c-debug-remove-face ,beg ,end 'c-debug-decl-spot-face)
@@ -7773,6 +7782,7 @@ comment at the start of cc-engine.el for more info."
(defvar c-last-identifier-range nil)
(defmacro c-record-type-id (range)
+ (declare (debug t))
(if (eq (car-safe range) 'cons)
;; Always true.
`(setq c-record-type-identifiers
@@ -7783,6 +7793,7 @@ comment at the start of cc-engine.el for more info."
(cons range c-record-type-identifiers))))))
(defmacro c-record-ref-id (range)
+ (declare (debug t))
(if (eq (car-safe range) 'cons)
;; Always true.
`(setq c-record-ref-identifiers
@@ -7808,6 +7819,7 @@ comment at the start of cc-engine.el for more info."
;; if TYPE is 'type or as a reference if TYPE is 'ref.
;;
;; This macro might do hidden buffer changes.
+ (declare (debug t))
`(let (res)
(setq c-last-identifier-range nil)
(while (if (setq res ,(if (eq type 'type)
@@ -7832,6 +7844,7 @@ comment at the start of cc-engine.el for more info."
;; `c-forward-keyword-prefixed-id'.
;;
;; This macro might do hidden buffer changes.
+ (declare (debug t))
`(while (and (progn
,(when update-safe-pos
'(setq safe-pos (point)))
@@ -8775,6 +8788,7 @@ comment at the start of cc-engine.el for more info."
(defmacro c-pull-open-brace (ps)
;; Pull the next open brace from PS (which has the form of paren-state),
;; skipping over any brace pairs. Returns NIL when PS is exhausted.
+ (declare (debug (symbolp)))
`(progn
(while (consp (car ,ps))
(setq ,ps (cdr ,ps)))
@@ -8890,6 +8904,7 @@ comment at the start of cc-engine.el for more info."
;; a comma. If either of <symbol> or bracketed <expression> is missing,
;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil
;; to 'done. This is not a general purpose macro!
+ (declare (debug t))
`(while (eq (char-before) ?,)
(backward-char)
(c-backward-syntactic-ws ,limit)
@@ -9283,6 +9298,7 @@ This function might do hidden buffer changes."
;; sometimes consumes the identifier in the declaration as a type.
;; This is used to "backtrack" and make the last type be treated as
;; an identifier instead.
+ (declare (debug nil))
`(progn
,(unless short
;; These identifiers are bound only in the inner let.
@@ -14686,18 +14702,6 @@ Cannot combine absolute offsets %S and %S in `add'
method"
indent)))
-(def-edebug-spec c-bos-pop-state t)
-(def-edebug-spec c-bos-save-error-info t)
-(def-edebug-spec c-state-cache-top-lparen t)
-(def-edebug-spec c-state-cache-top-paren t)
-(def-edebug-spec c-state-cache-after-top-paren t)
-(def-edebug-spec c-state-maybe-marker (form symbolp))
-(def-edebug-spec c-record-type-id t)
-(def-edebug-spec c-record-ref-id t)
-(def-edebug-spec c-forward-keyword-prefixed-id t)
-(def-edebug-spec c-forward-id-comma-list t)
-(def-edebug-spec c-pull-open-brace (symbolp))
-
(cc-provide 'cc-engine)
;; Local Variables:
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 4e28376..fdef084 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,4 +1,4 @@
-;;; cc-fonts.el --- font lock support for CC Mode
+;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -218,6 +218,7 @@
;; incorrectly.
;;
;; This function does a hidden buffer change.
+ (declare (debug t))
(if (fboundp 'font-lock-set-face)
;; Note: This function has no docstring in XEmacs so it might be
;; considered internal.
@@ -228,6 +229,7 @@
;; This is the inverse of `c-put-font-lock-face'.
;;
;; This function does a hidden buffer change.
+ (declare (debug t))
(if (fboundp 'font-lock-remove-face)
`(font-lock-remove-face ,from ,to)
`(remove-text-properties ,from ,to '(face nil))))
@@ -238,11 +240,13 @@
;; region should include them.
;;
;; This function does a hidden buffer change.
+ (declare (debug t))
(if (featurep 'xemacs)
`(c-put-font-lock-face (1+ ,from) (1- ,to) 'font-lock-string-face)
`(c-put-font-lock-face ,from ,to 'font-lock-string-face)))
(defmacro c-fontify-types-and-refs (varlist &rest body)
+ (declare (indent 1) (debug let*))
;; Like `let', but additionally activates `c-record-type-identifiers'
;; and `c-record-ref-identifiers', and fontifies the recorded ranges
;; accordingly on exit.
@@ -253,7 +257,6 @@
,@varlist)
(prog1 (progn ,@body)
(c-fontify-recorded-types-and-refs))))
- (put 'c-fontify-types-and-refs 'lisp-indent-function 1)
(defun c-skip-comments-and-strings (limit)
;; If the point is within a region fontified as a comment or
@@ -482,20 +485,7 @@
;; In the next form, check that point hasn't been moved beyond
;; `limit' in any of the above stanzas.
,(c-make-font-lock-search-form (car normal) (cdr normal) t)
- nil))))
-
-; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '(progn
-(def-edebug-spec c-put-font-lock-face t)
-(def-edebug-spec c-remove-font-lock-face t)
-(def-edebug-spec c-put-font-lock-string-face t)
- (def-edebug-spec c-fontify-types-and-refs let*)
- (def-edebug-spec c-make-syntactic-matcher t)
- ;; If there are literal quoted or backquoted highlight specs in
- ;; the call to `c-make-font-lock-search-function' then let's
- ;; instrument the forms in them.
- (def-edebug-spec c-make-font-lock-search-function
- (form &rest &or ("quote" (&rest form)) ("`" (&rest form)) form)));))
+ nil)))))
(defun c-fontify-recorded-types-and-refs ()
;; Convert the ranges recorded on `c-record-type-identifiers' and
@@ -2287,7 +2277,7 @@ need for `c-font-lock-extra-types'.")
;; font-lock-keyword-face. It always returns NIL to inhibit this and
;; prevent a repeat invocation. See elisp/lispref page "Search-based
;; fontification".
- (let (pos after-name)
+ (let (pos)
(while (c-syntactic-re-search-forward c-using-key limit 'end)
(while ; Do one declarator of a comma separated list, each time around.
(progn
@@ -2295,7 +2285,6 @@ need for `c-font-lock-extra-types'.")
(setq pos (point)) ; token after "using".
(when (and (c-on-identifier)
(c-forward-name))
- (setq after-name (point))
(cond
((eq (char-after) ?=) ; using foo = <type-id>;
(goto-char pos)
@@ -2305,7 +2294,8 @@ need for `c-font-lock-extra-types'.")
(c-go-up-list-backward)
(eq (char-after) ?{)
(eq (car (c-beginning-of-decl-1
- (c-determine-limit 1000))) 'same)
+ (c-determine-limit 1000)))
+ 'same)
(looking-at c-colon-type-list-re)))
;; Inherited protected member: leave unfontified
)
@@ -2712,6 +2702,7 @@ need for `pike-font-lock-extra-types'.")
(defmacro c-set-doc-comment-re-element (suffix)
;; Set the variable `c-doc-line-join-re' to a buffer local value suitable
;; for the current doc comment style, or kill the local value.
+ (declare (debug t))
(let ((var (intern (concat "c-doc" suffix))))
`(let* ((styles (c-get-doc-comment-style))
elts)
@@ -2738,6 +2729,7 @@ need for `pike-font-lock-extra-types'.")
(defmacro c-set-doc-comment-char-list (suffix)
;; Set the variable 'c-doc-<suffix>' to the list of *-<suffix>, which must
;; be characters, and * represents the doc comment style.
+ (declare (debug t))
(let ((var (intern (concat "c-doc" suffix))))
`(let* ((styles (c-get-doc-comment-style))
elts)
@@ -2783,7 +2775,7 @@ need for `pike-font-lock-extra-types'.")
;; is used as a flag in other code to skip comments.
;;
;; This function might do hidden buffer changes.
-
+ (declare (indent 2))
(let (comment-beg region-beg)
(if (memq (get-text-property (point) 'face)
'(font-lock-comment-face font-lock-comment-delimiter-face))
@@ -2866,7 +2858,6 @@ need for `pike-font-lock-extra-types'.")
(goto-char region-end)))))
nil)
-(put 'c-font-lock-doc-comments 'lisp-indent-function 2)
(defun c-find-invalid-doc-markup (regexp limit)
;; Used to fontify invalid markup in doc comments after the correct
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index 1b852ec..9c88c14 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -1,4 +1,4 @@
-;;; cc-guess.el --- guess indentation values by scanning existing code
+;;; cc-guess.el --- guess indentation values by scanning existing code -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software
;; Foundation, Inc.
@@ -58,7 +58,7 @@
;;
;; If you want to reuse the guessed style in future emacs sessions,
;; you may want to put it to your .emacs. `c-guess-view' is for
-;; you. It emits emacs lisp code which defines the last guessed
+;; you. It emits Emacs Lisp code which defines the last guessed
;; style, in a temporary buffer. You can put the emitted code into
;; your .emacs. This command was suggested by Alan Mackenzie.
@@ -527,7 +527,7 @@ is called with one argument, the guessed style."
(cdr needs-markers)))))
(defun c-guess-view (&optional with-name)
- "Emit emacs lisp code which defines the last guessed style.
+ "Emit Emacs Lisp code which defines the last guessed style.
So you can put the code into .emacs if you prefer the
guessed code.
\"STYLE NAME HERE\" is used as the name for the style in the
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index fa4e730..70b0d13 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1,4 +1,4 @@
-;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8
-*-
+;;; cc-langs.el --- language specific settings for CC Mode -*-
lexical-binding: t; coding: utf-8 -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -159,7 +159,9 @@ evaluated and bound to VAR when the result from the macro
`c-lang-const' is typically used in VAL to get the right value for the
language being initialized, and such calls will be macro expanded to
the evaluated constant value at compile time."
-
+ (declare (indent defun)
+ (debug (&define name def-form
+ &optional &or ("quote" symbolp) stringp)))
(when (and (not doc)
(eq (car-safe val) 'c-lang-const)
(eq (nth 1 val) var)
@@ -191,6 +193,7 @@ Emacs variable like `comment-start'.
`c-lang-const' is typically used in VAL to get the right value for the
language being initialized, and such calls will be macro expanded to
the evaluated constant value at compile time."
+ (declare (debug (&define name def-form)))
(let ((elem (assq var (cdr c-emacs-variable-inits))))
(if elem
(setcdr elem (list val)) ; Maybe remove "list", sometime. 2006-07-19
@@ -200,13 +203,6 @@ the evaluated constant value at compile time."
;; Return the symbol, like the other def* forms.
`',var)
-(put 'c-lang-defvar 'lisp-indent-function 'defun)
-; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '
-(def-edebug-spec c-lang-defvar
- (&define name def-form &optional &or ("quote" symbolp) stringp))
-(def-edebug-spec c-lang-setvar (&define name def-form))
-
;; Suppress "might not be defined at runtime" warning.
;; This file is only used when compiling other cc files.
(declare-function cl-delete-duplicates "cl-seq" (cl-seq &rest cl-keys))
@@ -378,12 +374,14 @@ The syntax tables aren't stored directly since they're
quite large."
(let ((table (make-syntax-table)))
(c-populate-syntax-table table)
;; Mode specific syntaxes.
- ,(cond ((or (c-major-mode-is 'objc-mode) (c-major-mode-is 'java-mode))
+ ,(cond ((c-major-mode-is 'objc-mode)
;; Let '@' be part of symbols in ObjC to cope with
;; its compiler directives as single keyword tokens.
;; This is then necessary since it's assumed that
;; every keyword is a single symbol.
'(modify-syntax-entry ?@ "_" table))
+ ((c-major-mode-is 'java-mode)
+ '(modify-syntax-entry ?@ "'" table))
((c-major-mode-is 'pike-mode)
'(modify-syntax-entry ?@ "." table)))
table)))
@@ -579,14 +577,12 @@ don't have EOL terminated statements. "
(c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn))
(c-lang-defconst c-vsemi-status-unknown-p-fn
- "Contains a predicate regarding the presence of virtual semicolons.
-More precisely, the function answers the question, \"are we unsure whether a
-virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of
-such a function is to prevent an infinite recursion in
-`c-beginning-of-statement-1' when point starts at a `while' token. The
function
-MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even
-indirectly. This variable contains nil for languages which don't have EOL
-terminated statements."
+ "A function \"are we unsure whether there is a virtual semicolon on this
line?\".
+The (admittedly kludgy) purpose of such a function is to prevent an infinite
+recursion in c-beginning-of-statement-1 when point starts at a `while' token.
+The function MUST NOT UNDER ANY CIRCUMSTANCES call
`c-beginning-of-statement-1',
+even indirectly. This variable contains nil for languages which don't have
+EOL terminated statements."
t nil
(c c++ objc) 'c-macro-vsemi-status-unknown-p
awk 'c-awk-vsemi-status-unknown-p)
@@ -4093,6 +4089,7 @@ accomplish that conveniently."
This macro is expanded at compile time to a form tailored for the mode
in question, so MODE must be a constant. Therefore MODE is not
evaluated and should not be quoted."
+ (declare (debug nil))
`(funcall ,(c-make-init-lang-vars-fun mode)))
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 0ff6efb..a099ec1 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -1,4 +1,4 @@
-;;; cc-menus.el --- imenu support for CC Mode
+;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index cfb23d0..a8f1662 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,4 +1,4 @@
-;;; cc-mode.el --- major mode for editing C and similar languages
+;;; cc-mode.el --- major mode for editing C and similar languages -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -969,6 +969,7 @@ Note that the style variables are always made local to the
buffer."
(defmacro c-run-mode-hooks (&rest hooks)
;; Emacs 21.1 has introduced a system with delayed mode hooks that
;; requires the use of the new function `run-mode-hooks'.
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'run-mode-hooks)
`(run-mode-hooks ,@hooks)
`(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks))))
@@ -2503,6 +2504,7 @@ This function is called from `c-common-init', once per
mode initialization."
;; Emacs < 22 and XEmacs
(defmacro c-advise-fl-for-region (function)
+ (declare (debug t))
`(defadvice ,function (before get-awk-region activate)
;; Make sure that any string/regexp is completely font-locked.
(when c-buffer-is-cc-mode
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 29cbe54..77cad77 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -1,4 +1,4 @@
-;;; cc-styles.el --- support for styles in CC Mode
+;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is
non-nil."
offset))
;;;###autoload
-(defun c-set-offset (symbol offset &optional ignored)
+(defun c-set-offset (symbol offset &optional _ignored)
"Change the value of a syntactic element symbol in `c-offsets-alist'.
SYMBOL is the syntactic element symbol to change and OFFSET is the new
offset 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 88ee092..b33fea0 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1,4 +1,4 @@
-;;; cc-vars.el --- user customization variables for CC Mode
+;;; cc-vars.el --- user customization variables for CC Mode -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -42,6 +42,9 @@
(cc-require 'cc-defs)
+(defvar c-syntactic-context)
+(defvar c-syntactic-element)
+
(cc-eval-when-compile
(require 'custom)
(require 'widget))
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 820867a..edcd88c 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -1,7 +1,6 @@
-;;; cmacexp.el --- expand C macros in a region
+;;; cmacexp.el --- expand C macros in a region -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: Francesco Potortì <pot@gnu.org>
;; Adapted-By: ESR
@@ -33,20 +32,20 @@
;; USAGE =============================================================
-;; In C mode C-C C-e is bound to c-macro-expand. The result of the
+;; In C mode C-c C-e is bound to `c-macro-expand'. The result of the
;; expansion is put in a separate buffer. A user option allows the
;; window displaying the buffer to be optimally sized.
;;
-;; When called with a C-u prefix, c-macro-expand replaces the selected
+;; When called with a C-u prefix, `c-macro-expand' replaces the selected
;; region with the expansion. Both the preprocessor name and the
-;; initial flag can be set by the user. If c-macro-prompt-flag is set
+;; initial flag can be set by the user. If `c-macro-prompt-flag' is set
;; to a non-nil value the user is offered to change the options to the
-;; preprocessor each time c-macro-expand is invoked. Preprocessor
-;; arguments default to the last ones entered. If c-macro-prompt-flag
+;; preprocessor each time `c-macro-expand' is invoked. Preprocessor
+;; arguments default to the last ones entered. If `c-macro-prompt-flag'
;; is nil, one must use M-x set-variable to set a different value for
-;; c-macro-cppflags.
+;; `c-macro-cppflags'.
-;; A c-macro-expansion function is provided for non-interactive use.
+;; A `c-macro-expansion' function is provided for non-interactive use.
;; INSTALLATION ======================================================
@@ -54,18 +53,22 @@
;; If you want the *Macroexpansion* window to be not higher than
;; necessary:
-;;(setq c-macro-shrink-window-flag t)
+;;
+;; (setq c-macro-shrink-window-flag t)
;;
;; If you use a preprocessor other than /lib/cpp (be careful to set a
;; -C option or equivalent in order to make the preprocessor not to
;; strip the comments):
-;;(setq c-macro-preprocessor "gpp -C")
+;;
+;; (setq c-macro-preprocessor "gpp -C")
;;
;; If you often use a particular set of flags:
-;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG"
+;;
+;; (setq c-macro-cppflags "-I /usr/include/local -DDEBUG"
;;
;; If you want the "Preprocessor arguments: " prompt:
-;;(setq c-macro-prompt-flag t)
+;;
+;; (setq c-macro-prompt-flag t)
;; BUG REPORTS =======================================================
@@ -87,16 +90,12 @@
(require 'cc-mode)
-(provide 'cmacexp)
-
(defvar msdos-shells)
-
(defgroup c-macro nil
"Expand C macros in a region."
:group 'c)
-
(defcustom c-macro-shrink-window-flag nil
"Non-nil means shrink the *Macroexpansion* window to fit its contents."
:type 'boolean)
@@ -392,4 +391,6 @@ Optional arg DISPLAY non-nil means show messages in the
echo area."
;; Cleanup.
(kill-buffer outbuf))))
+(provide 'cmacexp)
+
;;; cmacexp.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 8ade718..203712f 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -496,7 +496,7 @@ functions are annotated with \"<f>\" via the
(end
(unless (or (eq beg (point-max))
(member (char-syntax (char-after beg))
- '(?\s ?\" ?\( ?\))))
+ '(?\" ?\()))
(condition-case nil
(save-excursion
(goto-char beg)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 8481a27..e10602a 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
a (BEG . END) pair of buffer positions indicating that this
report applies to that region."
(let* ((state (gethash backend flymake--backend-state))
- (first-report (not (flymake--backend-state-reported-p state))))
+ first-report)
+ (unless state
+ (error "Can't find state for %s in `flymake--backend-state'" backend))
+ (setf first-report (not (flymake--backend-state-reported-p state)))
(setf (flymake--backend-state-reported-p state) t)
(let (expected-token
new-diags)
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index a0f5d36..cd92175 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -321,10 +321,6 @@ separators (like underscores) at places they belong to."
(remove-hook 'write-file-functions
'glasses-convert-to-unreadable t)))))
-
-;;; Announce
-
(provide 'glasses)
-
;;; glasses.el ends here
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index b105cba..a37477d 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -293,6 +293,10 @@ Used to gray out relevant toolbar icons.")
(tool-bar-local-item-from-menu
(car x) (cdr x) map gud-minor-mode-map))))
+(defvar gud-repeat-map (make-sparse-keymap)
+ "Keymap to repeat gud stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-file-name (f)
"Transform a relative file name to an absolute file name.
Uses `gud-<MINOR-MODE>-directories' to find the source files."
@@ -784,6 +788,17 @@ the buffer in which this command was invoked."
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
+ (dolist (cmd '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key gud-repeat-map (car cmd) (cdr cmd))
+ (put (cdr cmd) 'repeat-map 'gud-repeat-map))
+
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
(setq-local gud-gdb-completion-function 'gud-gdb-completions)
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index a590148..5026844 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -942,9 +942,6 @@ The environment marked is the one that contains point or
follows point."
(list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
(list "" 'ispell-complete-word))))
-
-;;; Just in case ...
-
(provide 'meta-mode)
(run-hooks 'meta-mode-load-hook)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 3dd1111..1023b75 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -296,7 +296,7 @@ to find the list of ignores for each directory."
;; Make sure ~/ etc. in local directory name is
;; expanded and not left for the shell command
;; to interpret.
- (localdir (file-local-name (expand-file-name dir)))
+ (localdir (file-name-unquote (file-local-name (expand-file-name
dir))))
(command (format "%s %s %s -type f %s -print0"
find-program
;; In case DIR is a symlink.
@@ -311,16 +311,25 @@ to find the list of ignores for each directory."
(concat " -o " find-name-arg " "))
" "
(shell-quote-argument ")"))
- ""))))
+ "")))
+ (output (with-output-to-string
+ (with-current-buffer standard-output
+ (let ((status
+ (process-file-shell-command command nil t)))
+ (unless (zerop status)
+ (error "File listing failed: %s"
(buffer-string))))))))
(project--remote-file-names
- (sort (split-string (shell-command-to-string command) "\0" t)
+ (sort (split-string output "\0" t)
#'string<))))
(defun project--remote-file-names (local-files)
- "Return LOCAL-FILES as if they were on the system of `default-directory'."
+ "Return LOCAL-FILES as if they were on the system of `default-directory'.
+Also quote LOCAL-FILES if `default-directory' is quoted."
(let ((remote-id (file-remote-p default-directory)))
(if (not remote-id)
- local-files
+ (if (file-name-quoted-p default-directory)
+ (mapcar #'file-name-quote local-files)
+ local-files)
(mapcar (lambda (file)
(concat remote-id file))
local-files))))
@@ -1322,7 +1331,7 @@ are legal even if they aren't listed in the dispatch
menu."
key tmp)))
(let ((key (if key
(vector key)
- (where-is-internal cmd project-prefix-map t))))
+ (where-is-internal cmd (list project-prefix-map) t))))
(format "[%s] %s"
(propertize (key-description key) 'face 'bold)
label)))
@@ -1338,28 +1347,36 @@ made from `project-switch-commands'.
When called in a program, it will use the project corresponding
to directory DIR."
(interactive (list (project-prompt-project-dir)))
- (let ((commands-menu
- (mapcar
- (lambda (row)
- (if (characterp (car row))
- ;; Deprecated format.
- ;; XXX: Add a warning about it?
- (reverse row)
- row))
- project-switch-commands))
- command)
+ (let* ((commands-menu
+ (mapcar
+ (lambda (row)
+ (if (characterp (car row))
+ ;; Deprecated format.
+ ;; XXX: Add a warning about it?
+ (reverse row)
+ row))
+ project-switch-commands))
+ (commands-map
+ (let ((temp-map (make-sparse-keymap)))
+ (set-keymap-parent temp-map project-prefix-map)
+ (dolist (row commands-menu temp-map)
+ (when-let ((cmd (nth 0 row))
+ (keychar (nth 2 row)))
+ (define-key temp-map (vector keychar) cmd)))))
+ command)
(while (not command)
- (let ((choice (read-event (project--keymap-prompt))))
- (when (setq command
- (or (car
- (seq-find (lambda (row) (equal choice (nth 2 row)))
- commands-menu))
- (lookup-key project-prefix-map (vector choice))))
+ (let ((overriding-local-map commands-map)
+ (choice (read-key-sequence (project--keymap-prompt))))
+ (when (setq command (lookup-key commands-map choice))
(unless (or project-switch-use-entire-map
(assq command commands-menu))
;; TODO: Add some hint to the prompt, like "key not
;; recognized" or something.
- (setq command nil)))))
+ (setq command nil)))
+ (let ((global-command (lookup-key (current-global-map) choice)))
+ (when (memq global-command
+ '(keyboard-quit keyboard-escape-quit))
+ (call-interactively global-command)))))
(let ((default-directory dir)
(project-current-inhibit-prompt t))
(call-interactively command))))
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 598f748..67c034d 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -1,4 +1,4 @@
-;;; ps-mode.el --- PostScript mode for GNU Emacs
+;;; ps-mode.el --- PostScript mode for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
@@ -281,20 +281,20 @@ If nil, use `temporary-file-directory'."
(defvar ps-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-v" 'ps-run-boundingbox)
- (define-key map "\C-c\C-u" 'ps-mode-uncomment-region)
- (define-key map "\C-c\C-t" 'ps-mode-epsf-rich)
- (define-key map "\C-c\C-s" 'ps-run-start)
- (define-key map "\C-c\C-r" 'ps-run-region)
- (define-key map "\C-c\C-q" 'ps-run-quit)
- (define-key map "\C-c\C-p" 'ps-mode-print-buffer)
- (define-key map "\C-c\C-o" 'ps-mode-comment-out-region)
- (define-key map "\C-c\C-k" 'ps-run-kill)
- (define-key map "\C-c\C-j" 'ps-mode-other-newline)
- (define-key map "\C-c\C-l" 'ps-run-clear)
- (define-key map "\C-c\C-b" 'ps-run-buffer)
+ (define-key map "\C-c\C-v" #'ps-run-boundingbox)
+ (define-key map "\C-c\C-u" #'ps-mode-uncomment-region)
+ (define-key map "\C-c\C-t" #'ps-mode-epsf-rich)
+ (define-key map "\C-c\C-s" #'ps-run-start)
+ (define-key map "\C-c\C-r" #'ps-run-region)
+ (define-key map "\C-c\C-q" #'ps-run-quit)
+ (define-key map "\C-c\C-p" #'ps-mode-print-buffer)
+ (define-key map "\C-c\C-o" #'ps-mode-comment-out-region)
+ (define-key map "\C-c\C-k" #'ps-run-kill)
+ (define-key map "\C-c\C-j" #'ps-mode-other-newline)
+ (define-key map "\C-c\C-l" #'ps-run-clear)
+ (define-key map "\C-c\C-b" #'ps-run-buffer)
;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
- (define-key map "\177" 'ps-mode-backward-delete-char)
+ (define-key map "\177" #'ps-mode-backward-delete-char)
map)
"Local keymap to use in PostScript mode.")
@@ -336,10 +336,10 @@ If nil, use `temporary-file-directory'."
(defvar ps-run-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map comint-mode-map)
- (define-key map "\C-c\C-q" 'ps-run-quit)
- (define-key map "\C-c\C-k" 'ps-run-kill)
- (define-key map "\C-c\C-e" 'ps-run-goto-error)
- (define-key map [mouse-2] 'ps-run-mouse-goto-error)
+ (define-key map "\C-c\C-q" #'ps-run-quit)
+ (define-key map "\C-c\C-k" #'ps-run-kill)
+ (define-key map "\C-c\C-e" #'ps-run-goto-error)
+ (define-key map [mouse-2] #'ps-run-mouse-goto-error)
map)
"Local keymap to use in PostScript run mode.")
@@ -1092,7 +1092,7 @@ Use line numbers if `ps-run-error-line-numbers' is not
nil."
;;
-(add-hook 'kill-emacs-hook 'ps-run-cleanup)
+(add-hook 'kill-emacs-hook #'ps-run-cleanup)
(provide 'ps-mode)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index e5c15d1..20ec339 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -247,8 +247,6 @@
;; I'd recommend the first one since you'll get the same behavior for
;; all modes out-of-the-box.
-;;; TODO:
-
;;; Code:
(require 'ansi-color)
@@ -3385,7 +3383,8 @@ user-friendly message if there's no process running;
defaults to
t when called interactively."
(interactive "p")
(pop-to-buffer
- (process-buffer (python-shell-get-process-or-error msg)) nil t))
+ (process-buffer (python-shell-get-process-or-error msg))
+ nil 'mark-for-redisplay))
(defun python-shell-send-setup-code ()
"Send all setup code for shell.
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index ba59f9c..c6bd32a 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'."
(define-minor-mode sh-electric-here-document-mode
"Make << insert a here document skeleton."
- nil nil nil
+ :lighter nil
(if sh-electric-here-document-mode
(add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t)
(remove-hook 'post-self-insert-hook #'sh--maybe-here-document t)))
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6224b3b..6e53a04 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1545,9 +1545,7 @@ statement. The format of variable should be a valid
;; `sql-font-lock-keywords-builder' function and follow the
;; implementation pattern used for the other products in this file.
-(eval-when-compile
- (defvar sql-mode-ansi-font-lock-keywords)
- (setq sql-mode-ansi-font-lock-keywords nil))
+(defvar sql-mode-ansi-font-lock-keywords)
(eval-and-compile
(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 a7f7295..2b88120 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2021.03.30.243771231
+;; Version: 2021.04.12.188864585
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2021-03-30-e87a75f-vpo-GNU"
+(defconst verilog-mode-version "2021-04-12-b41d849-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"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'."
;; More searching
(defun verilog-declaration-end ()
- (search-forward ";"))
+ (search-forward ";" nil t))
(defun verilog-single-declaration-end (limit)
"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.")
TYPE is `module', `tf' for task or function, or t if unknown."
(if (string= verilog-str "")
(setq verilog-str "[a-zA-Z_]"))
- (let ((verilog-str (concat (cond
- ((eq type 'module)
"\\<\\(module\\|connectmodule\\)\\s +")
- ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
- (t
"\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
- "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
+ (let ((verilog-str
+ (concat (cond
+ ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +")
+ ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
+ (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
+ "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
match)
- (if (not (looking-at verilog-defun-re))
- (verilog-re-search-backward verilog-defun-re nil t))
- (forward-char 1)
+ (save-excursion
+ (if (not (looking-at verilog-defun-re))
+ (verilog-re-search-backward verilog-defun-re nil t))
+ (forward-char 1)
- ;; Search through all reachable functions
- (goto-char (point-min))
- (while (verilog-re-search-forward verilog-str (point-max) t)
- (progn (setq match (buffer-substring (match-beginning 2)
- (match-end 2)))
- (setq verilog-all (cons match verilog-all))))
- (if (match-beginning 0)
- (goto-char (match-beginning 0)))))
+ ;; Search through all reachable functions
+ (goto-char (point-min))
+ (while (verilog-re-search-forward verilog-str (point-max) t)
+ (setq match (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ (setq verilog-all (cons match verilog-all))))))
(defun verilog-get-completion-decl (end)
"Macro for searching through current declaration (var, type or const)
@@ -11561,6 +11561,7 @@ See the example in `verilog-auto-inout-modport'."
(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
+(defvar vl-memory nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-modport nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning
@@ -12063,6 +12064,7 @@ Lisp Templates:
vl-width Width of the input/output port (`3' for [2:0]).
May be a (...) expression if bits isn't a constant.
vl-dir Direction of the pin input/output/inout/interface.
+ vl-memory The unpacked array part of the I/O port (`[5:0]').
vl-modport The modport, if an interface with a modport.
vl-cell-type Module name/type of the cell (`InstModule').
vl-cell-name Instance name of the cell (`instName').
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 856432c..5eeac8a 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,4 +1,4 @@
-;;; vhdl-mode.el --- major mode for editing VHDL code
+;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t;
-*-
;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
@@ -12,6 +12,9 @@
;; file on 18/3/2008, and the maintainer agreed that when a bug is
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
+;;
+;; Reto also said in Apr 2021 that he preferred to keep the XEmacs
+;; compatibility code.
(defconst vhdl-version "3.38.1"
"VHDL Mode version number.")
@@ -77,7 +80,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21.
+;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
@@ -92,7 +95,7 @@
;; Add the following lines to the `site-start.el' file in the `site-lisp'
;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
-;; (not required in Emacs 20 and higher):
+;; (not required in Emacs):
;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
@@ -136,12 +139,9 @@
(when (< emacs-major-version 25)
(condition-case nil (require 'cl-lib) (file-missing (require 'cl))))
-;; Emacs 21+ handling
-(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep
'xemacs)))
- "Non-nil if GNU Emacs 21, 22, ... is used.")
;; Emacs 22+ handling
(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep
'xemacs)))
- "Non-nil if GNU Emacs 22, ... is used.")
+ "Non-nil if GNU Emacs >= 22, ... is used.")
(defvar compilation-file-regexp-alist)
(defvar conf-alist)
@@ -490,7 +490,7 @@ NOTE: Activate new error and file message regexps and
reflect the new setting
(const :tag "Upcase" upcase)
(const :tag "Downcase" downcase))))))
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-update-mode-menu))
+ (vhdl-custom-set variable value #'vhdl-update-mode-menu))
:version "24.4"
:group 'vhdl-compile)
@@ -668,8 +668,8 @@ NOTE: Reflect the new setting in the choice list of option
`vhdl-project'
:format "%t\n%v\n")))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-update-mode-menu
- 'vhdl-speedbar-refresh))
+ #'vhdl-update-mode-menu
+ #'vhdl-speedbar-refresh))
:group 'vhdl-project)
(defcustom vhdl-project nil
@@ -713,7 +713,7 @@ All project setup files that match the file names specified
in option
\(alphabetically) last loaded setup of the first `vhdl-project-file-name'
entry is activated.
A project setup file can be obtained by exporting a project (see menu).
- At startup: project setup file is loaded at Emacs startup"
+ At startup: project setup file is loaded at Emacs startup."
:type '(set (const :tag "At startup" startup))
:group 'vhdl-project)
@@ -751,12 +751,12 @@ NOTE: Activate the new setting in a VHDL buffer by using
the menu entry
(const :tag "Math packages" math)))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-template-map-init
- 'vhdl-mode-abbrev-table-init
- 'vhdl-template-construct-alist-init
- 'vhdl-template-package-alist-init
- 'vhdl-update-mode-menu
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-template-map-init
+ #'vhdl-mode-abbrev-table-init
+ #'vhdl-template-construct-alist-init
+ #'vhdl-template-package-alist-init
+ #'vhdl-update-mode-menu
+ #'vhdl-words-init 'vhdl-font-lock-init))
:group 'vhdl-style)
(defcustom vhdl-basic-offset 2
@@ -770,7 +770,7 @@ This value is used by + and - symbols in
`vhdl-offsets-alist'."
This is done when typed or expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-types nil
@@ -778,7 +778,7 @@ This is done when typed or expanded or by the fix case
functions."
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-attributes nil
@@ -786,7 +786,7 @@ This is done when expanded or by the fix case functions."
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-enum-values nil
@@ -794,7 +794,7 @@ This is done when expanded or by the fix case functions."
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-constants t
@@ -802,7 +802,7 @@ This is done when expanded or by the fix case functions."
This is done when expanded."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-use-direct-instantiation 'standard
@@ -909,7 +909,7 @@ follows:
:type '(set (const :tag "VHDL keywords" vhdl)
(const :tag "User model keywords" user))
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))
+ (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init))
:group 'vhdl-template)
(defcustom vhdl-optional-labels 'process
@@ -1192,10 +1192,10 @@ NOTE: Activate the new setting in a VHDL buffer by
using the menu entry
(string :tag "Keyword " :format "%t: %v\n")))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-model-map-init
- 'vhdl-model-defun
- 'vhdl-mode-abbrev-table-init
- 'vhdl-update-mode-menu))
+ #'vhdl-model-map-init
+ #'vhdl-model-defun
+ #'vhdl-mode-abbrev-table-init
+ #'vhdl-update-mode-menu))
:group 'vhdl-model)
@@ -1598,7 +1598,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-names t
@@ -1615,7 +1615,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-special-words nil
@@ -1628,7 +1628,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-forbidden-words nil
@@ -1643,7 +1643,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
:type 'boolean
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-verilog-keywords nil
@@ -1656,7 +1656,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
:type 'boolean
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-translate-off nil
@@ -1670,7 +1670,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-case-sensitive nil
@@ -1724,7 +1724,7 @@ NOTE: Activate a changed regexp in a VHDL buffer by
re-fontifying it (menu
(string :tag "Color (dark) ")
(boolean :tag "In comments ")))
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-words '()
@@ -1737,7 +1737,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
:type '(repeat (string :format "%v"))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-syntax ""
@@ -1752,7 +1752,7 @@ NOTE: Activate the new setting in a VHDL buffer by
re-fontifying it (menu
:type 'regexp
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(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
:type '(repeat (string :format "%v"))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
@@ -2238,11 +2238,11 @@ Ignore byte-compiler warnings you might see."
; (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
(defun regexp-opt (strings &optional paren)
(let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
- (concat open (mapconcat 'regexp-quote strings "\\|") close))))
+ (concat open (mapconcat #'regexp-quote strings "\\|") close))))
;; `match-string-no-properties' undefined (XEmacs, what else?)
(unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
+ (defalias 'match-string-no-properties #'match-string))
;; `subst-char-in-string' undefined (XEmacs)
(unless (fboundp 'subst-char-in-string)
@@ -2269,7 +2269,7 @@ Ignore byte-compiler warnings you might see."
(let* ((nondir (file-name-nondirectory pattern))
(dirpart (file-name-directory pattern))
(dirs (if (and dirpart (string-match "[[*?]" dirpart))
- (mapcar 'file-name-as-directory
+ (mapcar #'file-name-as-directory
(file-expand-wildcards (directory-file-name
dirpart)))
(list dirpart)))
contents)
@@ -2296,7 +2296,7 @@ Ignore byte-compiler warnings you might see."
;; `member-ignore-case' undefined (XEmacs)
(unless (fboundp 'member-ignore-case)
- (defalias 'member-ignore-case 'member))
+ (defalias 'member-ignore-case #'member))
;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
;; behavior in XEmacs
@@ -2495,6 +2495,7 @@ current buffer if no project is defined."
"Enable case insensitive search and switch to syntax table that includes `_',
then execute BODY, and finally restore the old environment. Used for
consistent searching."
+ (declare (debug t))
`(let ((case-fold-search t)) ; case insensitive search
;; use extended syntax table
(with-syntax-table vhdl-mode-ext-syntax-table
@@ -2504,55 +2505,59 @@ consistent searching."
"Enable case insensitive search, switch to syntax table that includes `_',
arrange to ignore `intangible' overlays, then execute BODY, and finally restore
the old environment. Used for consistent searching."
+ (declare (debug t))
`(let ((case-fold-search t) ; case insensitive search
- (current-syntax-table (syntax-table))
(inhibit-point-motion-hooks t))
;; use extended syntax table
- (set-syntax-table vhdl-mode-ext-syntax-table)
- ;; execute BODY safely
- (unwind-protect
- (progn ,@body)
- ;; restore syntax table
- (set-syntax-table current-syntax-table))))
+ (with-syntax-table vhdl-mode-ext-syntax-table
+ ;; execute BODY safely
+ (progn ,@body))))
(defmacro vhdl-visit-file (file-name issue-error &rest body)
"Visit file FILE-NAME and execute BODY."
- `(if (null ,file-name)
- (progn ,@body)
- (unless (file-directory-p ,file-name)
- (let ((source-buffer (current-buffer))
- (visiting-buffer (find-buffer-visiting ,file-name))
- file-opened)
- (when (or (and visiting-buffer (set-buffer visiting-buffer))
- (condition-case ()
- (progn (set-buffer (create-file-buffer ,file-name))
- (setq file-opened t)
- (vhdl-insert-file-contents ,file-name)
- ;; FIXME: This modifies a global syntax-table!
- (modify-syntax-entry ?\- ". 12" (syntax-table))
- (modify-syntax-entry ?\n ">" (syntax-table))
- (modify-syntax-entry ?\^M ">" (syntax-table))
- (modify-syntax-entry ?_ "w" (syntax-table))
- t)
- (error
- (if ,issue-error
- (progn
- (when file-opened (kill-buffer (current-buffer)))
- (set-buffer source-buffer)
- (error "ERROR: File cannot be opened: \"%s\""
,file-name))
- (vhdl-warning (format "File cannot be opened: \"%s\""
,file-name) t)
- nil))))
- (condition-case info
- (progn ,@body)
- (error
- (if ,issue-error
- (progn
- (when file-opened (kill-buffer (current-buffer)))
- (set-buffer source-buffer)
- (error (cadr info)))
- (vhdl-warning (cadr info))))))
- (when file-opened (kill-buffer (current-buffer)))
- (set-buffer source-buffer)))))
+ (declare (debug t) (indent 2))
+ `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body)))
+
+(defun vhdl--visit-file (file-name issue-error body-fun)
+ (if (null file-name)
+ (funcall body-fun)
+ (unless (file-directory-p file-name)
+ (let ((source-buffer (current-buffer))
+ (visiting-buffer (find-buffer-visiting file-name))
+ file-opened)
+ (when (or (and visiting-buffer (set-buffer visiting-buffer))
+ (condition-case ()
+ (progn (set-buffer (create-file-buffer file-name))
+ (setq file-opened t)
+ (vhdl-insert-file-contents file-name)
+ (let ((st (copy-syntax-table (syntax-table))))
+ (modify-syntax-entry ?\- ". 12" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?\^M ">" st)
+ (modify-syntax-entry ?_ "w" st)
+ ;; FIXME: We should arguably reset the
+ ;; syntax-table after running `body-fun'.
+ (set-syntax-table st))
+ t)
+ (error
+ (if issue-error
+ (progn
+ (when file-opened (kill-buffer (current-buffer)))
+ (set-buffer source-buffer)
+ (error "ERROR: File cannot be opened: \"%s\""
file-name))
+ (vhdl-warning (format "File cannot be opened: \"%s\""
file-name) t)
+ nil))))
+ (condition-case info
+ (funcall body-fun)
+ (error
+ (if issue-error
+ (progn
+ (when file-opened (kill-buffer (current-buffer)))
+ (set-buffer source-buffer)
+ (error (cadr info)))
+ (vhdl-warning (cadr info))))))
+ (when file-opened (kill-buffer (current-buffer)))
+ (set-buffer source-buffer)))))
(defun vhdl-insert-file-contents (filename)
"Nicked from `insert-file-contents-literally', but allow coding system
@@ -2600,7 +2605,7 @@ conversion."
"Refresh directory or project with name KEY."
(when (and (boundp 'speedbar-frame)
(frame-live-p speedbar-frame))
- (let ((pos (point))
+ (let (;; (pos (point))
(last-frame (selected-frame)))
(if (null key)
(speedbar-refresh)
@@ -2677,96 +2682,96 @@ elements > `vhdl-menu-max-size'."
"Initialize `vhdl-template-map'."
(setq vhdl-template-map (make-sparse-keymap))
;; key bindings for VHDL templates
- (define-key vhdl-template-map "al" 'vhdl-template-alias)
- (define-key vhdl-template-map "ar" 'vhdl-template-architecture)
- (define-key vhdl-template-map "at" 'vhdl-template-assert)
- (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl)
- (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec)
- (define-key vhdl-template-map "bl" 'vhdl-template-block)
- (define-key vhdl-template-map "ca" 'vhdl-template-case-is)
- (define-key vhdl-template-map "cd" 'vhdl-template-component-decl)
- (define-key vhdl-template-map "ci" 'vhdl-template-component-inst)
- (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst)
- (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration)
- (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf)
- (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
- (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
- (define-key vhdl-template-map "co" 'vhdl-template-constant)
- (define-key vhdl-template-map "ct" 'vhdl-template-context)
- (define-key vhdl-template-map "di" 'vhdl-template-disconnect)
- (define-key vhdl-template-map "el" 'vhdl-template-else)
- (define-key vhdl-template-map "ei" 'vhdl-template-elsif)
- (define-key vhdl-template-map "en" 'vhdl-template-entity)
- (define-key vhdl-template-map "ex" 'vhdl-template-exit)
- (define-key vhdl-template-map "fi" 'vhdl-template-file)
- (define-key vhdl-template-map "fg" 'vhdl-template-for-generate)
- (define-key vhdl-template-map "fl" 'vhdl-template-for-loop)
- (define-key vhdl-template-map "\C-f" 'vhdl-template-footer)
- (define-key vhdl-template-map "fb" 'vhdl-template-function-body)
- (define-key vhdl-template-map "fd" 'vhdl-template-function-decl)
- (define-key vhdl-template-map "ge" 'vhdl-template-generic)
- (define-key vhdl-template-map "gd" 'vhdl-template-group-decl)
- (define-key vhdl-template-map "gt" 'vhdl-template-group-template)
- (define-key vhdl-template-map "\C-h" 'vhdl-template-header)
- (define-key vhdl-template-map "ig" 'vhdl-template-if-generate)
- (define-key vhdl-template-map "it" 'vhdl-template-if-then)
- (define-key vhdl-template-map "li" 'vhdl-template-library)
- (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop)
- (define-key vhdl-template-map "\C-m" 'vhdl-template-modify)
- (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date)
- (define-key vhdl-template-map "ma" 'vhdl-template-map)
- (define-key vhdl-template-map "ne" 'vhdl-template-next)
- (define-key vhdl-template-map "ot" 'vhdl-template-others)
- (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl)
- (define-key vhdl-template-map "Pb" 'vhdl-template-package-body)
- (define-key vhdl-template-map "(" 'vhdl-template-paired-parens)
- (define-key vhdl-template-map "po" 'vhdl-template-port)
- (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body)
- (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl)
- (define-key vhdl-template-map "pc" 'vhdl-template-process-comb)
- (define-key vhdl-template-map "ps" 'vhdl-template-process-seq)
- (define-key vhdl-template-map "rp" 'vhdl-template-report)
- (define-key vhdl-template-map "rt" 'vhdl-template-return)
- (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst)
- (define-key vhdl-template-map "si" 'vhdl-template-signal)
- (define-key vhdl-template-map "su" 'vhdl-template-subtype)
- (define-key vhdl-template-map "ty" 'vhdl-template-type)
- (define-key vhdl-template-map "us" 'vhdl-template-use)
- (define-key vhdl-template-map "va" 'vhdl-template-variable)
- (define-key vhdl-template-map "wa" 'vhdl-template-wait)
- (define-key vhdl-template-map "wl" 'vhdl-template-while-loop)
- (define-key vhdl-template-map "wi" 'vhdl-template-with)
- (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait)
- (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit)
- (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std)
- (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164)
- (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith)
- (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc)
- (define-key vhdl-template-map "\C-pS"
'vhdl-template-package-std-logic-signed)
- (define-key vhdl-template-map "\C-pT"
'vhdl-template-package-std-logic-textio)
- (define-key vhdl-template-map "\C-pU"
'vhdl-template-package-std-logic-unsigned)
- (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio)
- (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on)
- (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off)
- (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on)
- (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off)
- (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt)
+ (define-key vhdl-template-map "al" #'vhdl-template-alias)
+ (define-key vhdl-template-map "ar" #'vhdl-template-architecture)
+ (define-key vhdl-template-map "at" #'vhdl-template-assert)
+ (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl)
+ (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec)
+ (define-key vhdl-template-map "bl" #'vhdl-template-block)
+ (define-key vhdl-template-map "ca" #'vhdl-template-case-is)
+ (define-key vhdl-template-map "cd" #'vhdl-template-component-decl)
+ (define-key vhdl-template-map "ci" #'vhdl-template-component-inst)
+ (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst)
+ (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration)
+ (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf)
+ (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl)
+ (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec)
+ (define-key vhdl-template-map "co" #'vhdl-template-constant)
+ (define-key vhdl-template-map "ct" #'vhdl-template-context)
+ (define-key vhdl-template-map "di" #'vhdl-template-disconnect)
+ (define-key vhdl-template-map "el" #'vhdl-template-else)
+ (define-key vhdl-template-map "ei" #'vhdl-template-elsif)
+ (define-key vhdl-template-map "en" #'vhdl-template-entity)
+ (define-key vhdl-template-map "ex" #'vhdl-template-exit)
+ (define-key vhdl-template-map "fi" #'vhdl-template-file)
+ (define-key vhdl-template-map "fg" #'vhdl-template-for-generate)
+ (define-key vhdl-template-map "fl" #'vhdl-template-for-loop)
+ (define-key vhdl-template-map "\C-f" #'vhdl-template-footer)
+ (define-key vhdl-template-map "fb" #'vhdl-template-function-body)
+ (define-key vhdl-template-map "fd" #'vhdl-template-function-decl)
+ (define-key vhdl-template-map "ge" #'vhdl-template-generic)
+ (define-key vhdl-template-map "gd" #'vhdl-template-group-decl)
+ (define-key vhdl-template-map "gt" #'vhdl-template-group-template)
+ (define-key vhdl-template-map "\C-h" #'vhdl-template-header)
+ (define-key vhdl-template-map "ig" #'vhdl-template-if-generate)
+ (define-key vhdl-template-map "it" #'vhdl-template-if-then)
+ (define-key vhdl-template-map "li" #'vhdl-template-library)
+ (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop)
+ (define-key vhdl-template-map "\C-m" #'vhdl-template-modify)
+ (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date)
+ (define-key vhdl-template-map "ma" #'vhdl-template-map)
+ (define-key vhdl-template-map "ne" #'vhdl-template-next)
+ (define-key vhdl-template-map "ot" #'vhdl-template-others)
+ (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl)
+ (define-key vhdl-template-map "Pb" #'vhdl-template-package-body)
+ (define-key vhdl-template-map "(" #'vhdl-template-paired-parens)
+ (define-key vhdl-template-map "po" #'vhdl-template-port)
+ (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body)
+ (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl)
+ (define-key vhdl-template-map "pc" #'vhdl-template-process-comb)
+ (define-key vhdl-template-map "ps" #'vhdl-template-process-seq)
+ (define-key vhdl-template-map "rp" #'vhdl-template-report)
+ (define-key vhdl-template-map "rt" #'vhdl-template-return)
+ (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst)
+ (define-key vhdl-template-map "si" #'vhdl-template-signal)
+ (define-key vhdl-template-map "su" #'vhdl-template-subtype)
+ (define-key vhdl-template-map "ty" #'vhdl-template-type)
+ (define-key vhdl-template-map "us" #'vhdl-template-use)
+ (define-key vhdl-template-map "va" #'vhdl-template-variable)
+ (define-key vhdl-template-map "wa" #'vhdl-template-wait)
+ (define-key vhdl-template-map "wl" #'vhdl-template-while-loop)
+ (define-key vhdl-template-map "wi" #'vhdl-template-with)
+ (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait)
+ (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit)
+ (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std)
+ (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164)
+ (define-key vhdl-template-map "\C-pA"
#'vhdl-template-package-std-logic-arith)
+ (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc)
+ (define-key vhdl-template-map "\C-pS"
#'vhdl-template-package-std-logic-signed)
+ (define-key vhdl-template-map "\C-pT"
#'vhdl-template-package-std-logic-textio)
+ (define-key vhdl-template-map "\C-pU"
#'vhdl-template-package-std-logic-unsigned)
+ (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio)
+ (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on)
+ (define-key vhdl-template-map "\C-df"
#'vhdl-template-directive-translate-off)
+ (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on)
+ (define-key vhdl-template-map "\C-dF"
#'vhdl-template-directive-synthesis-off)
+ (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt)
(when (vhdl-standard-p 'ams)
- (define-key vhdl-template-map "br" 'vhdl-template-break)
- (define-key vhdl-template-map "cu" 'vhdl-template-case-use)
- (define-key vhdl-template-map "iu" 'vhdl-template-if-use)
- (define-key vhdl-template-map "lm" 'vhdl-template-limit)
- (define-key vhdl-template-map "na" 'vhdl-template-nature)
- (define-key vhdl-template-map "pa" 'vhdl-template-procedural)
- (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free)
- (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch)
- (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source)
- (define-key vhdl-template-map "sn" 'vhdl-template-subnature)
- (define-key vhdl-template-map "te" 'vhdl-template-terminal)
+ (define-key vhdl-template-map "br" #'vhdl-template-break)
+ (define-key vhdl-template-map "cu" #'vhdl-template-case-use)
+ (define-key vhdl-template-map "iu" #'vhdl-template-if-use)
+ (define-key vhdl-template-map "lm" #'vhdl-template-limit)
+ (define-key vhdl-template-map "na" #'vhdl-template-nature)
+ (define-key vhdl-template-map "pa" #'vhdl-template-procedural)
+ (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free)
+ (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch)
+ (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source)
+ (define-key vhdl-template-map "sn" #'vhdl-template-subnature)
+ (define-key vhdl-template-map "te" #'vhdl-template-terminal)
)
(when (vhdl-standard-p 'math)
- (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex)
- (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real)
+ (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex)
+ (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real)
))
;; initialize template map for VHDL Mode
@@ -2812,119 +2817,120 @@ STRING are replaced by `-' and substrings are
converted to lower case."
;; model key bindings
(define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map)
;; standard key bindings
- (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement)
- (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement)
- (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp)
- (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp)
- (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
- (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
- (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
+ (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement)
+ (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement)
+ (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp)
+ (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp)
+ (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list)
+ (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent)
+ (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent)
(unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
- (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
- (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
- (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
+ (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun))
+ (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp)
+ (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation)
;; mode specific key bindings
- (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
- (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
- (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
- (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
- (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
- (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
- (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
- (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile)
- (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make)
- (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile)
- (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
- (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
- (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
- (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component)
- (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
- (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
- (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
- (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs
- (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
- (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
- (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
- (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
- (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
- (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
- (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
- (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
- (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
- (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
- (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
- (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
- (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component)
- (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component)
- (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components)
- (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration)
- (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package)
- (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region)
- (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline)
- (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line)
- (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
- (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
- (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region)
- (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
- (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
- (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
- (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
- (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
- (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
- (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
- (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
- (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
- (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
- (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
- (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
- (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
- (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
- (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
- (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
- (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
- (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
- (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand)
- (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next)
- (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous)
- (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
- (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
- (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
- (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region)
- (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer)
- (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
- (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
- (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
- (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
- (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
- (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region)
- (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer)
- (define-key vhdl-mode-map "\C-c\C-u\C-s"
'vhdl-update-sensitivity-list-process)
- (define-key vhdl-mode-map "\C-c\C-u\M-s"
'vhdl-update-sensitivity-list-buffer)
- (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer)
- (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer)
- (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages)
- (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode)
- (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version)
- (define-key vhdl-mode-map "\M-\t" 'insert-tab)
+ (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode)
+ (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode)
+ (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project)
+ (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project)
+ (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project)
+ (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project)
+ (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler)
+ (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile)
+ (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make)
+ (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile)
+ (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy)
+ (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy)
+ (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity)
+ (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component)
+ (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance)
+ (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals)
+ (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants)
+ (define-key vhdl-mode-map
+ ;; `... C-g' not allowed in XEmacs.
+ (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g")
+ #'vhdl-port-paste-generic-map)
+ (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations)
+ (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench)
+ (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten)
+ (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction)
+ (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy)
+ (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy)
+ (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration)
+ (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body)
+ (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call)
+ (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten)
+ (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component)
+ (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component)
+ (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components)
+ (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration)
+ (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package)
+ (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region)
+ (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline)
+ (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line)
+ (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode)
+ (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group)
+ (define-key vhdl-mode-map "\M-\C-\\" #'indent-region)
+ (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer)
+ (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group)
+ (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group)
+ (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent)
+ (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list)
+ (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations)
+ (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region)
+ (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer)
+ (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group)
+ (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region)
+ (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list)
+ (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list)
+ (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group)
+ (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent)
+ (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region)
+ (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill)
+ (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy)
+ (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank)
+ (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand)
+ (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next)
+ (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous)
+ (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open)
+ (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line)
+ (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line)
+ (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region)
+ (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer)
+ (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause)
+ (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region)
+ (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer)
+ (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region)
+ (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer)
+ (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region)
+ (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer)
+ (define-key vhdl-mode-map "\C-c\C-u\C-s"
#'vhdl-update-sensitivity-list-process)
+ (define-key vhdl-mode-map "\C-c\C-u\M-s"
#'vhdl-update-sensitivity-list-buffer)
+ (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer)
+ (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer)
+ (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages)
+ (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode)
+ (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version)
+ (define-key vhdl-mode-map "\M-\t" #'insert-tab)
;; insert commands bindings
- (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
- (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
- (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
- (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
+ (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct)
+ (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package)
+ (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive)
+ (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert)
;; electric key bindings
- (define-key vhdl-mode-map " " 'vhdl-electric-space)
+ (define-key vhdl-mode-map " " #'vhdl-electric-space)
(when vhdl-intelligent-tab
- (define-key vhdl-mode-map "\t" 'vhdl-electric-tab))
- (define-key vhdl-mode-map "\r" 'vhdl-electric-return)
- (define-key vhdl-mode-map "-" 'vhdl-electric-dash)
- (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket)
- (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket)
- (define-key vhdl-mode-map "'" 'vhdl-electric-quote)
- (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon)
- (define-key vhdl-mode-map "," 'vhdl-electric-comma)
- (define-key vhdl-mode-map "." 'vhdl-electric-period)
+ (define-key vhdl-mode-map "\t" #'vhdl-electric-tab))
+ (define-key vhdl-mode-map "\r" #'vhdl-electric-return)
+ (define-key vhdl-mode-map "-" #'vhdl-electric-dash)
+ (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket)
+ (define-key vhdl-mode-map "]"
#'vhdl-electric-close-bracket)
+ (define-key vhdl-mode-map "'" #'vhdl-electric-quote)
+ (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon)
+ (define-key vhdl-mode-map "," #'vhdl-electric-comma)
+ (define-key vhdl-mode-map "." #'vhdl-electric-period)
(when (vhdl-standard-p 'ams)
- (define-key vhdl-mode-map "=" 'vhdl-electric-equal)))
+ (define-key vhdl-mode-map "=" #'vhdl-electric-equal)))
;; initialize mode map for VHDL Mode
(vhdl-mode-map-init)
@@ -2935,7 +2941,7 @@ STRING are replaced by `-' and substrings are converted
to lower case."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(when vhdl-word-completion-in-minibuffer
- (define-key map "\t" 'vhdl-minibuffer-tab))
+ (define-key map "\t" #'vhdl-minibuffer-tab))
map)
"Keymap for minibuffer used in VHDL Mode.")
@@ -3168,7 +3174,8 @@ STRING are replaced by `-' and substrings are converted
to lower case."
(unless (equal keyword "")
(push (list keyword ""
(vhdl-function-name
- "vhdl-model" (nth 0 elem) "hook") 0 'system)
+ "vhdl-model" (nth 0 elem) "hook")
+ 0 'system)
abbrev-list)))
abbrev-list)))))
@@ -3575,7 +3582,7 @@ STRING are replaced by `-' and substrings are converted
to lower case."
("Indent"
["Line" indent-according-to-mode :keys "C-c C-i C-l"]
["Group" vhdl-indent-group :keys "C-c C-i C-g"]
- ["Region" vhdl-indent-region (mark)]
+ ["Region" indent-region (mark)]
["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"])
("Align"
["Group" vhdl-align-group t]
@@ -4885,7 +4892,7 @@ Key bindings:
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
+ (set (make-local-variable 'indent-line-function) #'vhdl-indent-line)
(set (make-local-variable 'comment-start) "--")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-column) vhdl-inline-comment-column)
@@ -4898,13 +4905,13 @@ Key bindings:
;; setup the comment indent variable in an Emacs version portable way
;; ignore any byte compiler warnings you might get here
(when (boundp 'comment-indent-function)
- (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent))
+ (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent))
;; initialize font locking
(set (make-local-variable 'font-lock-defaults)
(list
'(nil vhdl-font-lock-keywords) nil
- (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
+ (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line))
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-rules
@@ -4913,7 +4920,7 @@ Key bindings:
("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
(set (make-local-variable 'font-lock-syntactic-keywords)
vhdl-font-lock-syntactic-keywords))
- (unless vhdl-emacs-21
+ (when (featurep 'xemacs)
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
(set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
@@ -4959,10 +4966,10 @@ Key bindings:
(defun vhdl-write-file-hooks-init ()
"Add/remove hooks when buffer is saved."
(if vhdl-modify-date-on-saving
- (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t)
- (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t))
+ (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t)
+ (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t))
(if (featurep 'xemacs) (make-local-hook 'after-save-hook))
- (add-hook 'after-save-hook 'vhdl-add-modified-file nil t))
+ (add-hook 'after-save-hook #'vhdl-add-modified-file nil t))
(defun vhdl-process-command-line-option (option)
"Process command line options for VHDL Mode."
@@ -5745,7 +5752,7 @@ negative, skip forward otherwise."
;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
- (defalias 'vhdl-forward-comment 'forward-comment))
+ (defalias 'vhdl-forward-comment #'forward-comment))
(defun vhdl-back-to-indentation ()
"Move point to the first non-whitespace character on this line."
@@ -5809,7 +5816,7 @@ negative, skip forward otherwise."
state)))
(and (string-match "Win-Emacs" emacs-version)
- (fset 'vhdl-in-literal 'vhdl-win-il))
+ (fset 'vhdl-in-literal #'vhdl-win-il))
;; Skipping of "syntactic whitespace". Syntactic whitespace is
;; defined as lexical whitespace or comments. Search no farther back
@@ -5847,9 +5854,9 @@ negative, skip forward otherwise."
(t (setq stop t))))))
(and (string-match "Win-Emacs" emacs-version)
- (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
+ (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws))
-(defun vhdl-beginning-of-macro (&optional lim)
+(defun vhdl-beginning-of-macro (&optional _lim)
"Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
(let ((here (point)))
(beginning-of-line)
@@ -5862,7 +5869,7 @@ negative, skip forward otherwise."
(goto-char here)
nil)))
-(defun vhdl-beginning-of-directive (&optional lim)
+(defun vhdl-beginning-of-directive (&optional _lim)
"Go to the beginning of a directive (nicked from `cc-engine')."
(let ((here (point)))
(beginning-of-line)
@@ -5906,7 +5913,7 @@ negative, skip forward otherwise."
(t (setq stop t))))))
(and (string-match "Win-Emacs" emacs-version)
- (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
+ (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws))
;; Functions to help finding the correct indentation column:
@@ -6054,7 +6061,7 @@ keyword."
t)
))
-(defun vhdl-corresponding-mid (&optional lim)
+(defun vhdl-corresponding-mid (&optional _lim)
(cond
((looking-at "is\\|block\\|generate\\|process\\|procedural")
"begin")
@@ -6270,7 +6277,7 @@ of an identifier that just happens to contain an \"end\"
keyword."
"A regular expression for searching backward that matches all known
\"statement\" keywords.")
-(defun vhdl-statement-p (&optional lim)
+(defun vhdl-statement-p (&optional _lim)
"Return t if we are looking at a real \"statement\" keyword.
Assumes that the caller will make sure that we are looking at
vhdl-statement-fwd-re, and are not inside a literal, and that we are not
@@ -6462,7 +6469,7 @@ searches."
;; internal-p controls where the statement keyword can
;; be found.
(internal-p (aref begin-vec 3))
- (last-backward (point)) last-forward
+ (last-backward (point)) ;; last-forward
foundp literal keyword)
;; Look for the statement keyword.
(while (and (not foundp)
@@ -6497,7 +6504,7 @@ searches."
(setq begin-re
(concat "\\b\\(" begin-re "\\)\\b[^_]"))
(save-excursion
- (setq last-forward (point))
+ ;; (setq last-forward (point))
;; Look for the supplementary keyword
;; (bounded by the backward search start
;; point).
@@ -6549,7 +6556,7 @@ With argument, do this that many times."
(setq target (point)))
(goto-char target)))
-(defun vhdl-end-of-defun (&optional count)
+(defun vhdl-end-of-defun (&optional _count)
"Move forward to the end of a VHDL defun."
(interactive)
(let ((case-fold-search t))
@@ -7321,7 +7328,7 @@ after the containing paren which starts the arglist."
(current-column))))
(- ce-curcol cs-curcol -1))))
-(defun vhdl-lineup-comment (langelem)
+(defun vhdl-lineup-comment (_langelem)
"Support old behavior for comment indentation. We look at
vhdl-comment-only-line-offset to decide how to indent comment
only-lines."
@@ -7383,27 +7390,13 @@ only-lines."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Progress reporting
-(defvar vhdl-progress-info nil
- "Array variable for progress information: 0 begin, 1 end, 2 time.")
-
-(defun vhdl-update-progress-info (string pos)
- "Update progress information."
- (when (and vhdl-progress-info (not noninteractive)
- (time-less-p vhdl-progress-interval
- (time-since (aref vhdl-progress-info 2))))
- (let ((delta (- (aref vhdl-progress-info 1)
- (aref vhdl-progress-info 0))))
- (message "%s... (%2d%%)" string
- (if (= 0 delta)
- 100
- (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
- delta))))
- (aset vhdl-progress-info 2 (time-convert nil 'integer))))
+(defvar vhdl--progress-reporter nil
+ "Holds the progress reporter data during long running operations.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indentation commands
-(defun vhdl-electric-tab (&optional prefix-arg)
+(defun vhdl-electric-tab (&optional arg)
"If preceding character is part of a word or a paren then hippie-expand,
else if right of non whitespace on line then insert tab,
else if last command was a tab or return then dedent one step or if a comment
@@ -7414,7 +7407,7 @@ else indent `correctly'."
(cond
;; indent region if region is active
((and (not (featurep 'xemacs)) (use-region-p))
- (vhdl-indent-region (region-beginning) (region-end) nil))
+ (indent-region (region-beginning) (region-end) nil))
;; expand word
((= (char-syntax (preceding-char)) ?w)
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
@@ -7423,12 +7416,12 @@ else indent `correctly'."
(or (and (boundp 'hippie-expand-only-buffers)
hippie-expand-only-buffers)
'(vhdl-mode))))
- (vhdl-expand-abbrev prefix-arg)))
+ (vhdl-expand-abbrev arg)))
;; expand parenthesis
((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
(case-replace nil))
- (vhdl-expand-paren prefix-arg)))
+ (vhdl-expand-paren arg)))
;; insert tab
((> (current-column) (current-indentation))
(insert-tab))
@@ -7487,7 +7480,7 @@ indentation change."
(setq syntax (vhdl-get-syntactic-context)))))
(when is-comment
(push (cons 'comment nil) syntax))
- (apply '+ (mapcar 'vhdl-get-offset syntax)))
+ (apply #'+ (mapcar #'vhdl-get-offset syntax)))
;; indent like previous nonblank line
(save-excursion (beginning-of-line)
(re-search-backward "^[^\n]" nil t)
@@ -7509,25 +7502,17 @@ indentation change."
(when (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))))
(run-hooks 'vhdl-special-indent-hook)
- (vhdl-update-progress-info "Indenting" (vhdl-current-line))
+ (when vhdl--progress-reporter
+ (progress-reporter-update vhdl--progress-reporter (point)))
shift-amt))
-(defun vhdl-indent-region (beg end &optional column)
- "Indent region as VHDL code.
-Adds progress reporting to `indent-region'."
- (interactive "r\nP")
- (when vhdl-progress-interval
- (setq vhdl-progress-info (vector (count-lines (point-min) beg)
- (count-lines (point-min) end) 0)))
- (indent-region beg end column)
- (when vhdl-progress-interval (message "Indenting...done"))
- (setq vhdl-progress-info nil))
+(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1")
(defun vhdl-indent-buffer ()
"Indent whole buffer as VHDL code.
Calls `indent-region' for whole buffer and adds progress reporting."
(interactive)
- (vhdl-indent-region (point-min) (point-max)))
+ (indent-region (point-min) (point-max)))
(defun vhdl-indent-group ()
"Indent group of lines between empty lines."
@@ -7540,7 +7525,7 @@ Calls `indent-region' for whole buffer and adds progress
reporting."
(if (re-search-forward vhdl-align-group-separate nil t)
(point-marker)
(point-max-marker)))))
- (vhdl-indent-region beg end)))
+ (indent-region beg end)))
(defun vhdl-indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
@@ -7699,7 +7684,7 @@ parentheses."
;; run FUNCTION
(funcall function beg end spacing)))
-(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
+(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent)
"Attempt to align a range of lines based on the content of the
lines. The definition of `alignment-list' determines the matching
order and the manner in which the lines are aligned. If ALIGNMENT-LIST
@@ -7709,12 +7694,15 @@ indentation is done before aligning."
(setq alignment-list (or alignment-list vhdl-align-alist))
(setq spacing (or spacing 1))
(save-excursion
- (let (bol indent)
+ (let (bol) ;; indent
(goto-char end)
(setq end (point-marker))
(goto-char begin)
(setq bol (setq begin (progn (beginning-of-line) (point))))
- (when indent
+ ;; FIXME: The `indent' arg is not used, and I think it's because
+ ;; the let binding commented out above `indent' was hiding it, so
+ ;; the test below should maybe still test `indent'?
+ (when nil ;; indent
(indent-region bol end nil))))
(let ((copy (copy-alist alignment-list)))
(vhdl-prepare-search-2
@@ -7799,18 +7787,21 @@ the token in MATCH."
"Align region, treat groups of lines separately."
(interactive "r\nP")
(save-excursion
- (let (orig pos)
- (goto-char beg)
- (beginning-of-line)
- (setq orig (point-marker))
- (setq beg (point))
- (goto-char end)
- (setq end (point-marker))
- (untabify beg end)
- (unless no-message
- (when vhdl-progress-interval
- (setq vhdl-progress-info (vector (count-lines (point-min) beg)
- (count-lines (point-min) end) 0))))
+ (goto-char beg)
+ (beginning-of-line)
+ (setq beg (point))
+ (goto-char end)
+ (setq end (point-marker))
+ (untabify beg end)
+ (let ((orig (copy-marker beg))
+ pos
+ (vhdl--progress-reporter
+ (if no-message
+ ;; Preserve a potential progress reporter from
+ ;; when called from `vhdl-align-region' call.
+ vhdl--progress-reporter
+ (when vhdl-progress-interval
+ (make-progress-reporter "Aligning..." beg (copy-marker end))))))
(when (nth 0 vhdl-beautify-options)
(vhdl-fixup-whitespace-region beg end t))
(goto-char beg)
@@ -7825,19 +7816,21 @@ the token in MATCH."
(setq pos (point-marker))
(vhdl-align-region-1 beg pos spacing)
(unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
- (vhdl-update-progress-info "Aligning" (vhdl-current-line))
+ (when vhdl--progress-reporter
+ (progress-reporter-update vhdl--progress-reporter (point)))
(setq beg (1+ pos))
(goto-char beg))
;; align last group
(when (< beg end)
(vhdl-align-region-1 beg end spacing)
(unless no-comments (vhdl-align-inline-comment-region-1 beg end))
- (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
+ (when vhdl--progress-reporter
+ (progress-reporter-update vhdl--progress-reporter (point)))))
(when vhdl-indent-tabs-mode
(tabify orig end))
(unless no-message
- (when vhdl-progress-interval (message "Aligning...done"))
- (setq vhdl-progress-info nil)))))
+ (when vhdl--progress-reporter
+ (progress-reporter-done vhdl--progress-reporter))))))
(defun vhdl-align-region (beg end &optional spacing)
"Align region, treat blocks with same indent and argument lists separately."
@@ -7848,10 +7841,10 @@ the token in MATCH."
;; align blocks with same indent and argument lists
(save-excursion
(let ((cur-beg beg)
- indent cur-end)
- (when vhdl-progress-interval
- (setq vhdl-progress-info (vector (count-lines (point-min) beg)
- (count-lines (point-min) end) 0)))
+ indent cur-end
+ (vhdl--progress-reporter
+ (when vhdl-progress-interval
+ (make-progress-reporter "Aligning..." beg (copy-marker end)))))
(goto-char end)
(setq end (point-marker))
(goto-char cur-beg)
@@ -7874,15 +7867,16 @@ the token in MATCH."
(= (current-indentation) indent))
(<= (save-excursion
(nth 0 (parse-partial-sexp
- (point) (vhdl-point 'eol)))) 0))
+ (point) (vhdl-point 'eol))))
+ 0))
(unless (looking-at "^\\s-*$")
(setq cur-end (vhdl-point 'bonl)))
(beginning-of-line 2)))
;; align region
(vhdl-align-region-groups cur-beg cur-end spacing t t))
(vhdl-align-inline-comment-region beg end spacing noninteractive)
- (when vhdl-progress-interval (message "Aligning...done"))
- (setq vhdl-progress-info nil)))))
+ (when vhdl--progress-reporter
+ (progress-reporter-done vhdl--progress-reporter))))))
(defun vhdl-align-group (&optional spacing)
"Align group of lines between empty lines."
@@ -8031,7 +8025,7 @@ empty lines are aligned individually, if
`vhdl-align-groups' is non-nil."
(tabify orig end))
(unless no-message (message "Aligning inline comments...done")))))
-(defun vhdl-align-inline-comment-group (&optional spacing)
+(defun vhdl-align-inline-comment-group (&optional _spacing)
"Align inline comments within a group of lines between empty lines."
(interactive)
(save-excursion
@@ -8126,7 +8120,8 @@ end of line, do nothing in comments."
"Convert all words matching WORD-REGEXP in region to lower or upper case,
depending on parameter UPPER-CASE."
(let ((case-replace nil)
- (last-update 0))
+ (pr (when (and count vhdl-progress-interval (not noninteractive))
+ (make-progress-reporter "Fixing case..." beg (copy-marker end)))))
(vhdl-prepare-search-2
(save-excursion
(goto-char end)
@@ -8137,19 +8132,13 @@ depending on parameter UPPER-CASE."
(if upper-case
(upcase-word -1)
(downcase-word -1)))
- (when (and count vhdl-progress-interval (not noninteractive)
- (time-less-p vhdl-progress-interval
- (time-since last-update)))
- (message "Fixing case... (%2d%s)"
- (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
- "%")
- (setq last-update (time-convert nil 'integer))))
- (goto-char end)))))
-
-(defun vhdl-fix-case-region (beg end &optional arg)
+ (when pr (progress-reporter-update pr (point))))
+ (when pr (progress-reporter-done pr))))))
+
+(defun vhdl-fix-case-region (beg end &optional _arg)
"Convert all VHDL words in region to lower or upper case, depending on
options vhdl-upper-case-{keywords,types,attributes,enum-values}."
- (interactive "r\nP")
+ (interactive "r")
(vhdl-fix-case-region-1
beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
(vhdl-fix-case-region-1
@@ -8195,11 +8184,11 @@ options
vhdl-upper-case-{keywords,types,attributes,enum-values}."
;; - force each statement to be on a separate line except when on same line
;; with 'end' keyword
-(defun vhdl-fix-statement-region (beg end &optional arg)
+(defun vhdl-fix-statement-region (beg end &optional _arg)
"Force statements in region on separate line except when on same line
with `end' keyword (necessary for correct indentation).
Currently supported keywords: `begin', `if'."
- (interactive "r\nP")
+ (interactive "r")
(vhdl-prepare-search-2
(let (point)
(save-excursion
@@ -8251,9 +8240,9 @@ with `end' keyword (necessary for correct indentation)."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Trailing spaces
-(defun vhdl-remove-trailing-spaces-region (beg end &optional arg)
+(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg)
"Remove trailing spaces in region."
- (interactive "r\nP")
+ (interactive "r")
(save-excursion
(goto-char end)
(setq end (point-marker))
@@ -8283,7 +8272,7 @@ case fixing to a region. Calls functions
`vhdl-indent-buffer',
(replace-match "" nil t)))
(when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
(when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
- (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
+ (when (nth 2 vhdl-beautify-options) (indent-region beg end))
(when (nth 3 vhdl-beautify-options)
(let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
(when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
@@ -8516,7 +8505,7 @@ buffer."
(delete-region sens-beg sens-end)
(when read-list
(insert " ()") (backward-char)))
- (setq read-list (sort read-list 'string<))
+ (setq read-list (sort read-list #'string<))
(when read-list
(setq margin (current-column))
(insert (car read-list))
@@ -8548,7 +8537,7 @@ buffer."
(concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
"." (file-name-extension (buffer-file-name)))))
(vhdl-visit-file
- file-name t
+ file-name t
(vhdl-prepare-search-2
(goto-char (point-min))
(if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>")
nil t))
@@ -8556,7 +8545,8 @@ buffer."
(when (setq beg (vhdl-re-search-forward
"\\<port[ \t\n\r\f]*("
(save-excursion
- (re-search-forward "^end\\>" nil t)) t))
+ (re-search-forward "^end\\>" nil t))
+ t))
(setq end (save-excursion
(backward-char) (forward-sexp) (point)))
(vhdl-forward-syntactic-ws)
@@ -8688,9 +8678,9 @@ buffer."
Used for undoing after template abortion.")
;; correct different behavior of function `unread-command-events' in XEmacs
-(defun vhdl-character-to-event (arg))
+(defun vhdl-character-to-event (_arg) nil)
(defalias 'vhdl-character-to-event
- (if (fboundp 'character-to-event) 'character-to-event 'identity))
+ (if (fboundp 'character-to-event) #'character-to-event #'identity))
(defun vhdl-work-library ()
"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."
(re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
(equal "CONFIGURATION" (upcase (match-string 1))))
(if (eq (vhdl-decision-query
- "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
+ "configuration" "(b)lock or (c)omponent configuration?" t)
+ ?c)
(vhdl-template-component-conf)
(vhdl-template-block-configuration)))
(t (vhdl-template-configuration-decl))))) ; otherwise
@@ -9256,7 +9247,7 @@ a configuration declaration if not within a design unit."
(interactive)
(let ((margin (current-indentation))
(start (point))
- entity-exists string name position)
+ name position) ;; entity-exists string
(vhdl-insert-keyword "CONTEXT ")
(when (setq name (vhdl-template-field "name" nil t start (point)))
(vhdl-insert-keyword " IS\n")
@@ -9412,7 +9403,8 @@ otherwise."
(re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
(equal "CONFIGURATION" (upcase (match-string 1))))
(if (eq (vhdl-decision-query
- "for" "(b)lock or (c)omponent configuration?" t) ?c)
+ "for" "(b)lock or (c)omponent configuration?" t)
+ ?c)
(vhdl-template-component-conf)
(vhdl-template-block-configuration)))
((and (save-excursion
@@ -9527,11 +9519,12 @@ otherwise."
(defun vhdl-template-group ()
"Insert group or group template declaration."
(interactive)
- (let ((start (point)))
- (if (eq (vhdl-decision-query
- "group" "(d)eclaration or (t)emplate declaration?" t) ?t)
- (vhdl-template-group-template)
- (vhdl-template-group-decl))))
+ ;; (let ((start (point)))
+ (if (eq (vhdl-decision-query
+ "group" "(d)eclaration or (t)emplate declaration?" t)
+ ?t)
+ (vhdl-template-group-template)
+ (vhdl-template-group-decl))) ;; )
(defun vhdl-template-group-decl ()
"Insert group declaration."
@@ -10472,7 +10465,8 @@ specification, if not already there."
(and (not (bobp))
(re-search-backward
(concat
"^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
- library "\\|end\\)\\>") nil t)
+ library "\\|end\\)\\>")
+ nil t)
(match-string 2))))
(equal (downcase library) "work"))
(vhdl-insert-keyword "LIBRARY ")
@@ -10832,9 +10826,9 @@ If starting after end-comment-column, start a new line."
(vhdl-line-kill-entire)))))
(goto-char final-pos))))
-(defun vhdl-comment-uncomment-region (beg end &optional arg)
+(defun vhdl-comment-uncomment-region (beg end &optional _arg)
"Comment out region if not commented out, uncomment otherwise."
- (interactive "r\nP")
+ (interactive "r")
(save-excursion
(goto-char (1- end))
(end-of-line)
@@ -10911,7 +10905,7 @@ Point is left between them."
"Read from user a procedure or function argument list."
(insert " (")
(let ((margin (current-column))
- (start (point))
+ ;; (start (point))
(end-pos (point))
not-empty interface semicolon-pos)
(unless vhdl-argument-list-indent
@@ -10920,7 +10914,8 @@ Point is left between them."
(indent-to margin))
(setq interface (vhdl-template-field
(concat "[CONSTANT | SIGNAL"
- (unless is-function " | VARIABLE") "]") " " t))
+ (unless is-function " | VARIABLE") "]")
+ " " t))
(while (vhdl-template-field "[names]" nil t)
(setq not-empty t)
(insert " : ")
@@ -10937,7 +10932,8 @@ Point is left between them."
(indent-to margin)
(setq interface (vhdl-template-field
(concat "[CONSTANT | SIGNAL"
- (unless is-function " | VARIABLE") "]") " " t)))
+ (unless is-function " | VARIABLE") "]")
+ " " t)))
(delete-region end-pos (point))
(when semicolon-pos (goto-char semicolon-pos))
(if not-empty
@@ -11157,7 +11153,7 @@ with double-quotes is to be inserted. DEFAULT
specifies a default string."
"Adjust case of following NUM words."
(if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
-(defun vhdl-minibuffer-tab (&optional prefix-arg)
+(defun vhdl-minibuffer-tab (&optional arg)
"If preceding character is part of a word or a paren then hippie-expand,
else insert tab (used for word completion in VHDL minibuffer)."
(interactive "P")
@@ -11170,12 +11166,12 @@ else insert tab (used for word completion in VHDL
minibuffer)."
(or (and (boundp 'hippie-expand-only-buffers)
hippie-expand-only-buffers)
'(vhdl-mode))))
- (vhdl-expand-abbrev prefix-arg)))
+ (vhdl-expand-abbrev arg)))
;; expand parenthesis
((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
(case-replace nil))
- (vhdl-expand-paren prefix-arg)))
+ (vhdl-expand-paren arg)))
;; insert tab
(t (insert-tab))))
@@ -11562,7 +11558,8 @@ but not if inside a comment or quote."
(unless (equal model-keyword "")
(eval `(defun
,(vhdl-function-name
- "vhdl-model" model-name "hook") ()
+ "vhdl-model" model-name "hook")
+ ()
(vhdl-hooked-abbrev
',(vhdl-function-name "vhdl-model" model-name)))))
(setq model-alist (cdr model-alist)))))
@@ -11858,7 +11855,7 @@ reflected in a subsequent paste operation."
(defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
"Paste a context clause."
- (let ((margin (current-indentation))
+ (let (;; (margin (current-indentation))
(clause-list (nth 3 vhdl-port-list))
clause)
(while clause-list
@@ -11868,7 +11865,8 @@ reflected in a subsequent paste operation."
(save-excursion
(re-search-backward
(concat "^\\s-*use\\s-+" (car clause)
- "." (cdr clause) "\\>") nil t)))
+ "." (cdr clause) "\\>")
+ nil t)))
(vhdl-template-standard-package (car clause) (cdr clause))
(insert "\n"))
(setq clause-list (cdr clause-list)))))
@@ -12260,7 +12258,8 @@ reflected in a subsequent paste operation."
(cond ((and vhdl-include-direction-comments (nth 2 port))
(format "%-6s" (concat "[" (nth 2 port) "] ")))
(vhdl-include-direction-comments " "))
- (when vhdl-include-port-comments (nth 4 port))) t))
+ (when vhdl-include-port-comments (nth 4 port)))
+ t))
(setq port-list (cdr port-list))
(when port-list (insert "\n") (indent-to margin)))
;; align signal list
@@ -12314,7 +12313,7 @@ reflected in a subsequent paste operation."
(let ((case-fold-search t)
(ent-name (vhdl-replace-string vhdl-testbench-entity-name
(nth 0 vhdl-port-list)))
- (source-buffer (current-buffer))
+ ;; (source-buffer (current-buffer))
arch-name config-name ent-file-name arch-file-name
ent-buffer arch-buffer position)
;; open entity file
@@ -12411,7 +12410,7 @@ reflected in a subsequent paste operation."
(insert "\n")
(setq position (point))
(vhdl-insert-string-or-file vhdl-testbench-declarations)
- (vhdl-indent-region position (point)))
+ (indent-region position (point)))
(setq position (point))
(insert "\n\n")
(vhdl-comment-display-line) (insert "\n")
@@ -12442,7 +12441,7 @@ reflected in a subsequent paste operation."
(insert "\n")
(setq position (point))
(vhdl-insert-string-or-file vhdl-testbench-statements)
- (vhdl-indent-region position (point)))
+ (indent-region position (point)))
(insert "\n")
(indent-to vhdl-basic-offset)
(unless (eq vhdl-testbench-create-files 'none)
@@ -12815,7 +12814,7 @@ expressions (e.g. for index ranges of types and
signals)."
;; override `he-list-beg' from `hippie-exp'
(unless (and (boundp 'viper-mode) viper-mode)
- (defalias 'he-list-beg 'vhdl-he-list-beg))
+ (defalias 'he-list-beg #'vhdl-he-list-beg))
;; function for expanding abbrevs and dabbrevs
(defalias 'vhdl-expand-abbrev (make-hippie-expand-function
@@ -12862,14 +12861,14 @@ expressions (e.g. for index ranges of types and
signals)."
(beginning-of-line)
(yank))
-(defun vhdl-line-expand (&optional prefix-arg)
+(defun vhdl-line-expand (&optional arg)
"Hippie-expand current line."
(interactive "P")
(require 'hippie-exp)
(let ((case-fold-search t) (case-replace nil)
(hippie-expand-try-functions-list
'(try-expand-line try-expand-line-all-buffers)))
- (hippie-expand prefix-arg)))
+ (hippie-expand arg)))
(defun vhdl-line-transpose-next (&optional arg)
"Interchange this line with next line."
@@ -12991,7 +12990,7 @@ File statistics: \"%s\"\n\
# total lines : %5d\n"
(buffer-file-name) no-stats no-code-lines no-empty-lines
no-comm-lines no-comments no-lines)
- (unless vhdl-emacs-21 (vhdl-show-messages))))
+ (when (featurep 'xemacs) (vhdl-show-messages))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Help functions
@@ -13040,7 +13039,7 @@ File statistics: \"%s\"\n\
(customize-set-variable 'vhdl-project vhdl-project)
(customize-save-customized))
-(defun vhdl-toggle-project (name token indent)
+(defun vhdl-toggle-project (name _token _indent)
"Set current project to NAME or unset if NAME is current project."
(vhdl-set-project (if (equal name vhdl-project) "" name)))
@@ -13244,6 +13243,7 @@ File statistics: \"%s\"\n\
"Toggle hideshow minor mode and update menu bar."
(interactive "P")
(require 'hideshow)
+ (declare-function hs-hide-all "hideshow" ())
;; check for hideshow version 5.x
(if (not (boundp 'hs-block-start-mdata-select))
(vhdl-warning-when-idle "Install included `hideshow.el' patch first (see
INSTALL file)")
@@ -13255,8 +13255,8 @@ File statistics: \"%s\"\n\
hs-special-modes-alist)))
(if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
(if vhdl-hide-all-init
- (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t)
- (remove-hook 'hs-minor-mode-hook 'hs-hide-all t))
+ (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t)
+ (remove-hook 'hs-minor-mode-hook #'hs-hide-all t))
(hs-minor-mode arg)
(force-mode-line-update))) ; hack to update menu bar
@@ -13523,6 +13523,8 @@ This does background highlighting of translate-off
regions.")
(while syntax-alist
(setq name (vhdl-function-name
"vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
+ ;; FIXME: This `defvar' shouldn't be needed: just quote the face
+ ;; name when you use it.
(eval `(defvar ,name ',name
,(concat "Face name to use for "
(nth 0 (car syntax-alist)) ".")))
@@ -13735,7 +13737,7 @@ This does background highlighting of translate-off
regions.")
(when (boundp 'ps-print-color-p)
(vhdl-ps-print-settings))
(if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
- (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t)))
+ (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -13907,7 +13909,7 @@ hierarchy otherwise.")
pack-list pack-body-list inst-list inst-ent-list)
;; scan file
(vhdl-visit-file
- file-name nil
+ file-name nil
(vhdl-prepare-search-2
(save-excursion
;; scan for design units
@@ -14082,7 +14084,8 @@ hierarchy otherwise.")
"component[ \t\n\r\f]+\\(\\w+\\)\\|"
"\\(\\(entity\\)\\|configuration\\)[
\t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
- "\\(^[ \t]*end[
\t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
+ "\\(^[ \t]*end[
\t\n\r\f]+\\(generate\\|block\\)\\>\\)")
+ end-of-unit t)
(or (not limit-hier-inst-no)
(<= (if (or (match-string 14)
(match-string 16))
@@ -14444,12 +14447,15 @@ of PROJECT."
;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
;; comp-lib-name level)
-(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
- conf-inst-alist level indent
- &optional include-top ent-hier)
+(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key
+ conf-key-arg conf-inst-alist level indent
+ &optional include-top ent-hier)
"Get instantiation hierarchy beginning in architecture ARCH-KEY of
entity ENT-KEY."
- (let* ((ent-entry (vhdl-aget ent-alist ent-key))
+ (let* ((ent-alist ent-alist-arg)
+ (conf-alist conf-alist-arg)
+ (conf-key conf-key-arg)
+ (ent-entry (vhdl-aget ent-alist ent-key))
(arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
(cdar (last (nth 3 ent-entry)))))
(inst-alist (nth 3 arch-entry))
@@ -14581,6 +14587,8 @@ entity ENT-KEY."
(error (progn (vhdl-warning "ERROR: An error occurred while saving the
hierarchy caches")
(sit-for 2)))))
+(defvar vhdl-cache-version)
+
(defun vhdl-save-cache (key)
"Save current hierarchy cache to file."
(let* ((orig-buffer (current-buffer))
@@ -14667,7 +14675,7 @@ entity ENT-KEY."
(file-dir-name (expand-file-name file-name directory))
vhdl-cache-version)
(unless (memq 'vhdl-save-caches kill-emacs-hook)
- (add-hook 'kill-emacs-hook 'vhdl-save-caches))
+ (add-hook 'kill-emacs-hook #'vhdl-save-caches))
(when (file-exists-p file-dir-name)
(condition-case ()
(progn (load-file file-dir-name)
@@ -14707,6 +14715,8 @@ if required."
(declare-function speedbar-change-initial-expansion-list "speedbar"
(new-default))
(declare-function speedbar-add-expansion-list "speedbar" (new-list))
+(declare-function speedbar-expand-line "speedbar" (&optional arg))
+(declare-function speedbar-edit-line "speedbar" ())
(defun vhdl-speedbar-initialize ()
"Initialize speedbar."
@@ -14731,19 +14741,19 @@ if required."
;; keymap
(unless vhdl-speedbar-mode-map
(setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
- (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line)
- (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line)
- (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line)
- (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line)
- (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level)
- (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all)
- (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy)
- (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component)
- (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration)
- (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra)
- (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design)
- (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy)
- (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches)
+ (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line)
+ (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line)
+ (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line)
+ (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line)
+ (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level)
+ (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all)
+ (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy)
+ (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component)
+ (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration)
+ (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra)
+ (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design)
+ (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy)
+ (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches)
(let ((key 0))
(while (<= key 9)
(define-key vhdl-speedbar-mode-map (int-to-string key)
@@ -14814,7 +14824,7 @@ if required."
(setq speedbar-initial-expansion-list-name "vhdl directory"))
(when (eq vhdl-speedbar-display-mode 'project)
(setq speedbar-initial-expansion-list-name "vhdl project"))
- (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
+ (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy)))
(defun vhdl-speedbar (&optional arg)
"Open/close speedbar."
@@ -14832,17 +14842,17 @@ if required."
"Name of last selected project.")
;; macros must be defined in the file they are used (copied from `speedbar.el')
-;;; (defmacro speedbar-with-writable (&rest forms)
-;;; "Allow the buffer to be writable and evaluate FORMS."
-;;; (list 'let '((inhibit-read-only t))
-;;; (cons 'progn forms)))
-;;; (put 'speedbar-with-writable 'lisp-indent-function 0)
+;; (defmacro speedbar-with-writable (&rest forms)
+;; "Allow the buffer to be writable and evaluate FORMS."
+;; (declare (indent 0) (debug t))
+;; (list 'let '((inhibit-read-only t))
+;; (cons 'progn forms)))
(declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
(declare-function speedbar-directory-buttons "speedbar" (directory _index))
(declare-function speedbar-file-lists "speedbar" (directory))
-(defun vhdl-speedbar-display-directory (directory depth &optional rescan)
+(defun vhdl-speedbar-display-directory (directory depth &optional _rescan)
"Display directory and hierarchy information in speedbar."
(setq vhdl-speedbar-show-projects nil)
(setq speedbar-ignored-directory-regexp
@@ -14863,7 +14873,7 @@ if required."
(when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
(error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information,
unable to display correctly")))))
-(defun vhdl-speedbar-display-projects (project depth &optional rescan)
+(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan)
"Display projects and hierarchy information in speedbar."
(setq vhdl-speedbar-show-projects t)
(setq speedbar-ignored-directory-regexp ".")
@@ -14879,6 +14889,8 @@ if required."
(declare-function speedbar-make-tag-line "speedbar"
(type char func data tag tfunc tdata tface depth))
+(defvar vhdl-speedbar-update-current-unit)
+
(defun vhdl-speedbar-insert-projects ()
"Insert all projects in speedbar."
(vhdl-speedbar-make-title-line "Projects:")
@@ -14889,9 +14901,9 @@ if required."
;; insert projects
(while project-alist
(speedbar-make-tag-line
- 'angle ?+ 'vhdl-speedbar-expand-project
+ 'angle ?+ #'vhdl-speedbar-expand-project
(caar project-alist) (caar project-alist)
- 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
+ #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
(setq project-alist (cdr project-alist)))
(setq project-alist vhdl-project-alist)
;; expand projects
@@ -14938,12 +14950,14 @@ otherwise use cached data."
(vhdl-speedbar-expand-units directory)
(vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
-(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
- ent-inst-list depth)
+(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist
+ ent-inst-list depth)
"Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
(if (not (or ent-alist conf-alist pack-alist))
(vhdl-speedbar-make-title-line "No VHDL design units!" depth)
- (let (ent-entry conf-entry pack-entry)
+ (let ((ent-alist ent-alist-arg)
+ (conf-alist conf-alist-arg)
+ ent-entry conf-entry pack-entry)
;; insert entities
(when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
(while ent-alist
@@ -15004,7 +15018,7 @@ otherwise use cached data."
(declare-function speedbar-goto-this-file "speedbar" (file))
-(defun vhdl-speedbar-expand-dirs (directory)
+(defun vhdl-speedbar-expand-dirs (_directory)
"Expand subdirectories in DIRECTORY according to
`speedbar-shown-directories'."
;; (nicked from `speedbar-default-directory-list')
@@ -15043,7 +15057,8 @@ otherwise use cached data."
(goto-char position)
(when (re-search-forward
(concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
- (car arch-alist) "\\>\\)") nil t)
+ (car arch-alist) "\\>\\)")
+ nil t)
(beginning-of-line)
(when (looking-at "^[0-9]+:\\s-*{")
(goto-char (match-end 0))
@@ -15412,6 +15427,7 @@ otherwise use cached data."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Display help functions
+;; FIXME: This `defvar' should be moved before its first use.
(defvar vhdl-speedbar-update-current-unit t
"Non-nil means to run `vhdl-speedbar-update-current-unit'.")
@@ -15847,7 +15863,7 @@ NO-POSITION non-nil means do not re-position cursor."
(abbreviate-file-name
(file-name-as-directory (speedbar-line-directory indent)))))
-(defun vhdl-speedbar-line-project (&optional indent)
+(defun vhdl-speedbar-line-project (&optional _indent)
"Get currently displayed project name."
(and vhdl-speedbar-show-projects
(save-excursion
@@ -15917,7 +15933,7 @@ NO-POSITION non-nil means do not re-position cursor."
;; speedbar loads dframe at runtime.
(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
-(defun vhdl-speedbar-find-file (text token indent)
+(defun vhdl-speedbar-find-file (_text token _indent)
"When user clicks on TEXT, load file with name and position in TOKEN.
Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
is already shown in a buffer."
@@ -15945,12 +15961,12 @@ is already shown in a buffer."
(let ((token (get-text-property
(match-beginning 3) 'speedbar-token)))
(vhdl-visit-file (car token) t
- (progn (goto-char (point-min))
- (forward-line (1- (cdr token)))
- (end-of-line)
- (if is-entity
- (vhdl-port-copy)
- (vhdl-subprog-copy)))))
+ (goto-char (point-min))
+ (forward-line (1- (cdr token)))
+ (end-of-line)
+ (if is-entity
+ (vhdl-port-copy)
+ (vhdl-subprog-copy))))
(error (error "ERROR: %s not scanned successfully\n (%s)"
(if is-entity "Port" "Interface") (cadr info))))
(error "ERROR: No entity/component or subprogram on current line")))))
@@ -16140,7 +16156,7 @@ expansion function)."
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
- (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize))
+ (with-no-warnings (add-hook 'speedbar-load-hook
#'vhdl-speedbar-initialize))
(vhdl-speedbar-initialize)
(when speedbar-frame (vhdl-speedbar-refresh)))
@@ -16168,7 +16184,7 @@ expansion function)."
(read-from-minibuffer "architecture name: "
nil vhdl-minibuffer-local-map)
(vhdl-replace-string vhdl-compose-architecture-name ent-name)))
- ent-file-name arch-file-name ent-buffer arch-buffer project end-pos)
+ ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project
(message "Creating component \"%s(%s)\"..." ent-name arch-name)
;; open entity file
(unless (eq vhdl-compose-create-files 'none)
@@ -16368,7 +16384,7 @@ component instantiation."
(if comp-name
;; ... from component declaration
(vhdl-visit-file
- (when vhdl-use-components-package pack-file-name) t
+ (when vhdl-use-components-package pack-file-name) t
(save-excursion
(goto-char (point-min))
(unless (re-search-forward (concat "^\\s-*component[
\t\n\r\f]+" comp-name "\\>") nil t)
@@ -16379,7 +16395,7 @@ component instantiation."
(concat (vhdl-replace-string vhdl-entity-file-name
comp-ent-name t)
"." (file-name-extension (buffer-file-name))))
(vhdl-visit-file
- comp-ent-file-name t
+ comp-ent-file-name t
(save-excursion
(goto-char (point-min))
(unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+"
comp-ent-name "\\>") nil t)
@@ -16652,6 +16668,8 @@ component instantiation."
(vhdl-comment-insert-inline (nth 4 entry) t))
(insert "\n"))
+(defvar lazy-lock-minimum-size)
+
(defun vhdl-compose-components-package ()
"Generate a package containing component declarations for all entities in the
current project/directory."
@@ -16704,10 +16722,10 @@ current project/directory."
;; insert component declarations
(while ent-alist
(vhdl-visit-file (nth 2 (car ent-alist)) nil
- (progn (goto-char (point-min))
- (forward-line (1- (nth 3 (car ent-alist))))
- (end-of-line)
- (vhdl-port-copy)))
+ (goto-char (point-min))
+ (forward-line (1- (nth 3 (car ent-alist))))
+ (end-of-line)
+ (vhdl-port-copy))
(goto-char component-pos)
(vhdl-port-paste-component t)
(when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
@@ -16721,13 +16739,16 @@ current project/directory."
(message "Generating components package \"%s\"...done\n File created:
\"%s\""
pack-name pack-file-name)))
-(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
- conf-alist inst-alist
- &optional insert-conf)
+(defun vhdl-compose-configuration-architecture ( _ent-name arch-name
+ ent-alist-arg conf-alist-arg
+ inst-alist
+ &optional insert-conf)
"Generate block configuration for architecture."
- (let ((margin (current-indentation))
+ (let ((ent-alist ent-alist-arg)
+ (conf-alist conf-alist-arg)
+ (margin (current-indentation))
(beg (point-at-bol))
- ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
+ ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key
;; insert block configuration (for architecture)
(vhdl-insert-keyword "FOR ") (insert arch-name "\n")
(setq margin (+ margin vhdl-basic-offset))
@@ -17078,7 +17099,7 @@ do not print any file names."
(file-relative-name (buffer-file-name))))
(when (and (= 0 (nth 1 (nth 10 compiler)))
(= 0 (nth 1 (nth 11 compiler))))
- (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
+ (setq compilation-process-setup-function #'vhdl-compile-print-file-name))
;; run compilation
(if options
(when command
@@ -17152,7 +17173,7 @@ specified by a target."
vhdl-error-regexp-emacs-alist)))
(when vhdl-emacs-22
- (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs))
+ (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Makefile generation
@@ -17431,7 +17452,7 @@ specified by a target."
(setq tmp-list rule-alist)
(while tmp-list ; pre-sort rule targets
(setq cell (cdar tmp-list))
- (setcar cell (sort (car cell) 'string<))
+ (setcar cell (sort (car cell) #'string<))
(setq tmp-list (cdr tmp-list)))
(setq rule-alist ; sort by first rule target
(sort rule-alist
@@ -17521,9 +17542,9 @@ specified by a target."
;; insert rule for each library unit
(insert "\n\n# Rules for compiling single library units and their
subhierarchy\n")
(while prim-list
- (setq second-list (sort (nth 1 (car prim-list)) 'string<))
+ (setq second-list (sort (nth 1 (car prim-list)) #'string<))
(setq subcomp-list
- (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
+ (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<))
(setq unit-key (caar prim-list)
unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
(nth 0 (vhdl-aget conf-alist unit-key))
@@ -17553,7 +17574,7 @@ specified by a target."
(vhdl-get-compile-options project compiler (nth 0 rule) t))
;; insert rule if file is supposed to be compiled
(setq target-list (nth 1 rule)
- depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
+ depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<))
;; insert targets
(setq tmp-list target-list)
(while target-list
@@ -17576,7 +17597,8 @@ specified by a target."
(if (eq options 'default) "$(OPTIONS)" options) " "
(nth 0 rule)
(if (equal vhdl-compile-post-command "") ""
- " $(POST-COMPILE)") "\n")
+ " $(POST-COMPILE)")
+ "\n")
(insert "\n"))
(unless (and options mapping-exist)
(setq tmp-list target-list)
@@ -17616,6 +17638,7 @@ specified by a target."
"Submit via mail a bug report on VHDL Mode."
(interactive)
;; load in reporter
+ (defvar reporter-prompt-for-summary-p)
(and
(y-or-n-p "Do you want to submit a report on VHDL Mode? ")
(let ((reporter-prompt-for-summary-p t))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index cada1f1..3d2f21a 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1416,7 +1416,8 @@ IGNORES is a list of glob patterns for files to ignore."
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
files
(file-name-as-directory
- (file-local-name (expand-file-name dir)))
+ (file-name-unquote
+ (file-local-name (expand-file-name
dir))))
ignores))
(def default-directory)
(buf (get-buffer-create " *xref-grep*"))
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 7bf2f71..72cbcf8 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -1,4 +1,4 @@
-;;; ps-bdf.el --- BDF font file handler for ps-print
+;;; ps-bdf.el --- BDF font file handler for ps-print -*- lexical-binding: t;
-*-
;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
;; 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."
(defun bdf-initialize ()
"Initialize `bdf' library."
(and (bdf-read-cache)
- (add-hook 'kill-emacs-hook 'bdf-write-cache)))
+ (add-hook 'kill-emacs-hook #'bdf-write-cache)))
(defun bdf-compact-code (code code-range)
(if (or (< code (aref code-range 4))
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index db86f94..a8b5210 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,4 +1,4 @@
-;;; ps-mule.el --- provide multi-byte character facility to ps-print
+;;; ps-mule.el --- provide multi-byte character facility to ps-print -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -612,7 +612,7 @@ f2, f3, h0, h1, and H0 respectively."
(push (/ code 256) code-list)
(push (% code 256) code-list))))
(forward-char 1)))
- (apply 'unibyte-string (nreverse code-list))))
+ (apply #'unibyte-string (nreverse code-list))))
(defun ps-mule-plot-composition (composition font-spec-table)
"Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE."
@@ -1041,10 +1041,11 @@ Any other value is treated as \"/H0\"."
(list (ps-mule-encode-region (point-min) (point-max)
(aref ps-mule-font-spec-tables
(aref ps-mule-font-number-to-type
- (cond ((string= fonttag "/h0") 4)
- ((string= fonttag "/h1") 5)
- ((string= fonttag "/L0") 6)
- (t 0))))))))
+ (pcase fonttag
+ ("/h0" 4)
+ ("/h1" 5)
+ ("/L0" 6)
+ (_ 0))))))))
;;;###autoload
(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."
(goto-char from)
(= (skip-chars-forward "\x00-\x7F" to) to)))
;; All characters can be printed by normal PostScript fonts.
- (setq ps-basic-plot-string-function 'ps-basic-plot-string
+ (setq ps-basic-plot-string-function #'ps-basic-plot-string
;; FIXME: Doesn't ps-encode-header-string-function take 2 args?
- ps-encode-header-string-function 'identity)
- (setq ps-basic-plot-string-function 'ps-mule-plot-string
- ps-encode-header-string-function 'ps-mule-encode-header-string
+ ps-encode-header-string-function #'identity)
+ (setq ps-basic-plot-string-function #'ps-mule-plot-string
+ ps-encode-header-string-function #'ps-mule-encode-header-string
ps-mule-font-info-database
- (cond ((eq ps-multibyte-buffer 'non-latin-printer)
- ps-mule-font-info-database-ps)
- ((eq ps-multibyte-buffer 'bdf-font)
- ps-mule-font-info-database-bdf)
- ((eq ps-multibyte-buffer 'bdf-font-except-latin)
- ps-mule-font-info-database-ps-bdf)
- (t
- ps-mule-font-info-database-default)))
+ (pcase ps-multibyte-buffer
+ ('non-latin-printer ps-mule-font-info-database-ps)
+ ('bdf-font ps-mule-font-info-database-bdf)
+ ('bdf-font-except-latin ps-mule-font-info-database-ps-bdf)
+ (_ ps-mule-font-info-database-default)))
;; Be sure to have font information for Latin-1.
(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."
id-max (1+ id-max))
(if (ps-mule-check-font font-spec)
(aset font-spec-vec
- (cond ((eq (car e) 'normal) 0)
- ((eq (car e) 'bold) 1)
- ((eq (car e) 'italic) 2)
- (t 3)) font-spec)))
+ (pcase (car e)
+ ('normal 0)
+ ('bold 1)
+ ('italic 2)
+ (_ 3))
+ font-spec)))
(when (aref font-spec-vec 0)
(or (aref font-spec-vec 3)
(aset font-spec-vec 3 (or (aref font-spec-vec 1)
@@ -1182,7 +1182,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
(let ((output-head (list t))
(ps-mule-output-list (list t)))
(dotimes (i 4)
- (map-char-table 'ps-mule-prepare-glyph
+ (map-char-table #'ps-mule-prepare-glyph
(aref ps-mule-font-spec-tables i)))
(ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
(ps-output-prologue (cdr output-head)))
diff --git a/lisp/rect.el b/lisp/rect.el
index cb941b4..504be41 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -652,7 +652,7 @@ with a prefix argument, prompt for START-AT and FORMAT."
"Toggle the region as rectangular.
Activates the region if needed. Only lasts until the region is deactivated."
- nil nil nil
+ :lighter nil
(rectangle--reset-crutches)
(when rectangle-mark-mode
(add-hook 'deactivate-mark-hook
diff --git a/lisp/repeat.el b/lisp/repeat.el
index a2b04b8..b7118cc 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -342,6 +342,34 @@ For example, you can set it to <return> like
`isearch-exit'."
:group 'convenience
:version "28.1")
+(defcustom repeat-keep-prefix t
+ "Keep the prefix arg of the previous command."
+ :type 'boolean
+ :group 'convenience
+ :version "28.1")
+
+(defcustom repeat-echo-function #'repeat-echo-message
+ "Function to display a hint about available keys.
+Function is called after every repeatable command with one argument:
+a repeating map, or nil after deactivating the repeat mode."
+ :type '(choice (const :tag "Show hints in the echo area"
+ repeat-echo-message)
+ (const :tag "Show indicator in the mode line"
+ repeat-echo-mode-line)
+ (const :tag "No visual feedback" ignore)
+ (function :tag "Function"))
+ :group 'convenience
+ :version "28.1")
+
+(defvar repeat-in-progress nil
+ "Non-nil when the repeating map is active.")
+
+;;;###autoload
+(defvar repeat-map nil
+ "The value of the repeating map for the next command.
+A command called from the map can set it again to the same map when
+the map can't be set on the command symbol property `repeat-map'.")
+
;;;###autoload
(define-minor-mode repeat-mode
"Toggle Repeat mode.
@@ -363,42 +391,73 @@ When Repeat mode is enabled, and the command symbol has
the property named
(defun repeat-post-hook ()
"Function run after commands to set transient keymap for repeatable keys."
- (when repeat-mode
- (let ((repeat-map (and (symbolp this-command)
- (get this-command 'repeat-map))))
- (when repeat-map
- (when (boundp repeat-map)
- (setq repeat-map (symbol-value repeat-map)))
- (let ((map (copy-keymap repeat-map))
- keys mess)
- (map-keymap (lambda (key _) (push key keys)) map)
-
- ;; Exit when the last char is not among repeatable keys,
- ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
- (when (or (memq last-command-event keys)
- (memq this-original-command '(universal-argument
- universal-argument-more
- digit-argument
- negative-argument)))
- ;; Messaging
- (setq mess (format-message
- "Repeat with %s%s"
- (mapconcat (lambda (key)
- (key-description (vector key)))
- keys ", ")
- (if repeat-exit-key
- (format ", or exit with %s"
- (key-description repeat-exit-key))
- "")))
- (if (current-message)
- (message "%s [%s]" (current-message) mess)
- (message mess))
-
- ;; Adding an exit key
- (when repeat-exit-key
- (define-key map repeat-exit-key 'ignore))
-
- (set-transient-map map)))))))
+ (let ((was-in-progress repeat-in-progress))
+ (setq repeat-in-progress nil)
+ (when repeat-mode
+ (let ((rep-map (or repeat-map
+ (and (symbolp real-this-command)
+ (get real-this-command 'repeat-map)))))
+ (when rep-map
+ (when (boundp rep-map)
+ (setq rep-map (symbol-value rep-map)))
+ (let ((map (copy-keymap rep-map)))
+
+ ;; Exit when the last char is not among repeatable keys,
+ ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
+ (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
+ (or (lookup-key map (this-command-keys-vector))
+ prefix-arg))
+
+ ;; Messaging
+ (unless prefix-arg
+ (funcall repeat-echo-function map))
+
+ ;; Adding an exit key
+ (when repeat-exit-key
+ (define-key map repeat-exit-key 'ignore))
+
+ (when (and repeat-keep-prefix (not prefix-arg))
+ (setq prefix-arg current-prefix-arg))
+
+ (setq repeat-in-progress t)
+ (set-transient-map map))))))
+
+ (setq repeat-map nil)
+ (when (and was-in-progress (not repeat-in-progress))
+ (funcall repeat-echo-function nil))))
+
+(defun repeat-echo-message-string (map)
+ "Return a string with a list of repeating keys."
+ (let (keys)
+ (map-keymap (lambda (key _) (push key keys)) map)
+ (format-message "Repeat with %s%s"
+ (mapconcat (lambda (key)
+ (key-description (vector key)))
+ keys ", ")
+ (if repeat-exit-key
+ (format ", or exit with %s"
+ (key-description repeat-exit-key))
+ ""))))
+
+(defun repeat-echo-message (map)
+ "Display available repeating keys in the echo area."
+ (when map
+ (let ((mess (repeat-echo-message-string map)))
+ (if (current-message)
+ (message "%s [%s]" (current-message) mess)
+ (message mess)))))
+
+(defvar repeat-echo-mode-line-string
+ (propertize "[Repeating...] " 'face 'mode-line-emphasis)
+ "String displayed in the mode line in repeating mode.")
+
+(defun repeat-echo-mode-line (map)
+ "Display the repeat indicator in the mode line."
+ (if map
+ (unless (assq 'repeat-in-progress mode-line-modes)
+ (add-to-list 'mode-line-modes (list 'repeat-in-progress
+ repeat-echo-mode-line-string)))
+ (force-mode-line-update t)))
(provide 'repeat)
diff --git a/lisp/replace.el b/lisp/replace.el
index f131d26..71c6e65 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."
(defcustom list-matching-lines-jump-to-current-line nil
"If non-nil, \\[list-matching-lines] shows the current line highlighted.
-Set the point right after such line when there are matches after it."
+The current line for this purpose is the line of the original buffer
+which was current when \\[list-matching-lines] was invoked.
+Point in the `*Occur*' buffer will be set right after such line when
+there are matches after it."
:type 'boolean
:group 'matching
:version "26.1")
(defcustom list-matching-lines-prefix-face 'shadow
"Face used by \\[list-matching-lines] to show the prefix column.
-If the face doesn't differ from the default face,
-don't highlight the prefix with line numbers specially."
+The prefix column is the part of display that precedes the actual
+contents of the line; it normally shows the line number. \(For
+multiline matches, the prefix column shows the line number for the
+first line and whitespace for the rest of the lines.\)
+If this face will display the same as the default face, the prefix
+column will not be highlighted speciall."
:type 'face
:group 'matching
:version "24.4")
@@ -1565,11 +1572,24 @@ REGION must be a list of (START . END) positions as
returned by
`region-bounds'.
The lines are shown in a buffer named `*Occur*'.
-It serves as a menu to find any of the occurrences in this buffer.
+That buffer can serve as a menu for finding any of the matches for REGEXP
+in the current buffer.
\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
-If `list-matching-lines-jump-to-current-line' is non-nil, then show
-the current line highlighted with `list-matching-lines-current-line-face'
-and set point at the first match after such line.
+
+Matches for REGEXP are shown in the face determined by the
+variable `list-matching-lines-face'.
+Names of buffers with matched lines are shown in the face determined
+by the variable `list-matching-lines-buffer-name-face'.
+The line numbers of the matching lines are shown in the face
+determined by the variable `list-matching-lines-prefix-face'.
+
+If `list-matching-lines-jump-to-current-line' is non-nil, then the
+line in the current buffer which was current when the command was
+invoked will be shown in the `*Occur*' buffer highlighted with
+the `list-matching-lines-current-line-face', with point at the end
+of that line. (If the current line doesn't match REGEXP, it will
+nonetheless be inserted into the `*Occur*' buffer between the 2
+closest lines that do match REGEXP.)
If REGEXP contains upper case characters (excluding those preceded by `\\')
and `search-upper-case' is non-nil, the matching is case-sensitive.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 11226fd..a0d4f6e 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -568,8 +568,6 @@ format first."
;;;###autoload
(define-minor-mode ruler-mode
"Toggle display of ruler in header line (Ruler mode)."
- nil nil
- ruler-mode-map
:group 'ruler-mode
:variable (ruler-mode
. (lambda (enable)
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index 8ba0cc9..415244f 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -108,7 +108,7 @@ ARG is like in `end-of-buffer'."
When Scroll-All mode is enabled, scrolling commands invoked in
one window apply to all visible windows in the same frame."
- nil " *SL*" nil
+ :lighter " *SL*"
:global t
:group 'windows
(if scroll-all-mode
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index a03965c..f39f173 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,4 +1,4 @@
-;;; shadowfile.el --- automatic file copying
+;;; shadowfile.el --- automatic file copying -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -90,27 +90,23 @@
"If t, always copy shadow files without asking.
If nil (the default), always ask. If not nil and not t, ask only if there
is no buffer currently visiting the file."
- :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe))
- :group 'shadow)
+ :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)))
(defcustom shadow-inhibit-message nil
"If non-nil, do not display a message when a file needs copying."
- :type 'boolean
- :group 'shadow)
+ :type 'boolean)
(defcustom shadow-inhibit-overload nil
"If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs].
Normally it overloads the function `save-buffers-kill-emacs' to check for
files that have been changed and need to be copied to other systems."
- :type 'boolean
- :group 'shadow)
+ :type 'boolean)
(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows")
"File to keep shadow information in.
The `shadow-info-file' should be shadowed to all your accounts to
ensure consistency. Default: ~/.emacs.d/shadows"
:type 'file
- :group 'shadow
:version "26.2")
(defcustom shadow-todo-file
@@ -122,13 +118,12 @@ remember and ask you again in your next Emacs session.
This file must NOT be shadowed to any other system, it is host-specific.
Default: ~/.emacs.d/shadow_todo"
:type 'file
- :group 'shadow
:version "26.2")
-;;; The following two variables should in most cases initialize themselves
-;;; correctly. They are provided as variables in case the defaults are wrong
-;;; on your machine (and for efficiency).
+;; The following two variables should in most cases initialize themselves
+;; correctly. They are provided as variables in case the defaults are wrong
+;; on your machine (and for efficiency).
(defvar shadow-system-name (concat "/" (system-name) ":")
"The identification for local files on this machine.")
@@ -160,7 +155,7 @@ created by `shadow-define-regexp-group'.")
(defvar shadow-files-to-copy nil) ; List of files that need to
; be copied to remote hosts.
-(defvar shadow-hashtable nil) ; for speed
+(defvar shadow-hashtable (make-hash-table :test #'equal)) ; for speed
(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
@@ -191,11 +186,11 @@ PREFIX."
;;; Clusters and sites
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; I use the term `site' to refer to a string which may be the
-;;; cluster identification "/name:", a remote identification
-;;; "/method:user@host:", or "/system-name:" (the value of
-;;; `shadow-system-name') for the location of local files. All
-;;; user-level commands should accept either.
+;; I use the term `site' to refer to a string which may be the
+;; cluster identification "/name:", a remote identification
+;; "/method:user@host:", or "/system-name:" (the value of
+;; `shadow-system-name') for the location of local files. All
+;; user-level commands should accept either.
(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp)
@@ -580,7 +575,7 @@ be shadowed), and list of SITES."
Filename should have clusters expanded, but otherwise can have any format.
Return value is a list of dotted pairs like (from . to), where from
and to are absolute file names."
- (or (symbol-value (intern-soft file shadow-hashtable))
+ (or (gethash file shadow-hashtable)
(let* ((absolute-file (shadow-expand-file-name
(or (shadow-local-file file) file)
shadow-homedir))
@@ -598,7 +593,7 @@ and to are absolute file names."
"shadow-shadows-of: %s %s %s %s %s"
file (shadow-local-file file) shadow-homedir
absolute-file canonical-file))
- (set (intern file shadow-hashtable) shadows))))
+ (puthash file shadows shadow-hashtable))))
(defun shadow-shadows-of-1 (file groups regexp)
"Return list of FILE's shadows in GROUPS.
@@ -639,7 +634,7 @@ Consider them as regular expressions if third arg REGEXP is
true."
shadows shadow-files-to-copy (with-output-to-string (backtrace))))
(when shadows
(setq shadow-files-to-copy
- (cl-union shadows shadow-files-to-copy :test #'equal))
+ (nreverse (cl-union shadows shadow-files-to-copy :test #'equal)))
(when (not shadow-inhibit-message)
(message "%s" (substitute-command-keys
"Use \\[shadow-copy-files] to update shadows."))
@@ -735,7 +730,7 @@ With non-nil argument also saves the buffer."
(sit-for 1))))))
(defun shadow-invalidate-hashtable ()
- (setq shadow-hashtable (make-vector 37 0)))
+ (clrhash shadow-hashtable))
(defun shadow-insert-var (variable)
"Build a `setq' to restore VARIABLE.
@@ -744,17 +739,17 @@ will restore VARIABLE to its current setting.
VARIABLE must be the name of a variable whose value is a list."
(let ((standard-output (current-buffer)))
(insert (format "(setq %s" variable))
- (cond ((consp (eval variable))
+ (cond ((consp (symbol-value variable))
(insert "\n '(")
- (prin1 (car (eval variable)))
- (let ((rest (cdr (eval variable))))
+ (prin1 (car (symbol-value variable)))
+ (let ((rest (cdr (symbol-value variable))))
(while rest
(insert "\n ")
(prin1 (car rest))
(setq rest (cdr rest)))
(insert "))\n\n")))
(t (insert " ")
- (prin1 (eval variable))
+ (prin1 (symbol-value variable))
(insert ")\n\n")))))
(defun shadow-save-buffers-kill-emacs (&optional arg)
@@ -763,6 +758,11 @@ With prefix arg, silently save all file-visiting buffers,
then kill.
Extended by shadowfile to automatically save `shadow-todo-file' and
look for files that have been changed and need to be copied to other systems."
+ (interactive "P")
+ (shadow--save-buffers-kill-emacs arg)
+ (save-buffers-kill-emacs arg))
+
+(defun shadow--save-buffers-kill-emacs (&optional arg &rest _)
;; This function is necessary because we need to get control and save
;; the todo file /after/ saving other files, but /before/ the warning
;; 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."
;; because it is not called at the correct time, and also because it is
;; called when the terminal is disconnected and we cannot ask whether
;; to copy files.
- (interactive "P")
(shadow-save-todo-file)
(save-some-buffers arg t)
(shadow-copy-files)
- (shadow-save-todo-file)
- (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf)))
- (buffer-list))))
- (yes-or-no-p "Modified buffers exist; exit anyway? "))
- (or (not (fboundp 'process-list))
- ;; `process-list' is not defined on MSDOS.
- (let ((processes (process-list))
- active)
- (while processes
- (and (memq (process-status (car processes)) '(run stop open
listen))
- (process-query-on-exit-flag (car processes))
- (setq active t))
- (setq processes (cdr processes)))
- (or (not active)
- (yes-or-no-p "Active processes exist; kill them and exit
anyway? "))))
- (kill-emacs)))
+ (shadow-save-todo-file))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook us up
@@ -809,19 +792,15 @@ look for files that have been changed and need to be
copied to other systems."
(message "Shadowfile information files not found - aborting")
(beep)
(sit-for 3))
- (when (and (not shadow-inhibit-overload)
- (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
- (defalias 'shadow-orig-save-buffers-kill-emacs
- (symbol-function 'save-buffers-kill-emacs))
- (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs))
- (add-hook 'write-file-functions 'shadow-add-to-todo)
- (define-key ctl-x-4-map "s" 'shadow-copy-files)))
+ (unless shadow-inhibit-overload
+ (advice-add 'save-buffers-kill-emacs :before
+ #'shadow--save-buffers-kill-emacs))
+ (add-hook 'write-file-functions #'shadow-add-to-todo)
+ (define-key ctl-x-4-map "s" #'shadow-copy-files)))
(defun shadowfile-unload-function ()
- (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map)
- (when (fboundp 'shadow-orig-save-buffers-kill-emacs)
- (fset 'save-buffers-kill-emacs
- (symbol-function 'shadow-orig-save-buffers-kill-emacs)))
+ (substitute-key-definition #'shadow-copy-files nil ctl-x-4-map)
+ (advice-remove 'save-buffers-kill-emacs #'shadow--save-buffers-kill-emacs)
;; continue standard unloading
nil)
@@ -832,7 +811,7 @@ look for files that have been changed and need to be copied
to other systems."
(defun shadow-union (a b)
"Add members of list A to list B if not equal to items already in B."
(declare (obsolete cl-union "28.1"))
- (cl-union a b :test #'equal))
+ (nreverse (cl-union a b :test #'equal)))
(define-obsolete-function-alias 'shadow-find #'seq-find "28.1")
diff --git a/lisp/shell.el b/lisp/shell.el
index cd99b00..3098d3a 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -980,7 +980,7 @@ Environment variables are expanded, see function
`substitute-in-file-name'."
The `dirtrack' package provides an alternative implementation of
this feature; see the function `dirtrack-mode'."
- nil nil nil
+ :lighter nil
(setq list-buffers-directory (if shell-dirtrack-mode default-directory))
(if shell-dirtrack-mode
(add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t)
diff --git a/lisp/simple.el b/lisp/simple.el
index 207b434..6a964cd0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2798,7 +2798,6 @@ or to the last history element for a backward search."
(if isearch-forward
(goto-history-element (length (minibuffer-history-value)))
(goto-history-element 0))
- (setq isearch-success t)
(goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
(defun minibuffer-history-isearch-push-state ()
diff --git a/lisp/so-long.el b/lisp/so-long.el
index f44d41d..f916b61 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
with `so-long-variable-overrides'.
This minor mode is a standard `so-long-action' option."
- nil nil nil
+ :lighter nil
(if so-long-minor-mode ;; We are enabling the mode.
(progn
;; Housekeeping. `so-long-minor-mode' might be invoked directly rather
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 12e57b1..118c726 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -4055,7 +4055,6 @@ this version is not backward compatible to 0.14 or
earlier.")
(provide 'speedbar)
-;; run load-time hooks
(run-hooks 'speedbar-load-hook)
;;; speedbar ends here
diff --git a/lisp/startup.el b/lisp/startup.el
index 628e985..bfbee6a 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1097,7 +1097,7 @@ please check its value")
("--no-x-resources") ("--debug-init")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")
- ("--dump-file") ("--temacs")))
+ ("--dump-file") ("--temacs") ("--seccomp")))
(argi (pop args))
(orig-argi argi)
argval)
@@ -1149,7 +1149,8 @@ please check its value")
(push '(visibility . icon) initial-frame-alist))
((member argi '("-nbc" "-no-blinking-cursor"))
(setq no-blinking-cursor t))
- ((member argi '("-dump-file" "-temacs")) ; Handled in C
+ ((member argi '("-dump-file" "-temacs" "-seccomp"))
+ ;; Handled in C
(or argval (pop args))
(setq argval nil))
;; Push the popped arg back on the list of arguments.
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 4b682e9..575092a 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1393,7 +1393,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
\\[strokes-decode-buffer].
\\{strokes-mode-map}"
- nil strokes-lighter strokes-mode-map :global t
+ :lighter strokes-lighter :global t
(cond ((not (display-mouse-p))
(error "Can't use Strokes without a mouse"))
(strokes-mode ; turn on strokes
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 2e27b29..f3c2fb7 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,
(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab)
(define-key tab-prefix-map "t" 'other-tab-prefix)
+(defvar tab-bar-switch-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "o" 'tab-next)
+ (define-key map "O" 'tab-previous)
+ map)
+ "Keymap to repeat tab switch key sequences `C-x t o o O'.
+Used in `repeat-mode'.")
+(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
+(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
+
+(defvar tab-bar-move-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "m" 'tab-move)
+ (define-key map "M" (lambda ()
+ (interactive)
+ (setq repeat-map 'tab-bar-move-repeat-map)
+ (tab-move -1)))
+ map)
+ "Keymap to repeat tab move key sequences `C-x t m m M'.
+Used in `repeat-mode'.")
+(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
+
(provide 'tab-bar)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index fa9b475..3f0cca0 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -474,6 +474,7 @@ checksum before doing the check."
"Construct a `rw-r--r--' string indicating MODE.
MODE should be an integer which is a file mode value.
For instance, if mode is #o700, then it produces `rwx------'."
+ (declare (obsolete file-modes-number-to-symbolic "28.1"))
(substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
@@ -489,25 +490,26 @@ For instance, if mode is #o700, then it produces
`rwx------'."
;; (ck (tar-header-checksum tar-hblock))
(type (tar-header-link-type tar-hblock))
(link-name (tar-header-link-name tar-hblock)))
- (format "%c%c%s %7s/%-7s %7s%s %s%s"
+ (format "%c%s %7s/%-7s %7s%s %s%s"
(if mod-p ?* ? )
- (cond ((or (eq type nil) (eq type 0)) ?-)
- ((eq type 1) ?h) ; link
- ((eq type 2) ?l) ; symlink
- ((eq type 3) ?c) ; char special
- ((eq type 4) ?b) ; block special
- ((eq type 5) ?d) ; directory
- ((eq type 6) ?p) ; FIFO/pipe
- ((eq type 20) ?*) ; directory listing
- ((eq type 28) ?L) ; next has longname
- ((eq type 29) ?M) ; multivolume continuation
- ((eq type 35) ?S) ; sparse
- ((eq type 38) ?V) ; volume header
- ((eq type 55) ?H) ; pax global extended header
- ((eq type 72) ?X) ; pax extended header
- (t ?\s)
- )
- (tar-grind-file-mode mode)
+ (file-modes-number-to-symbolic
+ mode
+ (cond ((or (eq type nil) (eq type 0)) ?-)
+ ((eq type 1) ?h) ; link
+ ((eq type 2) ?l) ; symlink
+ ((eq type 3) ?c) ; char special
+ ((eq type 4) ?b) ; block special
+ ((eq type 5) ?d) ; directory
+ ((eq type 6) ?p) ; FIFO/pipe
+ ((eq type 20) ?*) ; directory listing
+ ((eq type 28) ?L) ; next has longname
+ ((eq type 29) ?M) ; multivolume continuation
+ ((eq type 35) ?S) ; sparse
+ ((eq type 38) ?V) ; volume header
+ ((eq type 55) ?H) ; pax global extended header
+ ((eq type 72) ?X) ; pax extended header
+ (t ?\s)
+ ))
(if (= 0 (length uname)) uid uname)
(if (= 0 (length gname)) gid gname)
size
@@ -751,7 +753,7 @@ into the tar-file buffer that it came from. The changes
will
actually appear on disk when you save the tar-file's buffer."
;; Don't do this, because it is redundant and wastes mode line space.
;; :lighter " TarFile"
- nil nil nil
+ :lighter nil
(or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
(error "This buffer is not an element of a tar file"))
(cond (tar-subfile-mode
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index fbb9d21..d9a83c5 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -33,7 +33,7 @@
;; What is artist?
;; ---------------
;;
-;; Artist is an Emacs lisp package that allows you to draw lines,
+;; Artist is an Emacs Lisp package that allows you to draw lines,
;; rectangles and ellipses by using your mouse and/or keyboard. The
;; shapes are made up with the ascii characters |, -, / and \.
;;
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index 6d01871..27b2e0e 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -24,7 +24,6 @@
;; Done: font-lock, imenu, outline, commenting, indentation.
;; Todo: tab-completion.
-;; Bugs:
;;; Code:
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index f01c66b..31186fb 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -5608,8 +5608,5 @@ If APPEND is non-nil, append ENTRIES to those already
displayed."
(setq buffer-read-only t)
(goto-char (point-min)))
-
-;; Make BibTeX a Feature
-
(provide 'bibtex)
;;; bibtex.el ends here
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index eb52113..932308e 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -3744,7 +3744,7 @@ SPC.
For spell-checking \"on the fly\", not just after typing SPC or
RET, use `flyspell-mode'."
- nil " Spell" ispell-minor-keymap)
+ :lighter " Spell" :keymap ispell-minor-keymap)
(defun ispell-minor-check ()
"Check previous word, then continue with the normal binding of this key.
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index 8152f4b..653540a 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -284,7 +284,6 @@ line LINE of the window, or centered if LINE is nil."
(pop-to-buffer old-buffer)
)))
-;;; Place `provide' at end of file.
(provide 'makeinfo)
;;; makeinfo.el ends here
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index e1d7fb7..b86a2f1 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -170,8 +170,6 @@ point, respectively."
(interactive)
(apply #'message (cons "Page %d, line %d" (page--what-page))))
-
-;;; Place `provide' at end of file.
(provide 'page)
;;; page.el ends here
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 31e91c7..59b15e8 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -202,8 +202,6 @@ This is desirable in modes where blank lines are the
paragraph delimiters."
(put 'paragraph-ignore-fill-prefix 'safe-local-variable #'booleanp)
;; Silence the compiler.
-(defvar multiple-lines)
-
(defun forward-paragraph (&optional arg)
"Move forward to end of paragraph.
With argument ARG, do it ARG times;
@@ -262,13 +260,13 @@ Returns the count of paragraphs left to move."
;; Search back for line that starts or separates paragraphs.
(if (if fill-prefix-regexp
;; There is a fill prefix; it overrides parstart.
- (let (multiple-lines)
+ (let () ;; multiple-lines
(while (and (progn (beginning-of-line) (not (bobp)))
(progn (move-to-left-margin)
(not (looking-at parsep)))
(looking-at fill-prefix-regexp))
- (unless (= (point) start)
- (setq multiple-lines t))
+ ;; (unless (= (point) start)
+ ;; (setq multiple-lines t))
(forward-line -1))
(move-to-left-margin)
;; This deleted code caused a long hanging-indent line
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 53519ac..e710180 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'."
(forward-paragraph 1)
(setq end (point))
(setq found
- (refer-every (lambda (keyword)
- (goto-char begin)
- (re-search-forward keyword end t))
- keywords-list))
+ (seq-every-p (lambda (keyword)
+ (goto-char begin)
+ (re-search-forward keyword end t))
+ keywords-list))
(if (not found)
(progn
(setq begin end)
@@ -260,12 +260,6 @@ found on the last `refer-find-entry' or
`refer-find-next-entry'."
(progn (message "Scanning %s... not found" file)
nil))))
-(defun refer-every (pred l)
- (cond ((null l) nil)
- ((funcall pred (car l))
- (or (null (cdr l))
- (refer-every pred (cdr l))))))
-
(defun refer-convert-string-to-list-of-strings (s)
(let ((current (current-buffer))
(temp-buffer (get-buffer-create "*refer-temp*")))
@@ -391,4 +385,6 @@ found on the last `refer-find-entry' or
`refer-find-next-entry'."
(setq refer-bib-files files))
files))
+(define-obsolete-function-alias 'refer-every #'seq-every-p "28.1")
+
;;; refer.el ends here
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index cd76bf8..8a0436a 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
save the notes buffer without asking.
\\{remember-notes-mode-map}"
- nil nil nil
+ :lighter nil
(cond
(remember-notes-mode
(add-hook 'kill-buffer-query-functions
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 56cca84..1471be0 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1408,13 +1408,11 @@ highlighting.
When ReST minor mode is enabled, the ReST mode keybindings
are installed on top of the major mode bindings. Use this
for modes derived from Text mode, like Mail mode."
- ;; The initial value.
- nil
- ;; The indicator for the mode line.
- " ReST"
- ;; The minor mode bindings.
- rst-mode-map
- :group 'rst)
+ ;; The indicator for the mode line.
+ :lighter " ReST"
+ ;; The minor mode bindings.
+ :keymap rst-mode-map
+ :group 'rst)
;; FIXME: can I somehow install these too?
;; :abbrev-table rst-mode-abbrev-table
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 6958ab8..67f7319 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.")
HTML Autoview mode is a buffer-local minor mode for use with
`html-mode'. If enabled, saving the file automatically runs
`browse-url-of-buffer' to view it."
- nil nil nil
+ :lighter nil
(if html-autoview-mode
(add-hook 'after-save-hook #'browse-url-of-buffer nil t)
(remove-hook 'after-save-hook #'browse-url-of-buffer t)))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 13b4a6d..2dd52b8 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -383,7 +383,7 @@
;; There is no artificial-intelligence magic in this package. The
;; definition of a table and the cells inside the table is reasonably
;; limited in order to achieve acceptable performance in the
-;; interactive operation under Emacs lisp implementation. A valid
+;; interactive operation under Emacs Lisp implementation. A valid
;; table is a rectangular text area completely filled with valid
;; cells. A valid cell is a rectangle text area, which four borders
;; consist of valid border characters. Cells can not be nested one to
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index fb57b9b..8d7f459 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -28,7 +28,6 @@
;;; Code:
-;; Pacify the byte-compiler
(eval-when-compile
(require 'compare-w)
(require 'cl-lib)
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index a797df9..977f3ba 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -23,9 +23,9 @@
;;; Commentary:
-;;; Code:
+;;; Emacs Lisp functions to convert Texinfo files to Info files.
-;;; Emacs lisp functions to convert Texinfo files to Info files.
+;;; Code:
(defvar texinfmt-version "2.42 of 7 Jul 2006")
(make-obsolete-variable 'texinfmt-version 'emacs-version "28.1")
@@ -4310,8 +4310,6 @@ For example, invoke
(setq error 1))))
(kill-emacs error))))
-
-;;; Place `provide' at end of file.
(provide 'texinfmt)
;;; texinfmt.el ends here
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index 27807a9..0300454 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -2112,8 +2112,6 @@ chapter."
(message "Multiple files updated."))
-
-;; Place `provide' at end of file.
(provide 'texnfo-upd)
;;; texnfo-upd.el ends here
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 069c8e3..01e2ad7 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
When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard
space
representation for current major mode, the `tildify-space-string' buffer-local
variable will be set to the representation."
- nil " ~" nil
+ :lighter " ~"
(when tildify-mode
(let ((space (with-suppressed-warnings ((obsolete
tildify--pick-alist-entry))
@@ -503,8 +503,6 @@ variable will be set to the representation."
(remove-hook 'post-self-insert-hook #'tildify-space t)))
-;;; *** Announce ***
-
(provide 'tildify)
;;; tildify.el ends here
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index 6c3bacc..5a3a64a 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -319,16 +319,17 @@ first and the associated buffer to its right."
;;;###autoload
-(defun 2C-associate-buffer ()
- "Associate another buffer with this one in two-column minor mode.
+(defun 2C-associate-buffer (buffer)
+ "Associate another BUFFER with this one in two-column minor mode.
Can also be used to associate a just previously visited file, by
accepting the proposed default buffer.
\(See \\[describe-mode] .)"
- (interactive)
+ (interactive
+ (list (or (2C-other)
+ (read-buffer "Associate buffer: " (other-buffer)))))
(let ((b1 (current-buffer))
- (b2 (or (2C-other)
- (read-buffer "Associate buffer: " (other-buffer)))))
+ (b2 buffer))
(setq 2C-mode nil)
(with-current-buffer b2
(and (2C-other)
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 1d513d6..7cc0168 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -498,8 +498,6 @@ For use on `kill-buffer-hook'."
(file-name-directory filename) retval)))
retval))
-;;; The End
-
(defun uniquify-unload-function ()
"Unload the uniquify library."
(save-current-buffer
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 56b3166..eabbaba 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -191,7 +191,8 @@ when this variable is set to nil.")
(defconst log-edit-files-buf "*log-edit-files*")
(defvar log-edit-initial-files nil)
(defvar log-edit-callback nil)
-(defvar log-edit-diff-function nil)
+(defvar log-edit-diff-function
+ (lambda () (error "Diff functionality has not been setup")))
(defvar log-edit-listfun nil)
(defvar log-edit-parent-buffer nil)
@@ -659,9 +660,7 @@ Also saves its contents in the comment history and hides
(defun log-edit-show-diff ()
"Show the diff for the files to be committed."
(interactive)
- (if (functionp log-edit-diff-function)
- (funcall log-edit-diff-function)
- (error "Diff functionality has not been setup")))
+ (funcall log-edit-diff-function))
(defun log-edit-show-files ()
"Show the list of files to be committed."
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 6e039cc..42f531e 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -331,7 +331,7 @@ the primary since reading the primary can deactivate it."
"This mode is used for buffers related to a main *cvs* buffer.
All the `cvs-mode' buffer operations are simply rebound under
the \\[cvs-mode-map] prefix."
- nil " CVS"
+ :lighter " CVS"
:group 'pcl-cvs)
(put 'cvs-minor-mode 'permanent-local t)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index a054a7c..c9c1e91 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -26,10 +26,6 @@
;; This is a mercurial version control backend
-;;; Thanks:
-
-;;; Bugs:
-
;;; Todo:
;; 1) Implement the rest of the vc interface. See the comment at the
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index 0bd5132..bac0069 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -83,26 +83,24 @@
(defun vt-keypad-on (&optional tell)
"Turn on the VT applications keypad."
- (interactive)
+ (interactive "p")
(send-string-to-terminal "\e=")
(setq vt-applications-keypad-p t)
- (if (or tell (called-interactively-p 'interactive))
- (message "Applications keypad enabled.")))
+ (if tell (message "Applications keypad enabled.")))
(defun vt-keypad-off (&optional tell)
"Turn off the VT applications keypad."
(interactive "p")
(send-string-to-terminal "\e>")
(setq vt-applications-keypad-p nil)
- (if (or tell (called-interactively-p 'interactive))
- (message "Applications keypad disabled.")))
+ (if tell (message "Applications keypad disabled.")))
-(defun vt-numlock nil
+(defun vt-numlock (&optional tell)
"Toggle VT application keypad on and off."
- (interactive)
+ (interactive "p")
(if vt-applications-keypad-p
- (vt-keypad-off (called-interactively-p 'interactive))
- (vt-keypad-on (called-interactively-p 'interactive))))
+ (vt-keypad-off tell)
+ (vt-keypad-on tell)))
(provide 'vt-control)
diff --git a/lisp/widget.el b/lisp/widget.el
index 401b4cf..d258e6f 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -94,8 +94,6 @@ The third argument DOC is a documentation string for the
widget."
;; This is used by external widget code (in W3, at least).
(define-obsolete-function-alias 'widget-plist-member #'plist-member "26.1")
-;;; The End.
-
(provide 'widget)
;;; widget.el ends here
diff --git a/lisp/window.el b/lisp/window.el
index f27631b..071761e 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -10256,6 +10256,10 @@ displaying that processes's buffer."
(defvar other-window-repeat-map
(let ((map (make-sparse-keymap)))
(define-key map "o" 'other-window)
+ (define-key map "O" (lambda ()
+ (interactive)
+ (setq repeat-map 'other-window-repeat-map)
+ (other-window -1)))
map)
"Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
(put 'other-window 'repeat-map 'other-window-repeat-map)
diff --git a/lisp/winner.el b/lisp/winner.el
index 9506ac5..f30fa6c 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,4 +1,4 @@
-;;; winner.el --- Restore old window configurations
+;;; winner.el --- Restore old window configurations -*- lexical-binding: t -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
@@ -33,14 +33,13 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'ring)
(defun winner-active-region ()
(declare (gv-setter (lambda (store)
`(if ,store (activate-mark) (deactivate-mark)))))
(region-active-p))
-(require 'ring)
-
(defgroup winner nil
"Restoring window configurations."
:group 'windows)
@@ -273,7 +272,7 @@ You may want to include buffer names such as *Help*,
*Apropos*,
(let* ((buffers nil)
(alive
;; Possibly update `winner-point-alist'
- (cl-loop for buf in (mapcar 'cdr (cdr conf))
+ (cl-loop for buf in (mapcar #'cdr (cdr conf))
for pos = (winner-get-point buf nil)
if (and pos (not (memq buf buffers)))
do (push buf buffers)
@@ -317,7 +316,7 @@ You may want to include buffer names such as *Help*,
*Apropos*,
;; Return t if this is still a possible configuration.
(or (null xwins)
(progn
- (mapc 'delete-window (cdr xwins)) ; delete all but one
+ (mapc #'delete-window (cdr xwins)) ; delete all but one
(unless (one-window-p t)
(delete-window (car xwins))
t))))))
@@ -328,22 +327,20 @@ You may want to include buffer names such as *Help*,
*Apropos*,
(defcustom winner-mode-hook nil
"Functions to run whenever Winner mode is turned on or off."
- :type 'hook
- :group 'winner)
+ :type 'hook)
(define-obsolete-variable-alias 'winner-mode-leave-hook
'winner-mode-off-hook "24.3")
(defcustom winner-mode-off-hook nil
"Functions to run whenever Winner mode is turned off."
- :type 'hook
- :group 'winner)
+ :type 'hook)
(defvar winner-mode-map
(let ((map (make-sparse-keymap)))
(unless winner-dont-bind-my-keys
- (define-key map [(control c) left] 'winner-undo)
- (define-key map [(control c) right] 'winner-redo))
+ (define-key map [(control c) left] #'winner-undo)
+ (define-key map [(control c) right] #'winner-redo))
map)
"Keymap for Winner mode.")
diff --git a/src/alloc.c b/src/alloc.c
index ab1e96e..efcf0a5 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6251,7 +6251,7 @@ For further details, see Info node `(elisp)Garbage
Collection'. */)
}
DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe,
-Sgarbage_collect_maybe, 1, 1, "",
+Sgarbage_collect_maybe, 1, 1, 0,
doc: /* Call `garbage-collect' if enough allocation happened.
FACTOR determines what "enough" means here:
If FACTOR is a positive number N, it means to run GC if more than
diff --git a/src/character.c b/src/character.c
index a599a03..41abb83 100644
--- a/src/character.c
+++ b/src/character.c
@@ -321,28 +321,32 @@ strwidth (const char *str, ptrdiff_t len)
return c_string_width ((const unsigned char *) str, len, -1, NULL, NULL);
}
-/* Return width of Lisp string STRING when displayed in the current
- buffer. The width is measured by how many columns it occupies on
- the screen while paying attention to compositions. If PRECISION >
- 0, return the width of longest substring that doesn't exceed
- PRECISION, and set number of characters and bytes of the substring
- in *NCHARS and *NBYTES respectively. */
+/* Return width of a (substring of a) Lisp string STRING when
+ displayed in the current buffer. The width is measured by how many
+ columns it occupies on the screen while paying attention to
+ compositions. If PRECISION > 0, return the width of longest
+ substring that doesn't exceed PRECISION, and set number of
+ characters and bytes of the substring in *NCHARS and *NBYTES
+ respectively. FROM and TO are zero-based character indices
+ that define the substring of STRING to consider. */
ptrdiff_t
-lisp_string_width (Lisp_Object string, ptrdiff_t precision,
- ptrdiff_t *nchars, ptrdiff_t *nbytes)
+lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to,
+ ptrdiff_t precision, ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
- ptrdiff_t len = SCHARS (string);
/* This set multibyte to 0 even if STRING is multibyte when it
contains only ascii and eight-bit-graphic, but that's
intentional. */
- bool multibyte = len < SBYTES (string);
+ bool multibyte = SCHARS (string) < SBYTES (string);
unsigned char *str = SDATA (string);
- ptrdiff_t i = 0, i_byte = 0;
+ ptrdiff_t i = from, i_byte = from ? string_char_to_byte (string, from) : 0;
+ ptrdiff_t from_byte = i_byte;
ptrdiff_t width = 0;
struct Lisp_Char_Table *dp = buffer_display_table ();
- while (i < len)
+ eassert (precision <= 0 || (nchars && nbytes));
+
+ while (i < to)
{
ptrdiff_t chars, bytes, thiswidth;
Lisp_Object val;
@@ -375,8 +379,8 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision,
if (0 < precision && precision - width < thiswidth)
{
- *nchars = i;
- *nbytes = i_byte;
+ *nchars = i - from;
+ *nbytes = i_byte - from_byte;
return width;
}
if (INT_ADD_WRAPV (thiswidth, width, &width))
@@ -387,27 +391,37 @@ lisp_string_width (Lisp_Object string, ptrdiff_t
precision,
if (precision > 0)
{
- *nchars = i;
- *nbytes = i_byte;
+ *nchars = i - from;
+ *nbytes = i_byte - from_byte;
}
return width;
}
-DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
+DEFUN ("string-width", Fstring_width, Sstring_width, 1, 3, 0,
doc: /* Return width of STRING when displayed in the current buffer.
Width is measured by how many columns it occupies on the screen.
+Optional arguments FROM and TO specify the substring of STRING to
+consider, and are interpreted as in `substring'.
+
When calculating width of a multibyte character in STRING,
only the base leading-code is considered; the validity of
the following bytes is not checked. Tabs in STRING are always
-taken to occupy `tab-width' columns.
-usage: (string-width STRING) */)
- (Lisp_Object str)
+taken to occupy `tab-width' columns. The effect of faces and fonts
+used for non-Latin and other unusual characters (such as emoji) is
+ignored as well, as are display properties and invisible text.
+For these reasons, the results are not generally reliable;
+for accurate dimensions of text as it will be displayed,
+use `window-text-pixel-size' instead.
+usage: (string-width STRING &optional FROM TO) */)
+ (Lisp_Object str, Lisp_Object from, Lisp_Object to)
{
Lisp_Object val;
+ ptrdiff_t ifrom, ito;
CHECK_STRING (str);
- XSETFASTINT (val, lisp_string_width (str, -1, NULL, NULL));
+ validate_subarray (str, from, to, SCHARS (str), &ifrom, &ito);
+ XSETFASTINT (val, lisp_string_width (str, ifrom, ito, -1, NULL, NULL));
return val;
}
diff --git a/src/character.h b/src/character.h
index cbf4309..d19e1e2 100644
--- a/src/character.h
+++ b/src/character.h
@@ -572,8 +572,8 @@ extern ptrdiff_t str_to_unibyte (const unsigned char *,
unsigned char *,
extern ptrdiff_t strwidth (const char *, ptrdiff_t);
extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int,
ptrdiff_t *, ptrdiff_t *);
-extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t,
- ptrdiff_t *, ptrdiff_t *);
+extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object Vchar_unify_table;
extern Lisp_Object string_escape_byte8 (Lisp_Object);
diff --git a/src/editfns.c b/src/editfns.c
index 87e743a..bc73c1e 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3386,12 +3386,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
else
{
ptrdiff_t nch, nby;
- width = lisp_string_width (arg, prec, &nch, &nby);
+ nchars_string = SCHARS (arg);
+ width = lisp_string_width (arg, 0, nchars_string, prec,
+ &nch, &nby);
if (prec < 0)
- {
- nchars_string = SCHARS (arg);
- nbytes = SBYTES (arg);
- }
+ nbytes = SBYTES (arg);
else
{
nchars_string = nch;
diff --git a/src/emacs.c b/src/emacs.c
index 5995410..9a83a08 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -61,6 +61,21 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# include <sys/socket.h>
#endif
+#if defined HAVE_LINUX_SECCOMP_H && defined HAVE_LINUX_FILTER_H \
+ && HAVE_DECL_SECCOMP_SET_MODE_FILTER \
+ && HAVE_DECL_SECCOMP_FILTER_FLAG_TSYNC
+# define SECCOMP_USABLE 1
+#else
+# define SECCOMP_USABLE 0
+#endif
+
+#if SECCOMP_USABLE
+# include <linux/seccomp.h>
+# include <linux/filter.h>
+# include <sys/prctl.h>
+# include <sys/syscall.h>
+#endif
+
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
@@ -241,6 +256,11 @@ Initialization options:\n\
--dump-file FILE read dumped state from FILE\n\
",
#endif
+#if SECCOMP_USABLE
+ "\
+--sandbox=FILE read Seccomp BPF filter from FILE\n\
+"
+#endif
"\
--no-build-details do not add build details such as time stamps\n\
--no-desktop do not load a saved desktop\n\
@@ -938,6 +958,181 @@ load_pdump (int argc, char **argv)
}
#endif /* HAVE_PDUMPER */
+#if SECCOMP_USABLE
+
+/* Wrapper function for the `seccomp' system call on GNU/Linux. This
+ system call usually doesn't have a wrapper function. See the
+ manual page of `seccomp' for the signature. */
+
+static int
+emacs_seccomp (unsigned int operation, unsigned int flags, void *args)
+{
+#ifdef SYS_seccomp
+ return syscall (SYS_seccomp, operation, flags, args);
+#else
+ errno = ENOSYS;
+ return -1;
+#endif
+}
+
+/* Read SIZE bytes into BUFFER. Return the number of bytes read, or
+ -1 if reading failed altogether. */
+
+static ptrdiff_t
+read_full (int fd, void *buffer, ptrdiff_t size)
+{
+ eassert (0 <= fd);
+ eassert (buffer != NULL);
+ eassert (0 <= size);
+ enum
+ {
+ /* See MAX_RW_COUNT in sysdep.c. */
+#ifdef MAX_RW_COUNT
+ max_size = MAX_RW_COUNT
+#else
+ max_size = INT_MAX >> 18 << 18
+#endif
+ };
+ if (PTRDIFF_MAX < size || max_size < size)
+ {
+ errno = EFBIG;
+ return -1;
+ }
+ char *ptr = buffer;
+ ptrdiff_t read = 0;
+ while (size != 0)
+ {
+ ptrdiff_t n = emacs_read (fd, ptr, size);
+ if (n < 0)
+ return -1;
+ if (n == 0)
+ break; /* Avoid infinite loop on encountering EOF. */
+ eassert (n <= size);
+ size -= n;
+ ptr += n;
+ read += n;
+ }
+ return read;
+}
+
+/* Attempt to load Secure Computing filters from FILE. Return false
+ if that doesn't work for some reason. */
+
+static bool
+load_seccomp (const char *file)
+{
+ bool success = false;
+ void *buffer = NULL;
+ int fd
+ = emacs_open_noquit (file, O_RDONLY | O_CLOEXEC | O_BINARY, 0);
+ if (fd < 0)
+ {
+ emacs_perror ("open");
+ goto out;
+ }
+ struct stat stat;
+ if (fstat (fd, &stat) != 0)
+ {
+ emacs_perror ("fstat");
+ goto out;
+ }
+ if (! S_ISREG (stat.st_mode))
+ {
+ fprintf (stderr, "seccomp file %s is not regular\n", file);
+ goto out;
+ }
+ struct sock_fprog program;
+ if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size
+ || PTRDIFF_MAX <= stat.st_size
+ || stat.st_size % sizeof *program.filter != 0)
+ {
+ fprintf (stderr, "seccomp filter %s has invalid size %ld\n",
+ file, (long) stat.st_size);
+ goto out;
+ }
+ size_t size = stat.st_size;
+ size_t count = size / sizeof *program.filter;
+ eassert (0 < count && count < SIZE_MAX);
+ if (USHRT_MAX < count)
+ {
+ fprintf (stderr, "seccomp filter %s is too big\n", file);
+ goto out;
+ }
+ /* Try reading one more byte to detect file size changes. */
+ buffer = malloc (size + 1);
+ if (buffer == NULL)
+ {
+ emacs_perror ("malloc");
+ goto out;
+ }
+ ptrdiff_t read = read_full (fd, buffer, size + 1);
+ if (read < 0)
+ {
+ emacs_perror ("read");
+ goto out;
+ }
+ eassert (read <= SIZE_MAX);
+ if (read != size)
+ {
+ fprintf (stderr,
+ "seccomp filter %s changed size while reading\n",
+ file);
+ goto out;
+ }
+ if (emacs_close (fd) != 0)
+ emacs_perror ("close"); /* not a fatal error */
+ fd = -1;
+ program.len = count;
+ program.filter = buffer;
+
+ /* See man page of `seccomp' why this is necessary. Note that we
+ intentionally don't check the return value: a parent process
+ might have made this call before, in which case it would fail;
+ or, if enabling privilege-restricting mode fails, the `seccomp'
+ syscall will fail anyway. */
+ prctl (PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0);
+ /* Install the filter. Make sure that potential other threads can't
+ escape it. */
+ if (emacs_seccomp (SECCOMP_SET_MODE_FILTER,
+ SECCOMP_FILTER_FLAG_TSYNC, &program)
+ != 0)
+ {
+ emacs_perror ("seccomp");
+ goto out;
+ }
+ success = true;
+
+ out:
+ if (0 <= fd)
+ emacs_close (fd);
+ free (buffer);
+ return success;
+}
+
+/* Load Secure Computing filter from file specified with the --seccomp
+ option. Exit if that fails. */
+
+static void
+maybe_load_seccomp (int argc, char **argv)
+{
+ int skip_args = 0;
+ char *file = NULL;
+ while (skip_args < argc - 1)
+ {
+ if (argmatch (argv, argc, "-seccomp", "--seccomp", 9, &file,
+ &skip_args)
+ || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
+ break;
+ ++skip_args;
+ }
+ if (file == NULL)
+ return;
+ if (! load_seccomp (file))
+ fatal ("cannot enable seccomp filter from %s", file);
+}
+
+#endif /* SECCOMP_USABLE */
+
int
main (int argc, char **argv)
{
@@ -945,6 +1140,13 @@ main (int argc, char **argv)
for pointers. */
void *stack_bottom_variable;
+ /* First, check whether we should apply a seccomp filter. This
+ should come at the very beginning to allow the filter to protect
+ the initialization phase. */
+#if SECCOMP_USABLE
+ maybe_load_seccomp (argc, argv);
+#endif
+
bool no_loadup = false;
char *junk = 0;
char *dname_arg = 0;
@@ -2148,12 +2350,15 @@ static const struct standard_args standard_args[] =
{ "-color", "--color", 5, 0},
{ "-no-splash", "--no-splash", 3, 0 },
{ "-no-desktop", "--no-desktop", 3, 0 },
- /* The following two must be just above the file-name args, to get
+ /* The following three must be just above the file-name args, to get
them out of our way, but without mixing them with file names. */
{ "-temacs", "--temacs", 1, 1 },
#ifdef HAVE_PDUMPER
{ "-dump-file", "--dump-file", 1, 1 },
#endif
+#if SECCOMP_USABLE
+ { "-seccomp", "--seccomp", 1, 1 },
+#endif
#ifdef HAVE_NS
{ "-NSAutoLaunch", 0, 5, 1 },
{ "-NXAutoLaunch", 0, 5, 1 },
diff --git a/src/eval.c b/src/eval.c
index ddaa8ed..fd93f5b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1301,7 +1301,7 @@ DEFUN ("condition-case", Fcondition_case,
Scondition_case, 2, UNEVALLED, 0,
doc: /* Regain control when an error is signaled.
Executes BODYFORM and returns its value if no error happens.
Each element of HANDLERS looks like (CONDITION-NAME BODY...)
-where the BODY is made of Lisp expressions.
+or (:success BODY...), where the BODY is made of Lisp expressions.
A handler is applicable to an error if CONDITION-NAME is one of the
error's condition names. Handlers may also apply when non-error
@@ -1323,6 +1323,10 @@ with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the
error.
Then the value of the last BODY form is returned from the `condition-case'
expression.
+The special handler (:success BODY...) is invoked if BODYFORM terminated
+without signalling an error. BODY is then evaluated with VAR bound to
+the value returned by BODYFORM.
+
See also the function `signal' for more info.
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
@@ -1346,16 +1350,21 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
CHECK_SYMBOL (var);
+ Lisp_Object success_handler = Qnil;
+
for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object tem = XCAR (tail);
- clausenb++;
if (! (NILP (tem)
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
error ("Invalid condition handler: %s",
SDATA (Fprin1_to_string (tem, Qt)));
+ if (EQ (XCAR (tem), QCsuccess))
+ success_handler = XCDR (tem);
+ else
+ clausenb++;
}
/* The first clause is the one that should be checked first, so it
@@ -1369,7 +1378,8 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
clauses += clausenb;
for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
- *--clauses = XCAR (tail);
+ if (!EQ (XCAR (XCAR (tail)), QCsuccess))
+ *--clauses = XCAR (tail);
for (ptrdiff_t i = 0; i < clausenb; i++)
{
Lisp_Object clause = clauses[i];
@@ -1409,6 +1419,23 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
Lisp_Object result = eval_sub (bodyform);
handlerlist = oldhandlerlist;
+ if (!NILP (success_handler))
+ {
+ if (NILP (var))
+ return Fprogn (success_handler);
+
+ Lisp_Object handler_var = var;
+ if (!NILP (Vinternal_interpreter_environment))
+ {
+ result = Fcons (Fcons (var, result),
+ Vinternal_interpreter_environment);
+ handler_var = Qinternal_interpreter_environment;
+ }
+
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (handler_var, result);
+ return unbind_to (count, Fprogn (success_handler));
+ }
return result;
}
@@ -4381,6 +4408,7 @@ alist of active lexical bindings. */);
defsubr (&Sthrow);
defsubr (&Sunwind_protect);
defsubr (&Scondition_case);
+ DEFSYM (QCsuccess, ":success");
defsubr (&Ssignal);
defsubr (&Scommandp);
defsubr (&Sautoload);
diff --git a/src/frame.c b/src/frame.c
index 17e1b3f..a20c536 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3750,6 +3750,7 @@ window state change flag is reset. */)
DEFUN ("frame-scale-factor", Fframe_scale_factor, Sframe_scale_factor,
0, 1, 0,
doc: /* Return FRAMEs scale factor.
+If FRAME is omitted or nil, the selected frame is used.
The scale factor is the amount by which a logical pixel size must be
multiplied to find the real number of pixels. */)
(Lisp_Object frame)
diff --git a/src/image.c b/src/image.c
index 107670d..9608406 100644
--- a/src/image.c
+++ b/src/image.c
@@ -2109,46 +2109,68 @@ scale_image_size (int size, size_t divisor, size_t
multiplier)
return INT_MAX;
}
+/* Return a size, in pixels, from the value specified by SYMBOL, which
+ may be an integer or a pair of the form (VALUE . 'em) where VALUE
+ is a float that is multiplied by the font size to get the final
+ dimension.
+
+ If the value doesn't exist in the image spec, or is invalid, return
+ -1.
+*/
+static int
+image_get_dimension (struct image *img, Lisp_Object symbol)
+{
+ Lisp_Object value = image_spec_value (img->spec, symbol, NULL);
+
+ if (FIXNATP (value))
+ return min (XFIXNAT (value), INT_MAX);
+ if (CONSP (value) && NUMBERP (CAR (value)) && EQ (Qem, CDR (value)))
+ return min (img->face_font_size * XFLOATINT (CAR (value)), INT_MAX);
+
+ return -1;
+}
+
/* Compute the desired size of an image with native size WIDTH x HEIGHT.
Use SPEC to deduce the size. Store the desired size into
*D_WIDTH x *D_HEIGHT. Store -1 x -1 if the native size is OK. */
static void
compute_image_size (size_t width, size_t height,
- Lisp_Object spec,
+ struct image *img,
int *d_width, int *d_height)
{
Lisp_Object value;
+ int int_value;
int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1;
double scale = 1;
- value = image_spec_value (spec, QCscale, NULL);
+ value = image_spec_value (img->spec, QCscale, NULL);
if (NUMBERP (value))
scale = XFLOATINT (value);
- value = image_spec_value (spec, QCmax_width, NULL);
- if (FIXNATP (value))
- max_width = min (XFIXNAT (value), INT_MAX);
+ int_value = image_get_dimension (img, QCmax_width);
+ if (int_value >= 0)
+ max_width = int_value;
- value = image_spec_value (spec, QCmax_height, NULL);
- if (FIXNATP (value))
- max_height = min (XFIXNAT (value), INT_MAX);
+ int_value = image_get_dimension (img, QCmax_height);
+ if (int_value >= 0)
+ max_height = int_value;
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
- value = image_spec_value (spec, QCwidth, NULL);
- if (FIXNATP (value))
+ int_value = image_get_dimension (img, QCwidth);
+ if (int_value >= 0)
{
- desired_width = min (XFIXNAT (value) * scale, INT_MAX);
+ desired_width = int_value * scale;
/* :width overrides :max-width. */
max_width = -1;
}
- value = image_spec_value (spec, QCheight, NULL);
- if (FIXNATP (value))
+ int_value = image_get_dimension (img, QCheight);
+ if (int_value >= 0)
{
- desired_height = min (XFIXNAT (value) * scale, INT_MAX);
+ desired_height = int_value * scale;
/* :height overrides :max-height. */
max_height = -1;
}
@@ -2339,7 +2361,7 @@ image_set_transform (struct frame *f, struct image *img)
}
else
#endif
- compute_image_size (img->width, img->height, img->spec, &width, &height);
+ compute_image_size (img->width, img->height, img, &width, &height);
/* Determine rotation. */
double rotation = 0.0;
@@ -9345,7 +9367,7 @@ imagemagick_load_image (struct frame *f, struct image
*img,
#ifndef DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE
compute_image_size (MagickGetImageWidth (image_wand),
MagickGetImageHeight (image_wand),
- img->spec, &desired_width, &desired_height);
+ img, &desired_width, &desired_height);
#else
desired_width = desired_height = -1;
#endif
@@ -10208,7 +10230,7 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
viewbox_height = dimension_data.height;
}
- compute_image_size (viewbox_width, viewbox_height, img->spec,
+ compute_image_size (viewbox_width, viewbox_height, img,
&width, &height);
width *= FRAME_SCALE_FACTOR (f);
@@ -10917,6 +10939,8 @@ non-numeric, there is no explicit limit on the size of
images. */);
DEFSYM (QCmax_width, ":max-width");
DEFSYM (QCmax_height, ":max-height");
+ DEFSYM (Qem, "em");
+
#ifdef HAVE_NATIVE_TRANSFORMS
DEFSYM (Qscale, "scale");
DEFSYM (Qrotate, "rotate");
diff --git a/src/minibuf.c b/src/minibuf.c
index c9831fd..a3c1b99 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -112,13 +112,15 @@ choose_minibuf_frame (void)
{
if (FRAMEP (selected_frame)
&& FRAME_LIVE_P (XFRAME (selected_frame))
+ && WINDOW_LIVE_P (XFRAME (selected_frame)->minibuffer_window)
&& !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
{
struct frame *sf = XFRAME (selected_frame);
- /* I don't think that any frames may validly have a null minibuffer
- window anymore. */
- if (NILP (sf->minibuffer_window))
- emacs_abort ();
+ /* I don't think that any frames may validly have a null
+ minibuffer window anymore. (2021-04-15): Tooltip frames have
+ a null MB. Comment out the following. */
+ /* if (NILP (sf->minibuffer_window)) */
+ /* emacs_abort (); */
minibuf_window = sf->minibuffer_window;
}
@@ -195,7 +197,9 @@ move_minibuffers_onto_frame (struct frame *of, bool
for_deletion)
&& (for_deletion || minibuf_follows_frame () || FRAME_INITIAL_P (of))))
return;
if (FRAME_LIVE_P (f)
- && !EQ (f->minibuffer_window, of->minibuffer_window))
+ && !EQ (f->minibuffer_window, of->minibuffer_window)
+ && WINDOW_LIVE_P (f->minibuffer_window) /* F not a tootip frame */
+ && WINDOW_LIVE_P (of->minibuffer_window))
{
zip_minibuffer_stacks (f->minibuffer_window, of->minibuffer_window);
if (for_deletion && XFRAME (MB_frame) != of)
@@ -636,6 +640,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (minibuf_level > 1
+ && WINDOW_LIVE_P (XFRAME (MB_frame)->minibuffer_window)
&& !EQ (XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame,
MB_frame)
&& minibuf_moves_frame_when_opened ()
@@ -908,11 +913,13 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
unbind_to (count, Qnil);
/* Switch the frame back to the calling frame. */
- if ((!EQ (selected_frame, calling_frame)
- || !EQ (XWINDOW (XFRAME (calling_frame)->minibuffer_window)->frame,
- calling_frame))
- && FRAMEP (calling_frame)
- && FRAME_LIVE_P (XFRAME (calling_frame)))
+ if (FRAMEP (calling_frame)
+ && FRAME_LIVE_P (XFRAME (calling_frame))
+ && (!EQ (selected_frame, calling_frame)
+ || (WINDOW_LIVE_P (XFRAME (calling_frame)->minibuffer_window)
+ && !EQ (XWINDOW (XFRAME (calling_frame)->minibuffer_window)
+ ->frame,
+ calling_frame))))
call2 (intern ("select-frame-set-input-focus"), calling_frame, Qnil);
/* Add the value to the appropriate history list, if any. This is
@@ -1056,10 +1063,13 @@ read_minibuf_unwind (void)
{
f = XFRAME (exp_MB_frame);
window = f->minibuffer_window;
- w = XWINDOW (window);
- if (EQ (w->frame, exp_MB_frame)
- && EQ (w->contents, nth_minibuffer (minibuf_level)))
- goto found;
+ if (WINDOW_LIVE_P (window))
+ {
+ w = XWINDOW (window);
+ if (EQ (w->frame, exp_MB_frame)
+ && EQ (w->contents, nth_minibuffer (minibuf_level)))
+ goto found;
+ }
}
return; /* expired minibuffer not found. Maybe we should output an
error, here. */
diff --git a/src/w32term.c b/src/w32term.c
index 0ee805a..361cf33 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2031,8 +2031,11 @@ w32_draw_image_relief (struct glyph_string *s)
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
{
- thick = tool_bar_button_relief >= 0 ? tool_bar_button_relief
- : DEFAULT_TOOL_BAR_BUTTON_RELIEF;
+ thick = (tab_bar_button_relief < 0
+ ? DEFAULT_TAB_BAR_BUTTON_RELIEF
+ : (tool_bar_button_relief < 0
+ ? DEFAULT_TOOL_BAR_BUTTON_RELIEF
+ : min (tool_bar_button_relief, 1000000)));
raised_p = s->hl == DRAW_IMAGE_RAISED;
}
else
@@ -2045,6 +2048,19 @@ w32_draw_image_relief (struct glyph_string *s)
y1 = y + s->slice.height - 1;
extra_x = extra_y = 0;
+ if (s->face->id == TAB_BAR_FACE_ID)
+ {
+ if (CONSP (Vtab_bar_button_margin)
+ && FIXNUMP (XCAR (Vtab_bar_button_margin))
+ && FIXNUMP (XCDR (Vtab_bar_button_margin)))
+ {
+ extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin));
+ extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin));
+ }
+ else if (FIXNUMP (Vtab_bar_button_margin))
+ extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin);
+ }
+
if (s->face->id == TOOL_BAR_FACE_ID)
{
if (CONSP (Vtool_bar_button_margin)
diff --git a/src/window.c b/src/window.c
index 4d5c7e7..7c238a3 100644
--- a/src/window.c
+++ b/src/window.c
@@ -215,20 +215,6 @@ wset_combination (struct window *w, bool horflag,
Lisp_Object val)
w->horizontal = horflag;
}
-static void
-wset_update_mode_line (struct window *w)
-{
- /* If this window is the selected window on its frame, set the
- global variable update_mode_lines, so that gui_consider_frame_title
- will consider this frame's title for redisplay. */
- Lisp_Object fselected_window = XFRAME (WINDOW_FRAME (w))->selected_window;
-
- if (WINDOWP (fselected_window) && XWINDOW (fselected_window) == w)
- update_mode_lines = 42;
- else
- w->update_mode_line = true;
-}
-
/* True if leaf window W doesn't reflect the actual state
of displayed buffer due to its text or overlays change. */
@@ -2556,8 +2542,13 @@ window_list (void)
if (!CONSP (Vwindow_list))
{
Lisp_Object tail, frame;
+ ptrdiff_t count = SPECPDL_INDEX ();
Vwindow_list = Qnil;
+ /* Don't allow quitting in Fnconc. Otherwise we might end up
+ with a too short Vwindow_list and Fkill_buffer not being able
+ to replace a buffer in all windows showing it (Bug#47244). */
+ specbind (Qinhibit_quit, Qt);
FOR_EACH_FRAME (tail, frame)
{
Lisp_Object arglist = Qnil;
@@ -2569,6 +2560,8 @@ window_list (void)
arglist = Fnreverse (arglist);
Vwindow_list = nconc2 (Vwindow_list, arglist);
}
+
+ unbind_to (count, Qnil);
}
return Vwindow_list;
@@ -2705,6 +2698,8 @@ static Lisp_Object
next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames,
bool next_p)
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
decode_next_window_args (&window, &minibuf, &all_frames);
/* If ALL_FRAMES is a frame, and WINDOW isn't on that frame, just
@@ -2713,6 +2708,9 @@ next_window (Lisp_Object window, Lisp_Object minibuf,
Lisp_Object all_frames,
&& !EQ (all_frames, XWINDOW (window)->frame))
return Fframe_first_window (all_frames);
+ /* Don't allow quitting in Fmemq. */
+ specbind (Qinhibit_quit, Qt);
+
if (next_p)
{
Lisp_Object list;
@@ -2762,6 +2760,8 @@ next_window (Lisp_Object window, Lisp_Object minibuf,
Lisp_Object all_frames,
window = candidate;
}
+ unbind_to (count, Qnil);
+
return window;
}
@@ -2852,10 +2852,14 @@ static Lisp_Object
window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
{
Lisp_Object tail, list, rest;
+ ptrdiff_t count = SPECPDL_INDEX ();
decode_next_window_args (&window, &minibuf, &all_frames);
list = Qnil;
+ /* Don't allow quitting in Fmemq and Fnconc. */
+ specbind (Qinhibit_quit, Qt);
+
for (tail = window_list (); CONSP (tail); tail = XCDR (tail))
if (candidate_window_p (XCAR (tail), window, minibuf, all_frames))
list = Fcons (XCAR (tail), list);
@@ -2870,6 +2874,9 @@ window_list_1 (Lisp_Object window, Lisp_Object minibuf,
Lisp_Object all_frames)
XSETCDR (tail, Qnil);
list = nconc2 (rest, list);
}
+
+ unbind_to (count, Qnil);
+
return list;
}
diff --git a/src/window.h b/src/window.h
index 4f209f3..3a75c99 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1141,6 +1141,7 @@ extern void wset_redisplay (struct window *w);
extern void fset_redisplay (struct frame *f);
extern void bset_redisplay (struct buffer *b);
extern void bset_update_mode_line (struct buffer *b);
+extern void wset_update_mode_line (struct window *w);
/* Call this to tell redisplay to look for other windows than selected-window
that need to be redisplayed. Calling one of the *set_redisplay functions
above already does it, so it's only needed in unusual cases. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 82c9dc0..fecf1f6 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -869,6 +869,19 @@ bset_update_mode_line (struct buffer *b)
b->text->redisplay = true;
}
+void
+wset_update_mode_line (struct window *w)
+{
+ w->update_mode_line = true;
+ /* When a window's mode line needs to be updated, the window's frame's
+ title may also need to be updated, but we don't need to worry about it
+ here. Instead, `gui_consider_frame_title' is automatically called
+ whenever w->update_mode_line is set for that frame's selected window.
+ But for this to work reliably, we have to make sure the window
+ is considered, so we have to mark it for redisplay. */
+ wset_redisplay (w);
+}
+
DEFUN ("set-buffer-redisplay", Fset_buffer_redisplay,
Sset_buffer_redisplay, 4, 4, 0,
doc: /* Mark the current buffer for redisplay.
@@ -13607,8 +13620,9 @@ redisplay_tab_bar (struct frame *f)
/* Get information about the tab-bar item which is displayed in GLYPH
on frame F. Return in *PROP_IDX the index where tab-bar item
- properties start in F->tab_bar_items. Value is false if
- GLYPH doesn't display a tab-bar item. */
+ properties start in F->tab_bar_items. Return in CLOSE_P an
+ indication whether the click was on the close-tab icon of the tab.
+ Value is false if GLYPH doesn't display a tab-bar item. */
static bool
tab_bar_item_info (struct frame *f, struct glyph *glyph,
@@ -13654,7 +13668,6 @@ static int
get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
int *hpos, int *vpos, int *prop_idx, bool *close_p)
{
- Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
struct window *w = XWINDOW (f->tab_bar_window);
int area;
@@ -13668,18 +13681,7 @@ get_tab_bar_item (struct frame *f, int x, int y,
struct glyph **glyph,
if (!tab_bar_item_info (f, *glyph, prop_idx, close_p))
return -1;
- /* Is mouse on the highlighted item? */
- if (EQ (f->tab_bar_window, hlinfo->mouse_face_window)
- && *vpos >= hlinfo->mouse_face_beg_row
- && *vpos <= hlinfo->mouse_face_end_row
- && (*vpos > hlinfo->mouse_face_beg_row
- || *hpos >= hlinfo->mouse_face_beg_col)
- && (*vpos < hlinfo->mouse_face_end_row
- || *hpos < hlinfo->mouse_face_end_col
- || hlinfo->mouse_face_past_end))
- return 0;
-
- return 1;
+ return *prop_idx == f->last_tab_bar_item ? 0 : 1;
}
@@ -13701,25 +13703,14 @@ handle_tab_bar_click (struct frame *f, int x, int y,
bool down_p,
Lisp_Object enabled_p;
int ts;
- /* If not on the highlighted tab-bar item, and mouse-highlight is
- non-nil, return. This is so we generate the tab-bar button
- click only when the mouse button is released on the same item as
- where it was pressed. However, when mouse-highlight is disabled,
- generate the click when the button is released regardless of the
- highlight, since tab-bar items are not highlighted in that
- case. */
frame_to_window_pixel_xy (w, &x, &y);
ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
if (ts == -1
- || (ts != 0 && !NILP (Vmouse_highlight)))
+ /* If the button is released on a tab other than the one where
+ it was pressed, don't generate the tab-bar button click event. */
+ || (ts != 0 && !down_p))
return;
- /* When mouse-highlight is off, generate the click for the item
- where the button was pressed, disregarding where it was
- released. */
- if (NILP (Vmouse_highlight) && !down_p)
- prop_idx = f->last_tab_bar_item;
-
/* If item is disabled, do nothing. */
enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P);
if (NILP (enabled_p))
@@ -13727,10 +13718,10 @@ handle_tab_bar_click (struct frame *f, int x, int y,
bool down_p,
if (down_p)
{
- /* Show item in pressed state. */
+ /* Show the clicked button in pressed state. */
if (!NILP (Vmouse_highlight))
show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN);
- f->last_tab_bar_item = prop_idx;
+ f->last_tab_bar_item = prop_idx; /* record the pressed tab */
}
else
{
@@ -31998,6 +31989,11 @@ draw_row_with_mouse_face (struct window *w, int
start_x, struct glyph_row *row,
static void
show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw)
{
+ /* Don't bother doing anything if the mouse-face window is not set
+ up. */
+ if (!WINDOWP (hlinfo->mouse_face_window))
+ return;
+
struct window *w = XWINDOW (hlinfo->mouse_face_window);
struct frame *f = XFRAME (WINDOW_FRAME (w));
diff --git a/src/xselect.c b/src/xselect.c
index 030f624..cd6d86b 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1482,14 +1482,21 @@ x_get_window_property_as_lisp_data (struct
x_display_info *dpyinfo,
= XGetSelectionOwner (display, selection_atom) != 0;
unblock_input ();
if (there_is_a_selection_owner)
- signal_error ("Selection owner couldn't convert",
- actual_type
- ? list2 (target_type,
- x_atom_to_symbol (dpyinfo, actual_type))
- : target_type);
+ {
+ AUTO_STRING (format, "Selection owner couldn't convert: %s");
+ CALLN (Fmessage, format,
+ actual_type
+ ? list2 (target_type,
+ x_atom_to_symbol (dpyinfo, actual_type))
+ : target_type);
+ return Qnil;
+ }
else
- signal_error ("No selection",
- x_atom_to_symbol (dpyinfo, selection_atom));
+ {
+ AUTO_STRING (format, "No selection: %s");
+ CALLN (Fmessage, format, x_atom_to_symbol (dpyinfo, selection_atom));
+ return Qnil;
+ }
}
if (actual_type == dpyinfo->Xatom_INCR)
diff --git a/test/Makefile.in b/test/Makefile.in
index ba35428..91a8ea1 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -276,6 +276,8 @@ $(test_module): $(test_module:${SO}=.c)
../src/emacs-module.h
$(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c
endif
+src/emacs-tests.log: ../lib-src/seccomp-filter.c
+
## Check that there is no 'automated' subdirectory, which would
## indicate an incomplete merge from an older version of Emacs where
## the tests were arranged differently.
diff --git a/test/lisp/calculator-tests.el b/test/lisp/calculator-tests.el
new file mode 100644
index 0000000..9551b1a
--- /dev/null
+++ b/test/lisp/calculator-tests.el
@@ -0,0 +1,51 @@
+;;; calculator-tests.el --- Test suite for calculator. -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+(require 'ert)
+(require 'calculator)
+
+(ert-deftest calculator-test-calculator-string-to-number ()
+ (dolist (x '(("" 0.0)
+ ("+" 0.0)
+ ("-" 0.0)
+ ("." 0.0)
+ ("+." 0.0)
+ ("-." -0.0)
+ (".-" 0.0)
+ ("--." 0.0)
+ ("-0.0e" -0.0)
+ ("1e1" 10.0)
+ ("1e+1" 10.0)
+ ("1e-1" 0.1)
+ ("+1e1" 10.0)
+ ("-1e1" -10.0)
+ ("+1e-1" 0.1)
+ ("-1e-1" -0.1)
+ (".1.e1" 0.1)
+ (".1..e1" 0.1)
+ ("1e+1.1" 10.0)
+ ("-2e-1.1" -0.2)))
+ (pcase x
+ (`(,str ,expected)
+ (let ((calculator-input-radix nil))
+ (should (equal (calculator-string-to-number str) expected)))))))
+
+(provide 'calculator-tests)
+;; calculator-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5147cd2..c9ab3ec 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -41,7 +41,7 @@
"Identity, but hidden from some optimisations."
x)
-(defconst byte-opt-testsuite-arith-data
+(defconst bytecomp-tests--test-cases
'(
;; some functional tests
(let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c))
@@ -364,17 +364,17 @@
'((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c)
(t c) (x "a") (x "c") (x c) (x d) (x e)))
- (mapcar (lambda (x) (cond ((member '(a . b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1)
+ ((equal x '(c)) 2))))
'(((a . b)) a b (c) (d)))
- (mapcar (lambda (x) (cond ((memq '(a . b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1)
+ ((equal x '(c)) 2))))
'(((a . b)) a b (c) (d)))
- (mapcar (lambda (x) (cond ((member '(a b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1)
+ ((equal x '(c)) 2))))
'(((a b)) a b (c) (d)))
- (mapcar (lambda (x) (cond ((memq '(a b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((memq '(a b) x) 1)
+ ((equal x '(c)) 2))))
'(((a b)) a b (c) (d)))
(assoc 'b '((a 1) (b 2) (c 3)))
@@ -396,7 +396,7 @@
x)
(let ((x 1) (bytecomp-test-var 2) (y 3))
- (list x bytecomp-test-var (bytecomp-get-test-var) y))
+ (list x bytecomp-test-var (bytecomp-test-get-var) y))
(progn
(defvar d)
@@ -430,69 +430,126 @@
(list s x i))
(let ((x 2))
- (list (or (bytecomp-identity 'a) (setq x 3)) x)))
- "List of expression for test.
-Each element will be executed by interpreter and with
-bytecompiled code, and their results compared.")
+ (list (or (bytecomp-test-identity 'a) (setq x 3)) x))
-(defun bytecomp-check-1 (pat)
- "Return non-nil if PAT is the same whether directly evalled or compiled."
- (let ((warning-minimum-log-level :emergency)
- (byte-compile-warnings nil)
- (v0 (condition-case err
- (eval pat)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (byte-compile (list 'lambda nil pat)))
- (error (list 'bytecomp-check-error (car err))))))
- (equal v0 v1)))
-
-(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1)
-
-(defun bytecomp-explain-1 (pat)
- (let ((v0 (condition-case err
- (eval pat)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (byte-compile (list 'lambda nil pat)))
- (error (list 'bytecomp-check-error (car err))))))
- (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
- pat v0 v1)))
-
-(ert-deftest bytecomp-tests ()
- "Test the Emacs byte compiler."
- (dolist (pat byte-opt-testsuite-arith-data)
- (should (bytecomp-check-1 pat))))
-
-(defun test-byte-opt-arithmetic (&optional arg)
- "Unit test for byte-opt arithmetic operations.
-Subtests signal errors if something goes wrong."
- (interactive "P")
- (switch-to-buffer (generate-new-buffer "*Font Pase Test*"))
+ (let* ((x 1)
+ (y (condition-case x
+ (/ 1 0)
+ (arith-error x))))
+ (list x y))
+
+ (funcall
+ (condition-case x
+ (/ 1 0)
+ (arith-error (prog1 (lambda (y) (+ y x))
+ (setq x 10))))
+ 4)
+
+ ;; No error, no success handler.
+ (condition-case x
+ (list 42)
+ (error (cons 'bad x)))
+ ;; Error, no success handler.
+ (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x)))
+ ;; No error, success handler.
+ (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ ;; Error, success handler.
+ (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ ;; Verify that the success code is not subject to the error handlers.
+ (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (/ (car x) 0)))
+ ;; Check variable scoping on success.
+ (let ((x 2))
+ (condition-case x
+ (list x)
+ (error (list 'bad x))
+ (:success (list 'good x))))
+ ;; Check variable scoping on failure.
+ (let ((x 2))
+ (condition-case x
+ (/ 1 0)
+ (error (list 'bad x))
+ (:success (list 'good x))))
+ ;; Check capture of mutated result variable.
+ (funcall
+ (condition-case x
+ 3
+ (:success (prog1 (lambda (y) (+ y x))
+ (setq x 10))))
+ 4)
+ ;; Check for-effect context, on error.
+ (let ((f (lambda (x)
+ (condition-case nil
+ (/ 1 0)
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ ;; Check for-effect context, on success.
+ (let ((f (lambda (x)
+ (condition-case nil
+ nil
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ )
+ "List of expressions for cross-testing interpreted and compiled code.")
+
+(defconst bytecomp-tests--test-cases-lexbind-only
+ `(
+ ;; This would infloop (and exhaust stack) with dynamic binding.
+ (let ((f #'car))
+ (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
+ (funcall f '(1 . 2))))
+ )
+ "List of expressions for cross-testing interpreted and compiled code.
+These are only tested with lexical binding.")
+
+(defun bytecomp-tests--eval-interpreted (form)
+ "Evaluate FORM using the Lisp interpreter, returning errors as a
+special value."
+ (condition-case err
+ (eval form lexical-binding)
+ (error (list 'bytecomp-check-error (car err)))))
+
+(defun bytecomp-tests--eval-compiled (form)
+ "Evaluate FORM using the Lisp byte-code compiler, returning errors as a
+special value."
(let ((warning-minimum-log-level :emergency)
- (byte-compile-warnings nil)
- (pass-face '((t :foreground "green")))
- (fail-face '((t :foreground "red")))
- (print-escape-nonascii t)
- (print-escape-newlines t)
- (print-quoted t)
- v0 v1)
- (dolist (pat byte-opt-testsuite-arith-data)
- (condition-case err
- (setq v0 (eval pat))
- (error (setq v0 (list 'bytecomp-check-error (car err)))))
- (condition-case err
- (setq v1 (funcall (byte-compile (list 'lambda nil pat))))
- (error (setq v1 (list 'bytecomp-check-error (car err)))))
- (insert (format "%s" pat))
- (indent-to-column 65)
- (if (equal v0 v1)
- (insert (propertize "OK" 'face pass-face))
- (insert (propertize "FAIL\n" 'face fail-face))
- (indent-to-column 55)
- (insert (propertize (format "[%s] vs [%s]" v0 v1)
- 'face fail-face)))
- (insert "\n"))))
+ (byte-compile-warnings nil))
+ (condition-case err
+ (funcall (byte-compile (list 'lambda nil form)))
+ (error (list 'bytecomp-check-error (car err))))))
+
+(ert-deftest bytecomp-tests-lexbind ()
+ "Check that various expressions behave the same when interpreted and
+byte-compiled. Run with lexical binding."
+ (let ((lexical-binding t))
+ (dolist (form (append bytecomp-tests--test-cases-lexbind-only
+ bytecomp-tests--test-cases))
+ (ert-info ((prin1-to-string form) :prefix "form: ")
+ (should (equal (bytecomp-tests--eval-interpreted form)
+ (bytecomp-tests--eval-compiled form)))))))
+
+(ert-deftest bytecomp-tests-dynbind ()
+ "Check that various expressions behave the same when interpreted and
+byte-compiled. Run with dynamic binding."
+ (let ((lexical-binding nil))
+ (dolist (form bytecomp-tests--test-cases)
+ (ert-info ((prin1-to-string form) :prefix "form: ")
+ (should (equal (bytecomp-tests--eval-interpreted form)
+ (bytecomp-tests--eval-compiled form)))))))
(defun test-byte-comp-compile-and-load (compile &rest forms)
(declare (indent 1))
@@ -584,8 +641,8 @@ Subtests signal errors if something goes wrong."
`(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer))
(byte-compile ,@form)
- (ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward ,re-warning)))))
+ (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ")
+ (should (re-search-forward ,(string-replace " " "[ \n]+"
re-warning))))))
(ert-deftest bytecomp-warn-wrong-args ()
(bytecomp--with-warning-test "remq.*3.*2"
@@ -611,12 +668,13 @@ Subtests signal errors if something goes wrong."
(defmacro bytecomp--define-warning-file-test (file re-warning &optional
reverse)
`(ert-deftest ,(intern (format "bytecomp/%s" file)) ()
- :expected-result ,(if reverse :failed :passed)
(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer))
(byte-compile-file ,(ert-resource-file file))
(ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward ,re-warning))))))
+ (,(if reverse 'should-not 'should)
+ (re-search-forward ,(string-replace " " "[ \n]+" re-warning)
+ nil t))))))
(bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el"
"add-hook.*lexical var")
@@ -658,10 +716,10 @@ Subtests signal errors if something goes wrong."
"free.*foo")
(bytecomp--define-warning-file-test "warn-free-variable-reference.el"
- "free.*bar")
+ "free variable .bar")
(bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el"
- "make-variable-buffer-local.*not called at
toplevel")
+ "make-variable-buffer-local. not called at
toplevel")
(bytecomp--define-warning-file-test "warn-interactive-only.el"
"next-line.*interactive use only.*forward-line")
@@ -670,19 +728,19 @@ Subtests signal errors if something goes wrong."
"malformed interactive spec")
(bytecomp--define-warning-file-test "warn-obsolete-defun.el"
- "foo-obsolete.*obsolete function.*99.99")
+ "foo-obsolete. is an obsolete function (as of 99.99)")
(defvar bytecomp--tests-obsolete-var nil)
(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99")
(bytecomp--define-warning-file-test "warn-obsolete-hook.el"
- "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
+ "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el"
"foo-obs.*obsolete.*99.99" t)
(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
- "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
+ "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
"bytecomp--tests-obs.*obsolete.*99.99" t)
@@ -713,64 +771,64 @@ Subtests signal errors if something goes wrong."
(bytecomp--define-warning-file-test
"warn-wide-docstring-autoload.el"
- "autoload.*foox.*wider than.*characters")
+ "autoload .foox. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-custom-declare-variable.el"
- "custom-declare-variable.*foo.*wider than.*characters")
+ "custom-declare-variable .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-defalias.el"
- "defalias.*foo.*wider than.*characters")
+ "defalias .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-defconst.el"
- "defconst.*foo.*wider than.*characters")
+ "defconst .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-define-abbrev-table.el"
- "define-abbrev.*foo.*wider than.*characters")
+ "define-abbrev-table .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-define-obsolete-function-alias.el"
- "defalias.*foo.*wider than.*characters")
+ "defalias .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-define-obsolete-variable-alias.el"
- "defvaralias.*foo.*wider than.*characters")
+ "defvaralias .foo. docstring wider than .* characters")
;; TODO: We don't yet issue warnings for defuns.
(bytecomp--define-warning-file-test
"warn-wide-docstring-defun.el"
- "wider than.*characters" 'reverse)
+ "wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-defvar.el"
- "defvar.*foo.*wider than.*characters")
+ "defvar .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-defvaralias.el"
- "defvaralias.*foo.*wider than.*characters")
+ "defvaralias .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore-fill-column.el"
- "defvar.*foo.*wider than.*characters" 'reverse)
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore-override.el"
- "defvar.*foo.*wider than.*characters" 'reverse)
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore.el"
- "defvar.*foo.*wider than.*characters" 'reverse)
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-multiline-first.el"
- "defvar.*foo.*wider than.*characters")
+ "defvar .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-multiline.el"
- "defvar.*foo.*wider than.*characters")
+ "defvar .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"nowarn-inline-after-defvar.el"
@@ -813,47 +871,6 @@ Subtests signal errors if something goes wrong."
(defun def () (m))))
(should (equal (funcall 'def) 4)))
-(defconst bytecomp-lexbind-tests
- `(
- (let ((f #'car))
- (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
- (funcall f '(1 . 2))))
- )
- "List of expression for test.
-Each element will be executed by interpreter and with
-bytecompiled code, and their results compared.")
-
-(defun bytecomp-lexbind-check-1 (pat)
- "Return non-nil if PAT is the same whether directly evalled or compiled."
- (let ((warning-minimum-log-level :emergency)
- (byte-compile-warnings nil)
- (v0 (condition-case err
- (eval pat t)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (let ((lexical-binding t))
- (byte-compile `(lambda nil ,pat))))
- (error (list 'bytecomp-check-error (car err))))))
- (equal v0 v1)))
-
-(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1)
-
-(defun bytecomp-lexbind-explain-1 (pat)
- (let ((v0 (condition-case err
- (eval pat t)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (let ((lexical-binding t))
- (byte-compile (list 'lambda nil pat))))
- (error (list 'bytecomp-check-error (car err))))))
- (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
- pat v0 v1)))
-
-(ert-deftest bytecomp-lexbind-tests ()
- "Test the Emacs byte compiler lexbind handling."
- (dolist (pat bytecomp-lexbind-tests)
- (should (bytecomp-lexbind-check-1 pat))))
-
(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body)
(declare (indent 1))
(cl-check-type file-name-var symbol)
@@ -1227,6 +1244,74 @@ compiled correctly."
(let ((lexical-binding t))
(should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy)
"foo"))))
+(ert-deftest bytecomp-condition-case-success ()
+ ;; No error, no success handler.
+ (should (equal (condition-case x
+ (list 42)
+ (error (cons 'bad x)))
+ '(42)))
+ ;; Error, no success handler.
+ (should (equal (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x)))
+ '(bad arith-error)))
+ ;; No error, success handler.
+ (should (equal (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ '(good 42)))
+ ;; Error, success handler.
+ (should (equal (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ '(bad arith-error)))
+ ;; Verify that the success code is not subject to the error handlers.
+ (should-error (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (/ (car x) 0)))
+ :type 'arith-error)
+ ;; Check variable scoping.
+ (let ((x 2))
+ (should (equal (condition-case x
+ (list x)
+ (error (list 'bad x))
+ (:success (list 'good x)))
+ '(good (2))))
+ (should (equal (condition-case x
+ (/ 1 0)
+ (error (list 'bad x))
+ (:success (list 'good x)))
+ '(bad (arith-error)))))
+ ;; Check capture of mutated result variable.
+ (should (equal (funcall
+ (condition-case x
+ 3
+ (:success (prog1 (lambda (y) (+ y x))
+ (setq x 10))))
+ 4)
+ 14))
+ ;; Check for-effect context, on error.
+ (should (equal (let ((f (lambda (x)
+ (condition-case nil
+ (/ 1 0)
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ 4))
+ ;; Check for-effect context, on success.
+ (should (equal (let ((f (lambda (x)
+ (condition-case nil
+ nil
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ 4)))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index dd64876..f4e2e46 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -629,14 +629,25 @@ collection clause."
(let (n1)
(and xs
(progn (setq n1 (1+ n))
- (len2 (cdr xs) n1)))))))
+ (len2 (cdr xs) n1))))))
+ ;; Tail calls in error and success handlers.
+ (len3 (xs n)
+ (if xs
+ (condition-case k
+ (/ 1 (logand n 1))
+ (arith-error (len3 (cdr xs) (1+ n)))
+ (:success (len3 (cdr xs) (+ n k))))
+ n)))
(should (equal (len nil 0) 0))
(should (equal (len2 nil 0) 0))
+ (should (equal (len3 nil 0) 0))
(should (equal (len list-42 0) 42))
(should (equal (len2 list-42 0) 42))
+ (should (equal (len3 list-42 0) 42))
;; Should not bump into stack depth limits.
(should (equal (len list-42k 0) 42000))
- (should (equal (len2 list-42k 0) 42000))))
+ (should (equal (len2 list-42k 0) 42000))
+ (should (equal (len3 list-42k 0) 42000))))
;; Check that non-recursive functions are handled more efficiently.
(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 dcb261c..7d45432 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -1061,5 +1061,30 @@ backtracking (Bug#42701)."
"edebug-anon10001"
"edebug-tests-duplicate-symbol-backtrack"))))))
+(defmacro edebug-tests--duplicate-&define (_arg)
+ "Helper macro for the ERT test `edebug-tests-duplicate-&define'.
+The Edebug specification is similar to the one used by `cl-flet'
+previously; see Bug#41988."
+ (declare (debug (&or (&define name function-form) (defun)))))
+
+(ert-deftest edebug-tests-duplicate-&define ()
+ "Check that Edebug doesn't backtrack out of `&define' forms.
+This avoids potential duplicate definitions (Bug#41988)."
+ (with-temp-buffer
+ (print '(defun edebug-tests-duplicate-&define ()
+ (edebug-tests--duplicate-&define
+ (edebug-tests-duplicate-&define-inner () nil)))
+ (current-buffer))
+ (let* ((edebug-all-defs t)
+ (edebug-initial-mode 'Go-nonstop)
+ (instrumented-names ())
+ (edebug-new-definition-function
+ (lambda (name)
+ (when (memq name instrumented-names)
+ (error "Duplicate definition of `%s'" name))
+ (push name instrumented-names)
+ (edebug-new-definition name))))
+ (should-error (eval-buffer) :type 'invalid-read-syntax))))
+
(provide 'edebug-tests)
;;; edebug-tests.el ends here
diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el
new file mode 100644
index 0000000..b29796d
--- /dev/null
+++ b/test/lisp/loadhist-tests.el
@@ -0,0 +1,57 @@
+;;; loadhist-tests.el --- Tests for loadhist.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'loadhist)
+
+(ert-deftest loadhist-tests-feature-symbols ()
+ (should (equal (file-name-base (car (feature-symbols 'loadhist)))
"loadhist"))
+ (should-not (feature-symbols 'non-existent-feature)))
+
+(ert-deftest loadhist-tests-feature-file ()
+ (should (equal (file-name-base (feature-file 'loadhist)) "loadhist"))
+ (should-error (feature-file 'non-existent-feature)))
+
+(ert-deftest loadhist-tests-file-loadhist-lookup ()
+ ;; This should probably be extended...
+ (should (listp (file-loadhist-lookup "loadhist"))))
+
+(ert-deftest loadhist-tests-file-provides ()
+ (should (eq (car (file-provides "loadhist")) 'loadhist)))
+
+(ert-deftest loadhist-tests-file-requires ()
+ (should-not (file-requires "loadhist")))
+
+(ert-deftest loadhist-tests-file-dependents ()
+ (require 'dired-x)
+ (let ((deps (file-dependents "dired")))
+ (should (member "dired-x" (mapcar #'file-name-base deps)))))
+
+(ert-deftest loadhist-tests-unload-feature ()
+ (require 'dired-x)
+ (should-error (unload-feature 'dired))
+ (unload-feature 'dired-x))
+
+;;; loadhist-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index be428fc..1eb0d0e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -59,6 +59,7 @@
(declare-function tramp-get-remote-perl "tramp-sh")
(declare-function tramp-get-remote-stat "tramp-sh")
(declare-function tramp-list-tramp-buffers "tramp-cmds")
+(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
@@ -3097,6 +3098,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-scp-p)))
;; Wildcards are not supported in tramp-crypt.el.
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
@@ -4369,7 +4371,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(delete-file tmp-name))))))
(defun tramp--test-shell-file-name ()
- "Return default remote shell.."
+ "Return default remote shell."
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
(ert-deftest tramp-test28-process-file ()
@@ -5838,18 +5840,18 @@ This requires restrictions of file name syntax."
"Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt))
-(defun tramp--test-windows-nt-and-batch-p ()
- "Check, whether the locale host runs MS Windows in batch mode.
-This does not support special characters."
- (and (eq system-type 'windows-nt) noninteractive))
+(defun tramp--test-windows-nt-and-out-of-band-p ()
+ "Check, whether the locale host runs MS Windows and an out-of-band method.
+This does not support utf8 based file transfer."
+ (and (eq system-type 'windows-nt)
+ (tramp-method-out-of-band-p tramp-test-vec 1)))
-(defun tramp--test-windows-nt-and-pscp-psftp-p ()
- "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
+(defun tramp--test-windows-nt-and-scp-p ()
+ "Check, whether the locale host runs MS Windows, and scpx? is used.
This does not support utf8 based file transfer."
(and (eq system-type 'windows-nt)
(string-match-p
- (regexp-opt '("pscp" "psftp"))
- (file-remote-p tramp-test-temporary-file-directory 'method))))
+ "^scpx?" (file-remote-p tramp-test-temporary-file-directory 'method))))
(defun tramp--test-windows-nt-or-smb-p ()
"Check, whether the locale or remote host runs MS Windows.
@@ -6112,7 +6114,7 @@ This requires restrictions of file name syntax."
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-scp-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-special-characters))
@@ -6124,7 +6126,7 @@ Use the `stat' command."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-scp-p)))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6143,7 +6145,7 @@ Use the `perl' command."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-scp-p)))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6165,7 +6167,7 @@ Use the `ls' command."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-scp-p)))
(let ((tramp-connection-properties
(append
@@ -6230,8 +6232,7 @@ Use the `ls' command."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-gdrive-p)))
(skip-unless (not (tramp--test-crypt-p)))
@@ -6247,8 +6248,7 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; We cannot use `tramp-test-vec', because this fails during compilation.
@@ -6270,8 +6270,7 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; We cannot use `tramp-test-vec', because this fails during compilation.
@@ -6296,8 +6295,7 @@ Use the `ls' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
diff --git a/test/lisp/progmodes/project-tests.el
b/test/lisp/progmodes/project-tests.el
new file mode 100644
index 0000000..23e6854
--- /dev/null
+++ b/test/lisp/progmodes/project-tests.el
@@ -0,0 +1,44 @@
+;;; project-tests.el --- tests for project.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for progmodes/project.el.
+
+;;; Code:
+
+(require 'project)
+
+(require 'ert)
+
+(ert-deftest project/quoted-directory ()
+ "Check that `project-files' deals with quoted directory
+names (Bug#47799)."
+ (let ((directory (make-temp-file "project-tests-" :directory)))
+ (unwind-protect
+ (let ((project (cons 'transient (file-name-quote directory)))
+ (file (expand-file-name "file" directory)))
+ (make-empty-file file)
+ (should (equal (project-files project)
+ (list (file-name-quote file)))))
+ (delete-directory directory :recursive))))
+
+;;; project-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 0c2d712..7b9c2ff 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -117,8 +117,8 @@
(ignore-errors (delete-file shadow-info-file))
(ignore-errors (delete-file shadow-todo-file))
;; Reset variables.
+ (shadow-invalidate-hashtable)
(setq shadow-info-buffer nil
- shadow-hashtable nil
shadow-todo-buffer nil
shadow-files-to-copy nil))
diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el
index a54c253..d1d0d16 100644
--- a/test/manual/cedet/tests/test.el
+++ b/test/manual/cedet/tests/test.el
@@ -153,7 +153,4 @@
(defvar-mode-local emacs-lisp-mode a-mode-local-def
"some value")
-
-;;; Provide
-;;
(provide 'test)
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
new file mode 100644
index 0000000..9053a87
--- /dev/null
+++ b/test/manual/indent/scheme.scm
@@ -0,0 +1,23 @@
+;; Testing sexp-comments
+
+(define a #;(hello) there)
+
+(define a #;1 there)
+
+(define a #;"asdf" there)
+
+(define a ;; #;(hello
+ there)
+
+(define a #;(hello
+ there) 2)
+
+(define a #;(hello
+ #;(world))
+ and)
+ there) 2)
+
+(define a #;(hello
+ #;"asdf" (world
+ and)
+ there) 2)
diff --git a/test/src/character-tests.el b/test/src/character-tests.el
new file mode 100644
index 0000000..10fc4db
--- /dev/null
+++ b/test/src/character-tests.el
@@ -0,0 +1,45 @@
+;;; character-tests.el -- tests for character.c -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest character-test-string-width ()
+ "Test `string-width' with and without compositions."
+ (should (= (string-width "1234") 4))
+ (should (= (string-width "12\t34") (+ 4 tab-width)))
+ (should (= (string-width "áëòç") 4))
+ (should (= (string-width "áëòç") 4))
+ (should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
+ (should (= (string-width "1234" 1 3) 2))
+ (should (= (string-width "1234" nil -1) 3))
+ (should (= (string-width "1234" 2) 2))
+ (should-error (string-width "1234" nil 5))
+ (should-error (string-width "1234" -5))
+ (should (= (string-width "12\t34") (+ 4 tab-width)))
+ (should (= (string-width "1234\t56") (+ 6 tab-width)))
+ (should (= (string-width "áëòç") 4))
+ (should (= (string-width "áëòç" nil 3) 3))
+ (should (= (string-width "áëòç" 1 3) 2))
+ (should (= (string-width "áëòç" nil 2) 1))
+ (should (= (string-width "áëòç" nil 3) 2))
+ (should (= (string-width "áëòç" nil 4) 2))
+ (should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
+ (should (= (string-width "הַרְבֵּה אַהֲבָה" nil 8) 4)))
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 0000000..5b0e997
--- /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 0000000..b3d603d
--- /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 0000000..87c3e84
--- /dev/null
+++ b/test/src/emacs-tests.el
@@ -0,0 +1,257 @@
+;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for src/emacs.c.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+(require 'ert-x)
+(require 'rx)
+(require 'subr-x)
+
+(ert-deftest emacs-tests/seccomp/absent-file ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (should-not (file-exists-p "/does-not-exist.bpf"))
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ "--seccomp=/does-not-exist.bpf")
+ 0))))
+
+(cl-defmacro emacs-tests--with-temp-file
+ (var (prefix &optional suffix text) &rest body)
+ "Evaluate BODY while a new temporary file exists.
+Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT
+to `make-temp-file', which see."
+ (declare (indent 2) (debug (symbolp (form form form) body)))
+ (cl-check-type var symbol)
+ ;; Use an uninterned symbol so that the code still works if BODY
+ ;; changes VAR.
+ (let ((filename (make-symbol "filename")))
+ `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text)))
+ (unwind-protect
+ (let ((,var ,filename))
+ ,@body)
+ (delete-file ,filename)))))
+
+(ert-deftest emacs-tests/seccomp/empty-file ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf")
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't
+ ;; work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ ;; According to the Seccomp man page, a filter must have at
+ ;; least one element, so Emacs should reject an empty file.
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter))
+ 0)))))
+
+(ert-deftest emacs-tests/seccomp/file-too-large ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil)
+ ;; This value should be correct on all supported systems.
+ (ushort-max #xFFFF)
+ ;; Either 8 or 16, but 16 should be large enough in all cases.
+ (filter-size 16))
+ (skip-unless (file-executable-p emacs))
+ (emacs-tests--with-temp-file
+ filter ("seccomp-too-large-" ".bpf"
+ (make-string (* (1+ ushort-max) filter-size) ?a))
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't
+ ;; work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ ;; The filter count must fit into an `unsigned short'. A bigger
+ ;; file should be rejected.
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter))
+ 0)))))
+
+(ert-deftest emacs-tests/seccomp/invalid-file-size ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf"
+ "123456")
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't
+ ;; work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ ;; The Seccomp filter file must have a file size that's a
+ ;; multiple of the size of struct sock_filter, which is 8 or 16,
+ ;; but never 6.
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter))
+ 0)))))
+
+(ert-deftest emacs-tests/seccomp/allows-stdout ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (filter (ert-resource-file "seccomp-filter.bpf"))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (file-readable-p filter))
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ (with-temp-buffer
+ (let ((start-time (current-time))
+ (status (call-process
+ emacs nil t nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter)
+ (format "--eval=%S" '(message "Hi"))))
+ (end-time (current-time)))
+ (ert-info ((emacs-tests--seccomp-debug start-time end-time))
+ (should (eql status 0)))
+ (should (equal (string-trim (buffer-string)) "Hi"))))))
+
+(ert-deftest emacs-tests/seccomp/forbids-subprocess ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (filter (ert-resource-file "seccomp-filter.bpf"))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (file-readable-p filter))
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ (with-temp-buffer
+ (let ((start-time (current-time))
+ (status
+ (call-process
+ emacs nil t nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter)
+ (format "--eval=%S" `(call-process ,emacs nil nil nil
+ "--version"))))
+ (end-time (current-time)))
+ (ert-info ((emacs-tests--seccomp-debug start-time end-time))
+ (should-not (eql status 0)))))))
+
+(ert-deftest emacs-tests/bwrap/allows-stdout ()
+ (let ((bash (executable-find "bash"))
+ (bwrap (executable-find "bwrap"))
+ (emacs
+ (expand-file-name invocation-name invocation-directory))
+ (filter (ert-resource-file "seccomp-filter-exec.bpf"))
+ (process-environment nil))
+ (skip-unless bash)
+ (skip-unless bwrap)
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (file-readable-p filter))
+ (should-not (file-remote-p bwrap))
+ (should-not (file-remote-p emacs))
+ (should-not (file-remote-p filter))
+ (with-temp-buffer
+ (let* ((command
+ (concat
+ (mapconcat #'shell-quote-argument
+ `(,(file-name-unquote bwrap)
+ "--ro-bind" "/" "/"
+ "--seccomp" "20"
+ "--"
+ ,(file-name-unquote emacs)
+ "--quick" "--batch"
+ ,(format "--eval=%S" '(message "Hi")))
+ " ")
+ " 20< "
+ (shell-quote-argument (file-name-unquote filter))))
+ (start-time (current-time))
+ (status (call-process bash nil t nil "-c" command))
+ (end-time (current-time)))
+ (ert-info ((emacs-tests--seccomp-debug start-time end-time))
+ (should (eql status 0)))
+ (should (equal (string-trim (buffer-string)) "Hi"))))))
+
+(defun emacs-tests--seccomp-debug (start-time end-time)
+ "Return potentially useful debugging information for Seccomp.
+Assume that the current buffer contains subprocess output for the
+failing process. START-TIME and END-TIME are time values between
+which the process was running."
+ ;; Add a bit of slack for the timestamps.
+ (cl-callf time-subtract start-time 5)
+ (cl-callf time-add end-time 5)
+ (with-output-to-string
+ (princ "Process output:")
+ (terpri)
+ (princ (buffer-substring-no-properties (point-min) (point-max)))
+ ;; Search audit logs for Seccomp messages.
+ (when-let ((ausearch (executable-find "ausearch")))
+ (terpri)
+ (princ "Potentially relevant Seccomp audit events:")
+ (terpri)
+ (let ((process-environment '("LC_TIME=C")))
+ (call-process ausearch nil standard-output nil
+ "--message" "SECCOMP"
+ "--start"
+ (format-time-string "%D" start-time)
+ (format-time-string "%T" start-time)
+ "--end"
+ (format-time-string "%D" end-time)
+ (format-time-string "%T" end-time)
+ "--interpret")))
+ ;; Print coredump information if available.
+ (when-let ((coredumpctl (executable-find "coredumpctl")))
+ (terpri)
+ (princ "Potentially useful coredump information:")
+ (terpri)
+ (call-process coredumpctl nil standard-output nil
+ "info"
+ "--since" (format-time-string "%F %T" start-time)
+ "--until" (format-time-string "%F %T" end-time)
+ "--no-pager"))))
+
+;;; emacs-tests.el ends here