[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 82bd6d5: Merge remote-tracking branch 'savannah/mast
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 82bd6d5: Merge remote-tracking branch 'savannah/master' into native-comp |
|
Date: |
Fri, 12 Mar 2021 10:46:49 -0500 (EST) |
branch: feature/native-comp
commit 82bd6d57d54d4cdb205d921c2476d1dbb17f4188
Merge: d9cd55a a0854f9
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into native-comp
---
.gitignore | 1 +
Makefile.in | 18 +-
admin/admin.el | 6 +-
admin/charsets/Makefile.in | 12 +-
admin/charsets/mapfiles/README | 4 +-
admin/grammars/Makefile.in | 13 +-
admin/grammars/grammar.wy | 10 +-
admin/grammars/python.wy | 4 +-
admin/unidata/Makefile.in | 18 +-
configure.ac | 8 +-
doc/emacs/Makefile.in | 28 +-
doc/emacs/custom.texi | 14 +-
doc/emacs/maintaining.texi | 4 +
doc/lispintro/Makefile.in | 25 +-
doc/lispintro/emacs-lisp-intro.texi | 17 +-
doc/lispref/Makefile.in | 25 +-
doc/lispref/buffers.texi | 3 -
doc/lispref/display.texi | 15 +
doc/lispref/eval.texi | 1 -
doc/lispref/files.texi | 5 -
doc/lispref/keymaps.texi | 6 -
doc/lispref/loading.texi | 1 -
doc/lispref/minibuf.texi | 4 -
doc/lispref/positions.texi | 1 -
doc/lispref/variables.texi | 2 -
doc/misc/Makefile.in | 27 +-
doc/misc/efaq-w32.texi | 9 +-
doc/misc/gnus-faq.texi | 8 +-
doc/misc/gnus.texi | 15 +-
doc/misc/tramp.texi | 281 ++++++++----
etc/NEWS | 123 ++++--
etc/compilation.txt | 4 +-
etc/grep.txt | 4 +-
leim/Makefile.in | 14 +-
lib-src/Makefile.in | 29 +-
lib/Makefile.in | 21 +-
lisp/Makefile.in | 26 +-
lisp/align.el | 4 +-
lisp/arc-mode.el | 6 +-
lisp/auth-source.el | 6 +-
lisp/button.el | 4 +-
lisp/calc/calc-yank.el | 5 +-
lisp/calculator.el | 2 +-
lisp/calendar/icalendar.el | 3 -
lisp/calendar/todo-mode.el | 8 +-
lisp/cedet/ede/pmake.el | 4 +-
lisp/cedet/ede/project-am.el | 8 +-
lisp/cedet/semantic/bovine.el | 27 +-
lisp/cedet/semantic/bovine/c.el | 96 +++--
lisp/cedet/semantic/bovine/debug.el | 4 +-
lisp/cedet/semantic/bovine/el.el | 4 +-
lisp/cedet/semantic/bovine/gcc.el | 8 +-
lisp/cedet/semantic/bovine/make.el | 8 +-
lisp/cedet/semantic/bovine/scm.el | 6 +-
lisp/cedet/semantic/db-el.el | 6 +-
lisp/cedet/semantic/fw.el | 12 +-
lisp/cedet/semantic/grammar-wy.el | 617 +++++++++++++--------------
lisp/cedet/semantic/grammar.el | 62 +--
lisp/cedet/semantic/idle.el | 97 +++--
lisp/cedet/semantic/lex.el | 27 +-
lisp/cedet/semantic/scope.el | 4 +-
lisp/cedet/semantic/wisent.el | 13 +-
lisp/cedet/semantic/wisent/comp.el | 78 ++--
lisp/cedet/semantic/wisent/grammar.el | 12 +-
lisp/cedet/semantic/wisent/java-tags.el | 4 +-
lisp/cedet/semantic/wisent/javascript.el | 15 +-
lisp/cedet/semantic/wisent/python.el | 8 +-
lisp/cedet/semantic/wisent/wisent.el | 14 +-
lisp/doc-view.el | 2 +
lisp/emacs-lisp/benchmark.el | 3 +-
lisp/emacs-lisp/byte-opt.el | 2 +
lisp/emacs-lisp/bytecomp.el | 16 +-
lisp/emacs-lisp/cconv.el | 19 +-
lisp/emacs-lisp/checkdoc.el | 39 +-
lisp/emacs-lisp/debug.el | 2 +-
lisp/emacs-lisp/easy-mmode.el | 18 +-
lisp/emacs-lisp/edebug.el | 2 +-
lisp/emacs-lisp/ert.el | 31 +-
lisp/emacs-lisp/syntax.el | 13 +-
lisp/emacs-lisp/tcover-ses.el | 4 +-
lisp/emulation/cua-rect.el | 2 +-
lisp/emulation/edt.el | 28 +-
lisp/erc/erc-menu.el | 4 +-
lisp/erc/erc-track.el | 2 -
lisp/erc/erc.el | 56 +--
lisp/eshell/em-ls.el | 6 +-
lisp/faces.el | 17 +
lisp/files.el | 4 +-
lisp/gnus/gnus-art.el | 21 +-
lisp/gnus/gnus-kill.el | 4 +-
lisp/gnus/gnus-msg.el | 7 +-
lisp/gnus/gnus-search.el | 4 +-
lisp/gnus/gnus-start.el | 12 +-
lisp/gnus/gnus-sum.el | 8 +-
lisp/gnus/gnus.el | 4 +-
lisp/gnus/nnbabyl.el | 4 +-
lisp/gnus/nnfolder.el | 4 +-
lisp/gnus/nnimap.el | 2 +-
lisp/gnus/nnmail.el | 8 -
lisp/gnus/nnmh.el | 2 +
lisp/gnus/nnrss.el | 5 +-
lisp/gnus/nntp.el | 2 +-
lisp/help-fns.el | 21 +-
lisp/help-macro.el | 224 +++++-----
lisp/help-mode.el | 4 +-
lisp/help.el | 153 ++++---
lisp/ibuffer.el | 4 +-
lisp/ido.el | 4 +-
lisp/image-mode.el | 24 +-
lisp/image.el | 51 ++-
lisp/info.el | 4 +-
lisp/international/quail.el | 2 +-
lisp/isearch.el | 8 +-
lisp/jit-lock.el | 2 +-
lisp/mail/binhex.el | 14 +-
lisp/mail/blessmail.el | 2 +-
lisp/mail/emacsbug.el | 28 +-
lisp/mail/feedmail.el | 10 +-
lisp/mail/flow-fill.el | 4 +-
lisp/mail/ietf-drums.el | 4 +-
lisp/mail/mail-extr.el | 47 +-
lisp/mail/mail-hist.el | 15 +-
lisp/mail/mail-utils.el | 6 +-
lisp/mail/mailabbrev.el | 30 +-
lisp/mail/mailclient.el | 2 +-
lisp/mail/mailheader.el | 35 +-
lisp/mail/mspools.el | 10 +-
lisp/mail/rfc822.el | 2 +-
lisp/mail/rmail-spam-filter.el | 46 +-
lisp/mail/rmail.el | 4 +-
lisp/mail/rmailedit.el | 8 +-
lisp/mail/rmailkwd.el | 4 +-
lisp/mail/rmailmm.el | 194 +++++----
lisp/mail/rmailmsc.el | 4 +-
lisp/mail/rmailout.el | 11 +-
lisp/mail/rmailsort.el | 6 +-
lisp/mail/smtpmail.el | 8 +-
lisp/mail/supercite.el | 102 ++---
lisp/mail/uce.el | 27 +-
lisp/mail/unrmail.el | 4 +-
lisp/mouse-copy.el | 5 +-
lisp/mouse-drag.el | 2 +-
lisp/net/ange-ftp.el | 7 +-
lisp/net/browse-url.el | 42 +-
lisp/net/dictionary.el | 69 ++-
lisp/net/dig.el | 4 +-
lisp/net/dns.el | 8 +-
lisp/net/eudc-bob.el | 20 +-
lisp/net/eudc-export.el | 78 ++--
lisp/net/eudc-hotlist.el | 14 +-
lisp/net/eudc.el | 14 +-
lisp/net/eudcb-bbdb.el | 125 +++---
lisp/net/eudcb-ldap.el | 18 +-
lisp/net/eudcb-mab.el | 2 +-
lisp/net/eudcb-macos-contacts.el | 4 +-
lisp/net/gnutls.el | 7 +-
lisp/net/goto-addr.el | 28 +-
lisp/net/net-utils.el | 84 ++--
lisp/net/network-stream.el | 3 +-
lisp/net/newst-backend.el | 32 +-
lisp/net/newst-plainview.el | 121 +++---
lisp/net/newst-reader.el | 10 +-
lisp/net/newst-ticker.el | 12 +-
lisp/net/newst-treeview.el | 129 +++---
lisp/net/puny.el | 4 +-
lisp/net/quickurl.el | 29 +-
lisp/net/rcirc.el | 2 +-
lisp/net/secrets.el | 10 +-
lisp/net/shr-color.el | 14 +-
lisp/net/shr.el | 26 +-
lisp/net/sieve-mode.el | 6 +-
lisp/net/soap-client.el | 26 +-
lisp/net/soap-inspect.el | 46 +-
lisp/net/telnet.el | 20 +-
lisp/net/tramp-cache.el | 28 +-
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-compat.el | 2 +-
lisp/net/tramp-fuse.el | 205 +++++++++
lisp/net/tramp-integration.el | 2 +-
lisp/net/tramp-rclone.el | 188 +-------
lisp/net/tramp-sh.el | 132 +++---
lisp/net/tramp-sshfs.el | 367 ++++++++++++++++
lisp/net/tramp-sudoedit.el | 22 +-
lisp/net/tramp.el | 87 ++--
lisp/net/webjump.el | 2 +-
lisp/obsolete/inversion.el | 6 +-
lisp/obsolete/iswitchb.el | 35 +-
lisp/obsolete/nnir.el | 14 +-
lisp/obsolete/starttls.el | 2 +-
lisp/org/ob-lilypond.el | 6 +-
lisp/org/ol-gnus.el | 4 +-
lisp/org/ol.el | 6 +-
lisp/org/org-clock.el | 8 +-
lisp/org/org-crypt.el | 2 +
lisp/org/org-protocol.el | 4 +-
lisp/org/org-tempo.el | 2 +-
lisp/org/org.el | 2 +-
lisp/org/ox-odt.el | 11 +-
lisp/org/ox.el | 4 +-
lisp/outline.el | 72 ++--
lisp/progmodes/cfengine.el | 4 +-
lisp/progmodes/cperl-mode.el | 30 +-
lisp/progmodes/ebrowse.el | 4 +-
lisp/progmodes/project.el | 7 +-
lisp/progmodes/xref.el | 117 +++--
lisp/ruler-mode.el | 2 +-
lisp/ses.el | 24 +-
lisp/simple.el | 55 ++-
lisp/skeleton.el | 3 +-
lisp/speedbar.el | 20 +-
lisp/subr.el | 6 +-
lisp/tab-bar.el | 111 ++++-
lisp/tar-mode.el | 8 +-
lisp/textmodes/artist.el | 4 +-
lisp/textmodes/flyspell.el | 4 +-
lisp/textmodes/reftex-vars.el | 2 +-
lisp/textmodes/rst.el | 2 +-
lisp/textmodes/table.el | 2 +-
lisp/tooltip.el | 7 +-
lisp/userlock.el | 75 +++-
lisp/vc/pcvs-parse.el | 10 +
lisp/vc/smerge-mode.el | 49 +--
lisp/vc/vc.el | 7 +-
lisp/xdg.el | 4 +-
lwlib/Makefile.in | 19 +-
nt/Makefile.in | 19 +-
oldXMenu/Makefile.in | 19 +-
src/Makefile.in | 36 +-
src/buffer.c | 1 +
src/fns.c | 3 +-
src/image.c | 20 +-
src/keymap.c | 25 +-
src/sysdep.c | 17 +-
src/verbose.mk.in | 50 +++
test/Makefile.in | 27 +-
test/infra/Dockerfile.emba | 12 +-
test/lisp/cedet/semantic-utest-c.el | 1 -
test/lisp/emacs-lisp/bytecomp-tests.el | 5 +
test/lisp/emacs-lisp/ert-tests.el | 2 +-
test/lisp/help-tests.el | 24 +-
test/lisp/kmacro-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 85 ++--
test/lisp/progmodes/xref-resources/file1.txt | 2 +-
test/lisp/progmodes/xref-resources/file3.txt | 1 +
test/lisp/progmodes/xref-tests.el | 48 ++-
test/lisp/simple-tests.el | 111 ++++-
test/lisp/subr-tests.el | 7 +-
247 files changed, 3762 insertions(+), 3030 deletions(-)
diff --git a/.gitignore b/.gitignore
index d1a8c1d..53611ce 100644
--- a/.gitignore
+++ b/.gitignore
@@ -76,6 +76,7 @@ lib/unistd.h
src/buildobj.h
src/globals.h
src/lisp.mk
+src/verbose.mk
# Lisp-level sources built by 'make'.
*cus-load.el
diff --git a/Makefile.in b/Makefile.in
index 2c28c5c..6f09878 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -95,18 +95,8 @@ configuration=@configuration@
### The nt/ subdirectory gets built only for MinGW
NTDIR=@NTDIR@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+top_builddir = @top_builddir@
+-include ${top_builddir}/src/verbose.mk
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
@@ -969,6 +959,10 @@ extraclean: $(extraclean_dirs:=_extraclean)
# I removed it because it causes `make tags` to build Emacs.
TAGS tags: lib lib-src # src
$(MAKE) -C src tags
+ $(MAKE) -C doc/emacs tags
+ $(MAKE) -C doc/lispintro tags
+ $(MAKE) -C doc/lispref tags
+ $(MAKE) -C doc/misc tags
CHECK_TARGETS = check check-maybe check-expensive check-all
.PHONY: $(CHECK_TARGETS)
diff --git a/admin/admin.el b/admin/admin.el
index 203cf10..e370107 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -665,7 +665,7 @@ style=\"text-align:left\">")
(defconst make-manuals-dist-output-variables
'(("@\\(top_\\)?srcdir@" . ".") ; top_srcdir is wrong, but not used
- ("@abs_top_builddir@" . ".") ; wrong but unused
+ ("@\\(abs_\\)?top_builddir@" . ".") ; wrong but unused
("^\\(EMACS *=\\).*" . "\\1 emacs")
("^\\(\\(?:texinfo\\|buildinfo\\|emacs\\)dir *=\\).*" . "\\1 .")
("^\\(clean:.*\\)" . "\\1 infoclean")
@@ -684,9 +684,7 @@ style=\"text-align:left\">")
("@INSTALL@" . "install -c")
("@INSTALL_DATA@" . "${INSTALL} -m 644")
("@configure_input@" . "")
- ("@AM_DEFAULT_VERBOSITY@" . "0")
- ("@AM_V@" . "${V}")
- ("@AM_DEFAULT_V@" . "${AM_DEFAULT_VERBOSITY}"))
+ ("@AM_DEFAULT_VERBOSITY@" . "0"))
"Alist of (REGEXP . REPLACEMENT) pairs for `make-manuals-dist'.")
(defun make-manuals-dist--1 (root type)
diff --git a/admin/charsets/Makefile.in b/admin/charsets/Makefile.in
index 0fd130d..1fe0299 100644
--- a/admin/charsets/Makefile.in
+++ b/admin/charsets/Makefile.in
@@ -31,6 +31,7 @@ AWK = @AWK@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
charsetdir = ${top_srcdir}/etc/charsets
lispintdir = ${top_srcdir}/lisp/international
@@ -38,16 +39,7 @@ mapfiledir = ${srcdir}/mapfiles
GLIBC_CHARMAPS = ${srcdir}/glibc
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
# Note: We can not prepend "ISO-" to these map files because of file
# name limits on DOS.
diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README
index 60f0912..fb07826 100644
--- a/admin/charsets/mapfiles/README
+++ b/admin/charsets/mapfiles/README
@@ -63,8 +63,8 @@ to "JIS X 0213:2004".
* MULE-*.map
-Created by using ../mule-charsets.el in Emacs 22 as this:
- % emacs-22 -batch -l ../mule-charsets.el
+Created by using ../mule-charsets.el in Emacs as this:
+ % emacs -batch -l ../mule-charsets.el
This file is part of GNU Emacs.
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index 98c9c62..aa09d9e 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -28,18 +28,7 @@ srcdir = @srcdir@
top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH
diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy
index 054e85b..35fb7e8 100644
--- a/admin/grammars/grammar.wy
+++ b/admin/grammars/grammar.wy
@@ -128,7 +128,7 @@ epilogue:
;;
declaration:
decl
- (eval $1)
+ (eval $1 t)
;
decl:
@@ -206,7 +206,7 @@ put_decl:
put_name_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-name (EXPANDFULL $1 put_names))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 put_names))
;
put_names:
@@ -226,7 +226,7 @@ put_name:
put_value_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-code-detail (EXPANDFULL $1 put_values))
+ (mapcar #'semantic-tag-code-detail (EXPANDFULL $1 put_values))
;
put_values:
@@ -300,7 +300,7 @@ plist:
use_name_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-name (EXPANDFULL $1 use_names))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 use_names))
;
use_names:
@@ -356,7 +356,7 @@ nonterminal:
rules:
lifo_rules
- (apply 'nconc (nreverse $1))
+ (apply #'nconc (nreverse $1))
;
lifo_rules:
diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy
index 9c8f4ac..2539d1b 100644
--- a/admin/grammars/python.wy
+++ b/admin/grammars/python.wy
@@ -91,12 +91,14 @@
%expectedconflicts 5
%{
+(require 'semantic/tag)
(declare-function wisent-python-reconstitute-function-tag
"semantic/wisent/python" (tag suite))
(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python"
(tag))
(declare-function semantic-parse-region "semantic"
(start end &optional nonterminal depth returnonerror))
+(defvar wisent-python-EXPANDING-block)
}
%languagemode python-mode
@@ -871,7 +873,7 @@ paren_class_list_opt
paren_class_list
: PAREN_BLOCK
(let ((wisent-python-EXPANDING-block t))
- (mapcar 'semantic-tag-name (EXPANDFULL $1 paren_classes)))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 paren_classes)))
;
;; parameters: '(' [varargslist] ')'
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index f31e1bb..183569f 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -36,23 +36,7 @@ emacs = "${EMACS}" -batch --no-site-file --no-site-lisp
lparen = (
unifiles = $(addprefix ${unidir}/,$(sort $(shell sed -n 's/^[ \t][
\t]*${lparen}"\(uni-[^"]*\)"$$/\1/p' ${srcdir}/unidata-gen.el)))
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_ELC = $(am__v_ELC_@AM_V@)
-am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
-am__v_ELC_0 = @echo " ELC " $@;
-am__v_ELC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
.PHONY: all
diff --git a/configure.ac b/configure.ac
index b5b98ee..e0f7636 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1186,9 +1186,6 @@ AC_DEFUN([AM_CONDITIONAL],
dnl Prefer silent make output. For verbose output, use
dnl 'configure --disable-silent-rules' or 'make V=1' .
-dnl This code is adapted from Automake.
-dnl Although it can be simplified now that GNU Make is assumed,
-dnl the simplification hasn't been done yet.
AC_ARG_ENABLE([silent-rules],
[AS_HELP_STRING(
[--disable-silent-rules],
@@ -1198,11 +1195,8 @@ if test "$enable_silent_rules" = no; then
else
AM_DEFAULT_VERBOSITY=0
fi
-AM_V='$(V)'
-AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
-AC_SUBST([AM_V])
-AC_SUBST([AM_DEFAULT_V])
AC_SUBST([AM_DEFAULT_VERBOSITY])
+AC_CONFIG_FILES([src/verbose.mk])
dnl Some other nice autoconf tests.
AC_PROG_INSTALL
diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in
index 2a3f53f..69d39ef 100644
--- a/doc/emacs/Makefile.in
+++ b/doc/emacs/Makefile.in
@@ -28,6 +28,8 @@ srcdir=@srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
+
version = @version@
## Where the output files go.
@@ -73,13 +75,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = $(AM_V_GEN)TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
@@ -224,7 +220,7 @@ infoclean:
$(buildinfodir)/emacs.info-[1-9][0-9]
bootstrap-clean maintainer-clean: distclean infoclean
- rm -f ${srcdir}/emacsver.texi
+ rm -f ${srcdir}/emacsver.texi TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -273,4 +269,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} --include=../lispref/TAGS --include=../misc/TAGS
$(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
+
### Makefile ends here
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 22900c5..bd505d2 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -388,15 +388,15 @@ file. For example:
Emacs versions, like this:
@example
-(cond ((< emacs-major-version 22)
- ;; @r{Emacs 21 customization.}
- (setq custom-file "~/.config/custom-21.el"))
- ((and (= emacs-major-version 22)
+(cond ((< emacs-major-version 28)
+ ;; @r{Emacs 27 customization.}
+ (setq custom-file "~/.config/custom-27.el"))
+ ((and (= emacs-major-version 26)
(< emacs-minor-version 3))
- ;; @r{Emacs 22 customization, before version 22.3.}
- (setq custom-file "~/.config/custom-22.el"))
+ ;; @r{Emacs 26 customization, before version 26.3.}
+ (setq custom-file "~/.config/custom-26.el"))
(t
- ;; @r{Emacs version 22.3 or later.}
+ ;; @r{Emacs version 28.1 or later.}
(setq custom-file "~/.config/emacs-custom.el")))
(load custom-file)
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index bc276c4..2750418 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1611,6 +1611,10 @@ branch ID for a branch starting at the current revision.
For example,
if the current revision is 2.5, the branch ID should be 2.5.1, 2.5.2,
and so on, depending on the number of existing branches at that point.
+ This procedure will not work for distributed version control systems
+like git or Mercurial. For those systems you should use the prefix
+argument to @code{vc-create-tag} (@kbd{C-u C-x v s}) instead.
+
To create a new branch at an older revision (one that is no longer
the head of a branch), first select that revision (@pxref{Switching
Branches}). Your procedure will then differ depending on whether you
diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in
index d8b909c..294b310 100644
--- a/doc/lispintro/Makefile.in
+++ b/doc/lispintro/Makefile.in
@@ -20,6 +20,7 @@
SHELL = @SHELL@
srcdir = @srcdir@
+top_builddir = @top_builddir@
buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
@@ -55,13 +56,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = \
$(AM_V_GEN)TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \
@@ -124,6 +119,7 @@ infoclean:
$(buildinfodir)/eintr.info-[1-9]
bootstrap-clean maintainer-clean: distclean infoclean
+ rm -f TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -171,5 +167,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
### Makefile ends here
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index d5c280b..5b15a45 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -17532,10 +17532,9 @@ Here is the definition:
@need 1250
Now for the keybinding.
-Nowadays, function keys as well as mouse button events and
-non-@sc{ascii} characters are written within square brackets, without
-quotation marks. (In Emacs version 18 and before, you had to write
-different function key bindings for each different make of terminal.)
+Function keys as well as mouse button events and non-@sc{ascii}
+characters are written within square brackets, without quotation
+marks.
I bind @code{line-to-top-of-window} to my @key{F6} function key like
this:
@@ -17550,18 +17549,18 @@ Your Init File, emacs, The GNU Emacs Manual}.
@cindex Conditional 'twixt two versions of Emacs
@cindex Version of Emacs, choosing
@cindex Emacs version, choosing
-If you run two versions of GNU Emacs, such as versions 22 and 23, and
+If you run two versions of GNU Emacs, such as versions 27 and 28, and
use one @file{.emacs} file, you can select which code to evaluate with
the following conditional:
@smallexample
@group
(cond
- ((= 22 emacs-major-version)
- ;; evaluate version 22 code
+ ((= 27 emacs-major-version)
+ ;; evaluate version 27 code
( @dots{} ))
- ((= 23 emacs-major-version)
- ;; evaluate version 23 code
+ ((= 28 emacs-major-version)
+ ;; evaluate version 28 code
( @dots{} )))
@end group
@end smallexample
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 271f06e..a7701c5 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -24,6 +24,7 @@ SHELL = @SHELL@
# Standard configure variables.
srcdir = @srcdir@
+top_builddir = @top_builddir@
buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
@@ -59,13 +60,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = \
$(AM_V_GEN)TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \
@@ -185,6 +180,7 @@ infoclean:
$(buildinfodir)/elisp.info-[1-9][0-9]
bootstrap-clean maintainer-clean: distclean infoclean
+ rm -f TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -232,5 +228,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
### Makefile ends here
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 69733f9..0d31b0b 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -309,7 +309,6 @@ foo
This function renames the current buffer to @var{newname}. An error
is signaled if @var{newname} is not a string.
-@c Emacs 19 feature
Ordinarily, @code{rename-buffer} signals an error if @var{newname} is
already in use. However, if @var{unique} is non-@code{nil}, it modifies
@var{newname} to make a name that is not in use. Interactively, you can
@@ -344,7 +343,6 @@ a name. For example:
See also the function @code{get-buffer-create} in @ref{Creating Buffers}.
@end defun
-@c Emacs 19 feature
@defun generate-new-buffer-name starting-name &optional ignore
This function returns a name that would be unique for a new buffer---but
does not create the buffer. It starts with @var{starting-name}, and
@@ -879,7 +877,6 @@ then @code{other-buffer} uses that predicate to decide
which buffers to
consider. It calls the predicate once for each buffer, and if the value
is @code{nil}, that buffer is ignored. @xref{Buffer Parameters}.
-@c Emacs 19 feature
If @var{visible-ok} is @code{nil}, @code{other-buffer} avoids returning
a buffer visible in any window on any visible frame, except as a last
resort. If @var{visible-ok} is non-@code{nil}, then it does not matter
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 131ad2d..f003d52 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -5392,6 +5392,21 @@ are supported, unless the image type is
@code{imagemagick}. Positive
values rotate clockwise, negative values counter-clockwise. Rotation
is performed after scaling and cropping.
+@item :transform-smoothing @var{smooth}
+If this is @code{t}, any image transform will have smoothing applied;
+if @code{nil}, no smoothing will be applied. The exact algorithm used
+is platform dependent, but should be equivalent to bilinear
+filtering. Disabling smoothing will use the nearest neighbor
+algorithm.
+
+If this property is not specified, @code{create-image} will use the
+@code{image-transform-smoothing} user option to say whether scaling
+should be done or not. This option can be @code{nil} (no smoothing),
+@code{t} (use smoothing) or a predicate function that's called with
+the image object as the only parameter, and should return either
+@code{nil} or @code{t}. The default is for down-scaling to apply
+smoothing, and for large up-scaling to not apply smoothing.
+
@item :index @var{frame}
@xref{Multi-Frame Images}.
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 80e038c..448b8ae 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -332,7 +332,6 @@ or just
The built-in function @code{indirect-function} provides an easy way to
perform symbol function indirection explicitly.
-@c Emacs 19 feature
@defun indirect-function function &optional noerror
@anchor{Definition of indirect-function}
This function returns the meaning of @var{function} as a function. If
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 4110c51..2828b50 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -455,7 +455,6 @@ Even though this is not a normal hook, you can use
@code{add-hook} and
@code{remove-hook} to manipulate the list. @xref{Hooks}.
@end defvar
-@c Emacs 19 feature
@defvar write-contents-functions
This works just like @code{write-file-functions}, but it is intended
for hooks that pertain to the buffer's contents, not to the particular
@@ -486,7 +485,6 @@ this hook to make sure the file you are saving has the
current year in
its copyright notice.
@end defopt
-@c Emacs 19 feature
@defopt after-save-hook
This normal hook runs after a buffer has been saved in its visited file.
@end defopt
@@ -622,7 +620,6 @@ If @var{start} is @code{nil}, then the command writes the
entire buffer
contents (@emph{not} just the accessible portion) to the file and
ignores @var{end}.
-@c Emacs 19 feature
If @var{start} is a string, then @code{write-region} writes or appends
that string, rather than text from the buffer. @var{end} is ignored in
this case.
@@ -653,7 +650,6 @@ It also sets the last file modification time for the
current buffer to
feature is used by @code{save-buffer}, but you probably should not use
it yourself.
-@c Emacs 19 feature
If @var{visit} is a string, it specifies the file name to visit. This
way, you can write the data to one file (@var{filename}) while recording
the buffer as visiting another file (@var{visit}). The argument
@@ -3094,7 +3090,6 @@ which generate the listing with Lisp code.
@node Create/Delete Dirs
@section Creating, Copying and Deleting Directories
@cindex creating, copying and deleting directories
-@c Emacs 19 features
Most Emacs Lisp file-manipulation functions get errors when used on
files that are directories. For example, you cannot delete a directory
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 6a227e3..dabf985 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -369,7 +369,6 @@ appear directly as bindings in @var{keymap} are also copied
recursively,
and so on to any number of levels. However, recursive copying does not
take place when the definition of a character is a symbol whose function
definition is a keymap; the same symbol appears in the new copy.
-@c Emacs 19 feature
@example
@group
@@ -1140,7 +1139,6 @@ and have extra events at the end that do not fit into a
single key
sequence. Then the value is a number, the number of events at the front
of @var{key} that compose a complete key.
-@c Emacs 19 feature
If @var{accept-defaults} is non-@code{nil}, then @code{lookup-key}
considers default bindings as well as bindings for the specific events
in @var{key}. Otherwise, @code{lookup-key} reports only bindings for
@@ -1182,7 +1180,6 @@ not cause an error.
This function returns the binding for @var{key} in the current
local keymap, or @code{nil} if it is undefined there.
-@c Emacs 19 feature
The argument @var{accept-defaults} controls checking for default bindings,
as in @code{lookup-key} (above).
@end defun
@@ -1191,12 +1188,10 @@ as in @code{lookup-key} (above).
This function returns the binding for command @var{key} in the
current global keymap, or @code{nil} if it is undefined there.
-@c Emacs 19 feature
The argument @var{accept-defaults} controls checking for default bindings,
as in @code{lookup-key} (above).
@end defun
-@c Emacs 19 feature
@defun minor-mode-key-binding key &optional accept-defaults
This function returns a list of all the active minor mode bindings of
@var{key}. More precisely, it returns an alist of pairs
@@ -1414,7 +1409,6 @@ standard bindings:
@end group
@end smallexample
-@c Emacs 19 feature
If @var{oldmap} is non-@code{nil}, that changes the behavior of
@code{substitute-key-definition}: the bindings in @var{oldmap} determine
which keys to rebind. The rebindings still happen in @var{keymap}, not
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 8c6aeb0..e68a1ef 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -1052,7 +1052,6 @@ rather than replacing that element. @xref{Eval}.
@section Unloading
@cindex unloading packages
-@c Emacs 19 feature
You can discard the functions and variables loaded by a library to
reclaim memory for other Lisp objects. To do this, use the function
@code{unload-feature}:
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index bbc8340..d16409d 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -379,8 +379,6 @@ default, it makes the following bindings:
@end table
@end defvar
-@c In version 18, initial is required
-@c Emacs 19 feature
@defun read-no-blanks-input prompt &optional initial inherit-input-method
This function reads a string from the minibuffer, but does not allow
whitespace characters as part of the input: instead, those characters
@@ -2475,7 +2473,6 @@ usual minibuffer input functions because they all start
by choosing the
minibuffer window according to the selected frame.
@end defun
-@c Emacs 19 feature
@defun window-minibuffer-p &optional window
This function returns @code{t} if @var{window} is a minibuffer window.
@var{window} defaults to the selected window.
@@ -2619,7 +2616,6 @@ when the minibuffer is active, not even if you switch to
another window
to do it.
@end defopt
-@c Emacs 19 feature
If a command name has a property @code{enable-recursive-minibuffers}
that is non-@code{nil}, then the command can use the minibuffer to read
arguments even if it is invoked from the minibuffer. A command can
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index dc0c744..769aeed 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -232,7 +232,6 @@ backward until encountering the front of a word, rather
than forward.
@end deffn
@defopt words-include-escapes
-@c Emacs 19 feature
This variable affects the behavior of @code{forward-word} and
@code{backward-word}, and everything that uses them. If it is
non-@code{nil}, then characters in the escape and character-quote
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 6343817..0ddf3e4 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1696,7 +1696,6 @@ buffer has a buffer-local binding. For example, you
could use
you are in a C or Lisp mode buffer that has a buffer-local value for
this variable.
-@c Emacs 19 feature
The special forms @code{defvar} and @code{defconst} also set the
default value (if they set the variable at all), rather than any
buffer-local value.
@@ -1708,7 +1707,6 @@ this variable. If @var{symbol} is not buffer-local, this
is equivalent
to @code{symbol-value} (@pxref{Accessing Variables}).
@end defun
-@c Emacs 19 feature
@defun default-boundp symbol
The function @code{default-boundp} tells you whether @var{symbol}'s
default value is nonvoid. If @code{(default-boundp 'foo)} returns
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 87d87bf..63d4bf0 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -23,6 +23,8 @@ SHELL = @SHELL@
# of the source tree. This is set by configure's '--srcdir' option.
srcdir=@srcdir@
+top_builddir = @top_builddir@
+
## Where the output files go.
## Note that all the Info targets build the Info files in srcdir.
## There is no provision for Info files to exist in the build directory.
@@ -112,13 +114,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = $(AM_V_GEN)TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
@@ -291,6 +287,7 @@ orgclean:
rm -f ${TEXI_FROM_ORG}
bootstrap-clean maintainer-clean: distclean infoclean orgclean
+ rm -f TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -340,4 +337,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
+
### Makefile ends here
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index 2abde2c..6eff88b 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -370,11 +370,10 @@ On Windows, the @file{.emacs} file may be called
@file{_emacs} for
backward compatibility with DOS and FAT filesystems where filenames
could not start with a dot. Some users prefer to continue using such
a name due to historical problems various Windows tools had in the
-past with file names that begin with a dot. In Emacs 22 and later,
-the init file may also be called @file{.emacs.d/init.el}. Many of the
-other files that are created by lisp packages are now stored in the
-@file{.emacs.d} directory too, so this keeps all your Emacs related
-files in one place.
+past with file names that begin with a dot. The init file may also be
+called @file{.emacs.d/init.el}. Many of the other files that are
+created by Lisp packages are stored in the @file{.emacs.d} directory
+too, which keeps all your Emacs related files in one place.
All the files mentioned above should go in your @env{HOME} directory.
The @env{HOME} directory is determined by following the steps below:
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 4c29976..35a2526 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -160,13 +160,7 @@ Where and how to get Gnus?
@subsubheading Answer
-Gnus is released independent from releases of Emacs. Therefore, the
-version bundled with Emacs might not be up to date (e.g., Gnus 5.9
-bundled with Emacs 21 is outdated).
-You can get the latest released version of Gnus from
-@uref{https://www.gnus.org/dist/gnus.tar.gz}
-or from
-@uref{https://ftp.gnus.org/pub/gnus/gnus.tar.gz}.
+Gnus is bundled with Emacs.
@node FAQ 1-4
@subsubheading Question 1.4
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index fef066d..b6553c8 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -815,7 +815,7 @@ Various
* Undo:: Some actions can be undone.
* Predicate Specifiers:: Specifying predicates.
* Moderation:: What to do if you're a moderator.
-* Image Enhancements:: Modern versions of Emacs can display images.
+* Image Enhancements:: Emacs can display images.
* Fuzzy Matching:: What's the big fuzz?
* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial
email.
* Spam Package:: A package for filtering and processing spam.
@@ -16269,7 +16269,6 @@ Translate all @samp{@key{TAB}} characters into
@samp{@key{SPC}} characters.
@item nnmail-ignore-broken-references
@findex nnmail-ignore-broken-references
-@c @findex nnmail-fix-eudora-headers
@cindex Eudora
@cindex Pegasus
Some mail user agents (e.g., Eudora and Pegasus) produce broken
@@ -16359,9 +16358,8 @@ If you start using any of the mail back ends, they have
the annoying
habit of assuming that you want to read mail with them. This might not
be unreasonable, but it might not be what you want.
-If you set @code{mail-sources} and @code{nnmail-spool-file} to
-@code{nil}, none of the back ends will ever attempt to read incoming
-mail, which should help.
+If you set @code{mail-sources} to @code{nil}, none of the back ends
+will ever attempt to read incoming mail, which should help.
@vindex nnbabyl-get-new-mail
@vindex nnmbox-get-new-mail
@@ -22507,7 +22505,7 @@ to you, using @kbd{G b u} and updating the group will
usually fix this.
* Predicate Specifiers:: Specifying predicates.
* Moderation:: What to do if you're a moderator.
* Fetching a Group:: Starting Gnus just to read a group.
-* Image Enhancements:: Modern versions of Emacs can display images.
+* Image Enhancements:: Emacs can display images.
* Fuzzy Matching:: What's the big fuzz?
* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial
email.
* Spam Package:: A package for filtering and processing spam.
@@ -23670,9 +23668,8 @@ It takes the group name as a parameter.
@node Image Enhancements
@section Image Enhancements
-Emacs 21@footnote{Emacs 21 on MS Windows doesn't
-support images, Emacs 22 does.} and up are able to display pictures and
-stuff, so Gnus has taken advantage of that.
+Emacs is able to display pictures and stuff, so Gnus has taken
+advantage of that.
@menu
* X-Face:: Display a funky, teensy black-and-white image.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 2c9348f..e5e15cd 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -126,6 +126,7 @@ Configuring @value{tramp} for use
* Inline methods:: Inline methods.
* External methods:: External methods.
* GVFS-based methods:: @acronym{GVFS}-based external methods.
+* FUSE-based methods:: @acronym{FUSE}-based external methods.
* Default Method:: Selecting a default method.
* Default User:: Selecting a default user.
* Default Host:: Selecting a default host.
@@ -139,6 +140,7 @@ Configuring @value{tramp} for use
Setting own connection related information.
* Remote programs:: How @value{tramp} finds and uses programs on
the remote host.
* Remote shell setup:: Remote shell setup hints.
+* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
@@ -433,7 +435,7 @@ remote host, when the buffer you call the process from has
a remote
@code{default-directory}.
-@anchor{Quick Start Guide: File name syntax}
+@anchor{Quick Start Guide File name syntax}
@section File name syntax
@cindex file name syntax
@@ -459,7 +461,7 @@ connection methods also support a notation for the port to
be used, in
which case it is written as @code{host#port}.
-@anchor{Quick Start Guide: @option{ssh} and @option{plink} methods}
+@anchor{Quick Start Guide ssh and plink methods}
@section Using @option{ssh} and @option{plink}
@cindex method @option{ssh}
@cindex @option{ssh} method
@@ -478,28 +480,31 @@ an @command{ssh} server:
@file{@trampfn{plink,user@@host,/path/to/file}}.
-@anchor{Quick Start Guide: @option{su}, @option{sudo} and @option{sg} methods}
-@section Using @option{su}, @option{sudo} and @option{sg}
+@anchor{Quick Start Guide su, sudo, doas and sg methods}
+@section Using @option{su}, @option{sudo}, @option{doas} and @option{sg}
@cindex method @option{su}
@cindex @option{su} method
@cindex method @option{sudo}
@cindex @option{sudo} method
+@cindex method @option{doas}
+@cindex @option{doas} method
@cindex method @option{sg}
@cindex @option{sg} method
Sometimes, it is necessary to work on your local host under different
permissions. For this, you can use the @option{su} or @option{sudo}
-connection method. Both methods use @samp{root} as default user name
-and the return value of @code{(system-name)} as default host name.
-Therefore, it is convenient to open a file as
+connection method. On OpenBSD systems, the @option{doas} connection
+method offers the same functionality. These methods use @samp{root}
+as default user name and the return value of @code{(system-name)} as
+default host name. Therefore, it is convenient to open a file as
@file{@trampfn{sudo,,/path/to/file}}.
The method @option{sg} stands for ``switch group''; here the user name
is used as the group to change to. The default host name is the same.
-@anchor{Quick Start Guide: @option{ssh}, @option{plink}, @option{su},
@option{sudo} and @option{sg} methods}
-@section Combining @option{ssh} or @option{plink} with @option{su} or
@option{sudo}
+@anchor{Quick Start Guide Combining ssh, plink, su, sudo and doas methods}
+@section Combining @option{ssh} or @option{plink} with @option{su},
@option{sudo} or @option{doas}
@cindex method @option{ssh}
@cindex @option{ssh} method
@cindex method @option{plink}
@@ -508,18 +513,20 @@ is used as the group to change to. The default host name
is the same.
@cindex @option{su} method
@cindex method @option{sudo}
@cindex @option{sudo} method
+@cindex method @option{doas}
+@cindex @option{doas} method
-If the @option{su} or @option{sudo} option should be performed on
-another host, it can be comnbined with a leading @option{ssh} or
-@option{plink} option. That means that @value{tramp} connects first to
-the other host with non-administrative credentials, and changes to
-administrative credentials on that host afterwards. In a simple case,
-the syntax looks like
+If the @option{su}, @option{sudo} or @option{doas} option should be
+performed on another host, it can be comnbined with a leading
+@option{ssh} or @option{plink} option. That means that @value{tramp}
+connects first to the other host with non-administrative credentials,
+and changes to administrative credentials on that host afterwards. In
+a simple case, the syntax looks like
@file{@value{prefix}ssh@value{postfixhop}user@@host|sudo@value{postfixhop}@value{postfix}/path/to/file}.
@xref{Ad-hoc multi-hops}.
-@anchor{Quick Start Guide: @option{sudoedit} method}
+@anchor{Quick Start Guide sudoedit method}
@section Using @command{sudoedit}
@cindex method @option{sudoedit}
@cindex @option{sudoedit} method
@@ -532,7 +539,7 @@ method, it is restricted to @samp{localhost} only, and it
does not
support external processes.
-@anchor{Quick Start Guide: @option{smb} method}
+@anchor{Quick Start Guide smb method}
@section Using @command{smbclient}
@cindex method @option{smb}
@cindex @option{smb} method
@@ -546,7 +553,7 @@ of the local file name is the share exported by the remote
host,
@samp{path} in this example.
-@anchor{Quick Start Guide: GVFS-based methods}
+@anchor{Quick Start Guide GVFS-based methods}
@section Using @acronym{GVFS}-based methods
@cindex methods, gvfs
@cindex gvfs-based methods
@@ -570,7 +577,7 @@ file system), @file{@trampfn{dav,user@@host,/path/to/file}},
@file{@trampfn{mtp,device,/path/to/file}} (for media devices).
-@anchor{Quick Start Guide: GNOME Online Accounts based methods}
+@anchor{Quick Start Guide GNOME Online Accounts based methods}
@section Using @acronym{GNOME} Online Accounts based methods
@cindex @acronym{GNOME} Online Accounts
@cindex method @option{gdrive}
@@ -590,21 +597,18 @@ account), or
@file{@trampfn{nextcloud,user@@host#8081,/path/to/file}}
(@samp{8081} stands for the port number) for OwnCloud/NextCloud files.
-@anchor{Quick Start Guide: Android}
-@section Using Android
-@cindex method @option{adb}
-@cindex @option{adb} method
-@cindex android
-
-An Android device, which is connected via USB to your local host, can
-be accessed via the @command{adb} command. No user or host name is
-needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}.
-
-
-@anchor{Quick Start Guide: @option{rclone} method}
-@section Using @command{rclone}
+@anchor{Quick Start Guide FUSE-based methods}
+@section Using @acronym{FUSE}-based methods
+@cindex methods, fuse
+@cindex fuse-based methods
@cindex method @option{rclone}
@cindex @option{rclone} method
+@cindex method @option{sshfs}
+@cindex @option{sshfs} method
+
+@acronym{FUSE, Filesystem in Userspace} allows users to mount a
+virtual file system. It is also used by @acronym{GVFS} internally,
+but here we discuss methods which do not use the @acronym{GVFS} API.
A convenient way to access system storages is the @command{rclone}
program. If you have configured a storage in @command{rclone} under a
@@ -612,6 +616,24 @@ name @samp{storage} (for example), you can access it via
the remote
file name syntax @file{@trampfn{rclone,storage,/path/to/file}}. User
names are not needed.
+On local hosts which have installed the @command{sshfs} client for
+mounting a file system based on @command{sftp}, this method can be
+used. All remote files are available via the local mount point.
+@value{tramp} aids in mounting the file system if it isn't mounted
+yet, and it supports the access with the usual file name syntax
+@file{@trampfn{sshfs,user@@host,/path/to/file}}.
+
+
+@anchor{Quick Start Guide Android}
+@section Using Android
+@cindex method @option{adb}
+@cindex @option{adb} method
+@cindex android
+
+An Android device, which is connected via USB to your local host, can
+be accessed via the @command{adb} command. No user or host name is
+needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}.
+
@node Configuration
@chapter Configuring @value{tramp}
@@ -650,6 +672,7 @@ may be used in your init file:
* Inline methods:: Inline methods.
* External methods:: External methods.
* GVFS-based methods:: @acronym{GVFS}-based external methods.
+* FUSE-based methods:: @acronym{FUSE}-based external methods.
* Default Method:: Selecting a default method.
Here we also try to help those who
don't have the foggiest which method
@@ -666,6 +689,7 @@ may be used in your init file:
Setting own connection related information.
* Remote programs:: How @value{tramp} finds and uses programs on
the remote host.
* Remote shell setup:: Remote shell setup hints.
+* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
@@ -1110,7 +1134,6 @@ UNC file name specification does not allow the
specification of a
different user name for authentication like the @command{smbclient}
can.
-
@item @option{adb}
@cindex method @option{adb}
@cindex @option{adb} method
@@ -1150,45 +1173,6 @@ specified using @file{device#42} host name syntax or
@value{tramp} can
use the default value as declared in @command{adb} command. Port
numbers are not applicable to Android devices connected through USB@.
-
-@item @option{rclone}
-@cindex method @option{rclone}
-@cindex @option{rclone} method
-
-@vindex tramp-rclone-program
-The program @command{rclone} allows to access different system
-storages in the cloud, see @url{https://rclone.org/} for a list of
-supported systems. If the @command{rclone} program isn't found in
-your @env{PATH} environment variable, you can tell @value{tramp} its
-absolute path via the user option @code{tramp-rclone-program}.
-
-A system storage must be configured via the @command{rclone config}
-command, outside Emacs. If you have configured a storage in
-@command{rclone} under a name @samp{storage} (for example), you could
-access it via the remote file name
-
-@example
-@trampfn{rclone,storage,/path/to/file}
-@end example
-
-User names are part of the @command{rclone} configuration, and not
-needed in the remote file name. If a user name is contained in the
-remote file name, it is ignored.
-
-Internally, @value{tramp} mounts the remote system storage at location
-@file{/tmp/tramp.rclone.storage}, with @file{storage} being the name
-of the configured system storage.
-
-Optional flags to the different @option{rclone} operations could be
-passed as connection property, @xref{Predefined connection
-information}. Supported properties are @t{"mount-args"},
-@t{"copyto-args"}, @t{"moveto-args"} and @t{"about-args"}.
-
-Access via @option{rclone} is slow. If you have an alternative method
-for accessing the system storage, you should use it.
-@ref{GVFS-based methods} for example, methods @option{gdrive} and
-@option{nextcloud}.
-
@end table
@@ -1200,8 +1184,8 @@ for accessing the system storage, you should use it.
@acronym{GVFS} is the virtual file system for the @acronym{GNOME}
Desktop, @uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on
-@acronym{GVFS} are mounted locally through FUSE and @value{tramp} uses
-this locally mounted directory internally.
+@acronym{GVFS} are mounted locally through @acronym{FUSE} and
+@value{tramp} uses this locally mounted directory internally.
Emacs uses the D-Bus mechanism to communicate with @acronym{GVFS}@.
Emacs must have the message bus system, D-Bus integration active,
@@ -1317,6 +1301,88 @@ respectively:
@end defopt
+@node FUSE-based methods
+@section @acronym{FUSE}-based external methods
+@cindex methods, fuse
+@cindex fuse-based methods
+
+Besides @acronym{GVFS}, there are other virtual file systems using the
+@acronym{FUSE} interface. Remote files are mounted locally through
+@acronym{FUSE} and @value{tramp} uses this locally mounted directory
+internally. When possible, @value{tramp} maps the remote file names
+to their respective local file name, and applies the file name
+operation on them. For some of the file name operations this is not
+possible, @value{tramp} emulates those operations otherwise.
+
+@table @asis
+@item @option{rclone}
+@cindex method @option{rclone}
+@cindex @option{rclone} method
+
+@vindex tramp-rclone-program
+The program @command{rclone} allows to access different system
+storages in the cloud, see @url{https://rclone.org/} for a list of
+supported systems. If the @command{rclone} program isn't found in
+your @env{PATH} environment variable, you can tell @value{tramp} its
+absolute path via the user option @code{tramp-rclone-program}.
+
+A system storage must be configured via the @command{rclone config}
+command, outside Emacs. If you have configured a storage in
+@command{rclone} under a name @samp{storage} (for example), you could
+access it via the remote file name
+
+@example
+@trampfn{rclone,storage,/path/to/file}
+@end example
+
+User names are part of the @command{rclone} configuration, and not
+needed in the remote file name. If a user name is contained in the
+remote file name, it is ignored.
+
+Internally, @value{tramp} mounts the remote system storage at location
+@file{/tmp/tramp.rclone.storage}, with @file{storage} being the name
+of the configured system storage.
+
+The mount point and optional flags to the different @option{rclone}
+operations could be passed as connection properties, @xref{Setup of
+rclone method}.
+
+Access via @option{rclone} is slow. If you have an alternative method
+for accessing the system storage, you should use it.
+@ref{GVFS-based methods} for example, methods @option{gdrive} and
+@option{nextcloud}.
+
+@item @option{sshfs}
+@cindex method @option{sshfs}
+@cindex @option{sshfs} method
+
+@vindex tramp-sshfs-program
+On local hosts which have installed the @command{sshfs} client for
+mounting a file system based on @command{sftp}, this method can be
+used, see
+@url{https://github.com/libfuse/sshfs/blob/master/README.rst/}. If
+the @command{sshfs} program isn't found in your @env{PATH} environment
+variable, you can tell @value{tramp} its absolute path via the user
+option @code{tramp-sshfs-program}.
+
+All remote files are available via the local mount point.
+@value{tramp} aids in mounting the file system if it isn't mounted
+yet. The remote file name syntax is
+
+@example
+@trampfn{sshfs,user@@host#port,/path/to/file}
+@end example
+
+User name and port number are optional. This method does not support
+password handling, the file system must either be mounted already, or
+the connection must be established passwordless via ssh keys.
+
+The mount point and mount arguments could be passed as connection
+properties, @xref{Setup of sshfs method}.
+
+@end table
+
+
@node Default Method
@section Selecting a default method
@cindex default method
@@ -2102,6 +2168,13 @@ The default value of this property is @code{t} (not
specified in
@code{tramp-methods}). If the remote host runs native MS Windows,
this propery has no effect.
+@item @t{"mount-point"}
+
+The directory file name an @acronym{FUSE}-based file system is mounted
+on. The default value of this property is
+@t{"/tmp/tramp.method.user@@host#port"} (not specified in
+@code{tramp-methods}).
+
@item @t{"mount-args"}@*
@t{"copyto-args"}@*
@t{"moveto-args"}@*
@@ -2430,7 +2503,6 @@ match the end of the connection buffer. Due to
performance reasons,
this search starts at the end of the buffer, and it is limited to 256
characters backwards.
-
@item Conflicting names for users and variables in @file{.profile}
When a user name is the same as a variable name in a local file, such
@@ -2440,7 +2512,6 @@ variable name to something different from the user name.
For example,
if the user name is @env{FRUMPLE}, then change the variable name to
@env{FRUMPLE_DIR}.
-
@item Non-Bourne commands in @file{.profile}
When the remote host's @file{.profile} is also used for shells other
@@ -2465,7 +2536,6 @@ To accommodate using non-Bourne shells on that remote,
use other
shell-specific config files. For example, bash can use
@file{~/.bash_profile} and ignore @file{.profile}.
-
@item Interactive shell prompt
@vindex INSIDE_EMACS@r{, environment variable}
@@ -2533,6 +2603,60 @@ where @samp{192.168.0.1} is the remote host IP address
@end table
+@node FUSE setup
+@section @acronym{FUSE} setup hints
+
+The @acronym{FUSE} file systems are mounted per default at
+@file{/tmp/tramp.method.user@@host#port}. The user name and port
+number are optional. If the file system is already mounted, it will
+be used as it is. If the mount point does not exist yet,
+@value{tramp} creates this directory.
+
+The mount point can be overwritten by the connection property
+@t{"mount-point"}, @ref{Predefined connection information}.
+Example:
+
+@lisp
+@group
+(add-to-list 'tramp-connection-properties
+ `(,(regexp-quote "@trampfn{sshfs,user@@host,}")
+ "mount-point"
+ ,(expand-file-name "sshfs.user@@host" user-emacs-directory)))
+@end group
+@end lisp
+
+
+@anchor{Setup of rclone method}
+@subsection @option{rclone} setup
+@cindex rclone setup
+
+The default arguments of the @command{rclone} operations
+@command{mount}, @command{coopyto}, @command{moveto} and
+@command{about} are declared in the variable @code{tramp-methods} as
+method specific parameters. Usually, they don't need to be overwritten.
+
+If needed, these parameters can be overwritten as connection
+properties @t{"mount-args"}, @t{"copyto-args"}, @t{"moveto-args"} and
+@t{"about-args"}, @xref{Predefined connection information}. All of
+them are list of strings.
+
+Be careful changing @t{"--dir-cache-time"}, this could delay
+visibility of files.
+
+
+@anchor{Setup of sshfs method}
+@subsection @option{sshfs} setup
+@cindex sshfs setup
+
+The method @option{sshfs} declares the mount arguments in the variable
+@code{tramp-methods}, passed to the @command{sshfs} command. This is
+a list of list of strings, and can be overwritten by the connection
+property @t{"mount-args"}, @xref{Predefined connection information}.
+
+Additionally. it declares also the arguments for running remote
+processes, using the @command{ssh} command. These don't need to be
+changed.
+
@node Android shell setup
@section Android shell setup hints
@cindex android shell setup for ssh
@@ -4197,6 +4321,7 @@ Disable excessive traces. Set @code{tramp-verbose} to 3
or lower,
default being 3. Increase trace levels temporarily when hunting for
bugs.
+
@item
@value{tramp} does not connect to the remote host
@@ -4448,6 +4573,7 @@ disable @samp{--color=yes} or @samp{--color=auto} in the
remote host's
@file{.bashrc} or @file{.profile}. Turn this alias on and off to see
if file name completion works.
+
@item
File name completion does not work in directories with large number of
files
@@ -4846,6 +4972,7 @@ In BBDB buffer, access an entry by pressing the key
@kbd{F}.
Thanks to @value{tramp} users for contributing to these recipes.
+
@item
Why saved multi-hop file names do not work in a new Emacs session?
diff --git a/etc/NEWS b/etc/NEWS
index 2984c6e..86fa1ef 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -29,7 +29,7 @@ To enable, configure Emacs with the
'--with-native-compilation' option
to the 'configure' script. This requires to have the libgccjit
library to be installed and functional.
---
+---
** Support for building with Motif has been removed.
** Cairo graphics library is now used by default if found.
@@ -74,8 +74,7 @@ It was declared obsolete in Emacs 27.1.
---
** The configure option '--without-makeinfo' has been removed.
This was only ever relevant when building from a repository checkout.
-Please install makeinfo, or if all else fails run 'make lisp' instead
-of 'make [all]'.
+This now requires makeinfo, which is part of the texinfo package.
---
** Support for building with '-fcheck-pointer-bounds' has been removed.
@@ -271,8 +270,8 @@ current mode.
+++
** New user option 'read-extended-command-predicate'.
-This option controls how 'M-x' performs completion of commands when
-you type TAB. By default, any command that matches what you have
+This user option controls how 'M-x' performs completion of commands when
+you type 'TAB'. By default, any command that matches what you have
typed is considered a completion candidate, but you can customize this
option to exclude commands that are not applicable to the current
buffer's major and minor modes, and respect the command's completion
@@ -374,16 +373,16 @@ Typing 'TAB' on a heading line cycles the current section
between
anywhere in the buffer cycles the whole buffer between "only top-level
headings", "all headings and subheadings", and "show all" states.
-*** New minor mode 'outline-cycle-minor-mode'.
-This mode is a variant of 'outline-minor-mode', with the difference
+*** New user option 'outline-minor-mode-cycle'.
+This user option customizes 'outline-minor-mode', with the difference
that 'TAB' and 'S-TAB' on heading lines cycle heading visibility.
Typing 'TAB' on a heading line cycles the current section between
"hide all", "subheadings", and "show all" states. Typing 'S-TAB' on a
heading line cycles the whole buffer between "only top-level
headings", "all headings and subheadings", and "show all" states.
-*** New minor mode 'outline-cycle-highlight-minor-mode'.
-This mode is a variant of 'outline-cycle-minor-mode'. It puts
+*** New user option 'outline-minor-mode-highlight'.
+This user option customizes 'outline-minor-mode'. It puts
highlighting on heading lines using standard outline faces. This
works well only when there are no conflicts with faces used by the
major mode.
@@ -393,7 +392,7 @@ major mode.
** Macroexp
---
-*** New function 'macroexp-file-name' to know the name of the current file
+*** New function 'macroexp-file-name' to know the name of the current file.
---
*** New function 'macroexp-compiling-p' to know if we're compiling.
---
@@ -406,17 +405,18 @@ It used to be enabled when Emacs is started in GUI mode
but not when started
in text mode. The cursor still only actually blinks in GUI frames.
** Bindat
+
+++
*** New 'Bindat type expression' description language.
This new system is provided by the new macro 'bindat-type' and
obsoletes the old data layout specifications. It supports
arbitrary-size integers, recursive types, and more. See the Info node
-'Byte Packing' in the ELisp manual for more details.
+"(elisp) Byte Packing" in the ELisp manual for more details.
** pcase
+++
-*** The 'or' pattern now binds the union of the vars of its sub-patterns
+*** The 'or' pattern now binds the union of the vars of its sub-patterns.
If a variable is not bound by the subpattern that matched, it gets bound
to nil. This was already sometimes the case, but it is now guaranteed.
@@ -546,6 +546,10 @@ It also supports a negative argument.
It also supports a negative argument.
---
+*** 'C-x t G' assigns a group name to the tab.
+'tab-close-group' can close all tabs that belong to the selected group.
+
+---
*** New user option 'tab-bar-tab-name-format-function'.
---
@@ -926,6 +930,15 @@ skipped.
** Help
---
+*** Keybindings in 'help-mode' use the new 'help-key-binding' face.
+This face is added by 'substitute-command-keys' to any "\[command]"
+substitution. The return value of that function should consequently
+be assumed to be a propertized string.
+
+Note that the new face will also be used in tooltips. When using the
+GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t.
+
+---
*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation.
+++
@@ -1028,10 +1041,9 @@ To customize obsolete user options, use
'customize-option' or
** Edebug
----
*** Obsoletions
+---
**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
-
+++
**** The spec operator ':name NAME' is obsolete, use '&name' instead.
+++
@@ -1063,7 +1075,7 @@ use) and HEAD is the code that matched SPEC.
+++
*** New user option 'eldoc-echo-area-display-truncation-message'.
If non-nil (the default), eldoc will display a message saying
-something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
+something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
to see rest)" when a message has been truncated. If nil, truncated
messages will be marked with just "..." at the end.
@@ -1132,6 +1144,10 @@ preferred over the eudcb-mab.el backend.
like cell phones, tablets or cameras.
+++
+*** New connection method "sshfs", which allows accessing remote files
+via a file system mounted with 'sshfs'.
+
++++
*** Trashed remote files are moved to the local trash directory.
All remote files, which are trashed, are moved to the local trash
directory. Except remote encrypted files, which are always deleted.
@@ -1438,9 +1454,9 @@ decaying average of delays, and if this number gets too
high, the
animation is stopped.
+++
-*** The 'n' and 'p' commands (next/previous image) now respects dired order.
+*** The 'n' and 'p' commands (next/previous image) now respect Dired order.
These commands would previously display the next/previous image in
-alphabetical order, but will now find the "parent" dired buffer and
+lexicographic order, but will now find the "parent" Dired buffer and
select the next/previous image file according to how the files are
sorted there. The commands have also been extended to work when the
"parent" buffer is an archive mode (i.e., zip file or the like) or tar
@@ -1470,6 +1486,22 @@ To load images with the default frame colors use the
':foreground' and
This change only affects image types that support foreground and
background colors or transparency, such as xbm, pbm, svg, png and gif.
++++
+*** Image smoothing can now be explicitly enabled or disabled.
+Smoothing applies a bilinear filter while scaling or rotating an image
+to prevent aliasing and other unwanted effects. The new image
+property ':transform-smoothing' can be set to t to force smoothing
+and nil to disable smoothing.
+
+The default behaviour of smoothing on down-scaling and not smoothing
+on up-scaling remains unchanged.
+
++++
+*** New user option 'image-transform-smoothing'.
+This controls whether to use smoothing or not for an image. Values
+include nil (no smoothing), t (do smoothing) or a predicate function
+that's called with the image object and should return nil/t.
+
** EWW
+++
@@ -1560,7 +1592,7 @@ have been renamed to have "proper" public names and
documented
'xref-show-definitions-buffer-at-bottom').
*** New command 'xref-quit-and-pop-marker-stack' and a binding for it
-in "*xref*" buffers ('M-,'). This combination is easy to press
+in "*xref*" buffers ('M-,'). This combination is easy to press
semi-accidentally if the user wants to go back in the middle of
choosing the exact definition to go to, and this should do TRT.
@@ -2143,7 +2175,7 @@ messages, contain the error name of that message now.
+++
*** D-Bus events have changed their internal structure.
They carry now the destination and the error-name of an event. They
-also keep the type information of their arguments. Use the
+also keep the type information of their arguments. Use the
'dbus-event-*' accessor functions.
** CPerl Mode
@@ -2185,7 +2217,7 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo
many changes,
'C-x { { } } ^ ^ v v' to resize the selected window interactively,
'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).
+defines an additional key to exit mode like 'isearch-exit' ('RET').
* New Modes and Packages in Emacs 28.1
@@ -2301,7 +2333,7 @@ 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
+The user option 'generic-extras-enable-list' is now obsolete, and
setting it has no effect.
---
@@ -2348,18 +2380,21 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'dirtrack-debug-toggle', 'dynamic-completion-table',
'easy-menu-precalculate-equivalent-keybindings',
'epa-display-verify-result', 'epg-passphrase-callback-function',
-'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark',
-'ffap-bug', 'ffap-submit-bug', 'ffap-version',
-'file-cache-choose-completion', 'forward-point', 'generic-char-p',
-'global-highlight-changes', 'hi-lock-face-history',
-'hi-lock-regexp-history', 'highlight-changes-active-string',
-'highlight-changes-initial-state', 'highlight-changes-passive-string',
-'image-mode-maybe', 'imenu-example--name-and-position',
-'ispell-aspell-supports-utf8', 'lisp-mode-auto-fill',
-'locate-file-completion', 'make-coding-system',
+'erc-announced-server-name', 'erc-default-coding-system',
+'erc-process', 'erc-send-command', 'eshell-report-bug',
+'eval-next-after-load', 'exchange-dot-and-mark', 'ffap-bug',
+'ffap-submit-bug', 'ffap-version', 'file-cache-choose-completion',
+'forward-point', 'generic-char-p', 'global-highlight-changes',
+'hi-lock-face-history', 'hi-lock-regexp-history',
+'highlight-changes-active-string', 'highlight-changes-initial-state',
+'highlight-changes-passive-string',
+'icalendar--datetime-to-noneuropean-date', 'image-mode-maybe',
+'imenu-example--name-and-position', 'ispell-aspell-supports-utf8',
+'lisp-mode-auto-fill', 'locate-file-completion', 'make-coding-system',
'minibuffer-local-must-match-filename-map', 'mouse-choose-completion',
'mouse-major-mode-menu', 'mouse-popup-menubar',
'mouse-popup-menubar-stuff', 'newsticker-groups-filename',
+'nnir-swish-e-index-file', 'nnmail-fix-eudora-headers',
'non-iso-charset-alist', 'nonascii-insert-offset',
'nonascii-translation-table', 'password-read-and-add',
'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message',
@@ -2392,7 +2427,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'semantic-token-type-parent', 'semantic-toplevel-bovine-cache',
'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks',
'set-coding-priority', 'set-process-filter-multibyte',
-'shadows-compare-text-p', 'shell-dirtrack-toggle', 't-mouse-mode',
+'shadows-compare-text-p', 'shell-dirtrack-toggle',
+'speedbar-navigating-speed', 'speedbar-update-speed', 't-mouse-mode',
'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell',
'url-generate-unique-filename', 'url-temporary-directory',
'vc-arch-command', 'vc-default-working-revision' (variable),
@@ -2400,6 +2436,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
'wisent-lex-make-token-table'.
+---
+** Some functions and variables obsolete since Emacs 22 have been removed:
+'gnus-article-hide-pgp-hook', 'gnus-inews-mark-gcc-as-read',
+'gnus-treat-display-xface', 'gnus-treat-strip-pgp',
+'nnmail-spool-file'.
+
** The WHEN argument of 'make-obsolete' and related functions is mandatory.
The use of those functions without a WHEN argument was marked obsolete
back in Emacs 23.1. The affected functions are: 'make-obsolete',
@@ -2408,6 +2450,8 @@ back in Emacs 23.1. The affected functions are:
'make-obsolete',
** The variable 'keyboard-type' is obsolete and not dynamically scoped any
more.
+** The 'values' variable is now obsolete.
+
* Lisp Changes in Emacs 28.1
@@ -2444,13 +2488,13 @@ This variable holds a list of currently enabled global
minor modes (as
a list of symbols).
+++
-** 'define-minor-mode' now takes an :interactive argument.
+** 'define-minor-mode' now takes an ':interactive' argument.
This can be used for specifying which modes this minor mode is meant
for, or to make the new minor mode non-interactive. The default value
is t.
+++
-** 'define-derived-mode' now takes an :interactive argument.
+** 'define-derived-mode' now takes an ':interactive' argument.
This can be used to control whether the defined mode is a command
or not, and is useful when defining commands that aren't meant to be
used by users directly.
@@ -2458,8 +2502,6 @@ used by users directly.
---
** The 'easymenu' library is now preloaded.
-** The 'values' variable is now obsolete.
-
---
** New variable 'indent-line-ignored-functions'.
This allows modes to cycle through a set of indentation functions
@@ -2490,10 +2532,11 @@ When non-nil, then functions 'read-char-choice' and
'y-or-n-p' (respectively)
use the function 'read-key' to read a character instead of using the
minibuffer.
---
-** New variable 'use-short-answers' to use 'y-or-n-p' instead of 'yes-or-no-p'.
-This eliminates the need to define an alias that maps one to another
-in the init file. The same variable also controls whether the
-function 'read-answer' accepts short answers.
+** New user option 'use-short-answers'.
+When non-nil, the function 'y-or-n-p' is used instead of
+'yes-or-no-p'. This eliminates the need to define an alias that maps
+one to another in the init file. The same user option also controls
+whether the function 'read-answer' accepts short answers.
+++
** 'set-window-configuration' now takes an optional 'dont-set-frame'
@@ -2695,7 +2738,7 @@ menu handling.
It is meant as an (experimental) aid for converting Emacs Lisp code
to lexical binding, where dynamic (special) variables bound in one
file can affect code in another. For details, see the manual section
-"(Elisp) Converting to Lexical Binding".
+"(elisp) Converting to Lexical Binding".
+++
*** 'byte-recompile-directory' can now compile symlinked ".el" files.
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 05c0464..01d4df1b0 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -696,5 +696,7 @@ COPYING PERMISSIONS:
;;; Local Variables:
;;; outline-regexp: "\\*\\_>"
-;;; eval: (outline-cycle-highlight-minor-mode)
+;;; outline-minor-mode-cycle: t
+;;; outline-minor-mode-highlight: t
+;;; eval: (outline-minor-mode 1)
;;; End:
diff --git a/etc/grep.txt b/etc/grep.txt
index a54ebf8..0370ae4 100644
--- a/etc/grep.txt
+++ b/etc/grep.txt
@@ -125,5 +125,7 @@ COPYING PERMISSIONS:
;;; Local Variables:
;;; eval: (let ((inhibit-read-only t) (compilation-filter-start (point-min)))
(save-excursion (goto-char (point-max)) (grep-filter) (set-buffer-modified-p
nil)))
;;; buffer-read-only: t
-;;; eval: (outline-cycle-highlight-minor-mode)
+;;; outline-minor-mode-cycle: t
+;;; outline-minor-mode-highlight: t
+;;; eval: (outline-minor-mode 1)
;;; End:
diff --git a/leim/Makefile.in b/leim/Makefile.in
index f3e530a..c2f9cf5 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -25,24 +25,14 @@ SHELL = @SHELL@
# Here are the things that we expect ../configure to edit.
srcdir=@srcdir@
+top_builddir = @top_builddir@
# Where the generated files go.
leimdir = ${srcdir}/../lisp/leim
EXEEXT = @EXEEXT@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 0a6dd82..05eb524 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -44,33 +44,8 @@ WERROR_CFLAGS = @WERROR_CFLAGS@
# Program name transformation.
TRANSFORM = @program_transform_name@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_RC = $(am__v_RC_@AM_V@)
-am__v_RC_ = $(am__v_RC_@AM_DEFAULT_V@)
-am__v_RC_0 = @echo " RC " $@;
-am__v_RC_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+top_builddir = @top_builddir@
+-include ${top_builddir}/src/verbose.mk
# ==================== Where To Install Things ====================
diff --git a/lib/Makefile.in b/lib/Makefile.in
index be398d1..68a0247 100644
--- a/lib/Makefile.in
+++ b/lib/Makefile.in
@@ -29,26 +29,7 @@ top_srcdir = @top_srcdir@
all:
.PHONY: all
-# 'make' verbosity.
-AM_V_AR = $(am__v_AR_@AM_V@)
-am__v_AR_ = $(am__v_AR_@AM_DEFAULT_V@)
-am__v_AR_0 = @echo " AR " $@;
-am__v_AR_1 =
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 94de546..c926648 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -21,6 +21,7 @@ SHELL = @SHELL@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
lisp = $(srcdir)
VPATH = $(srcdir)
EXEEXT = @EXEEXT@
@@ -29,37 +30,14 @@ EXEEXT = @EXEEXT@
# limitation.
XARGS_LIMIT = @XARGS_LIMIT@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
-
-AM_V_ELC = $(am__v_ELC_@AM_V@)
-am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
ifeq ($(HAVE_NATIVE_COMP),yes)
-ifeq ($(NATIVE_DISABLED),1)
-am__v_ELC_0 = @echo " ELC " $@;
-else
-am__v_ELC_0 = @echo " ELC+ELN " $@;
-endif
ifndef NATIVE_FULL_AOT
NATIVE_SKIP_NONDUMP = 1
endif
-else
-am__v_ELC_0 = @echo " ELC " $@;
endif
-am__v_ELC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
FIND_DELETE = @FIND_DELETE@
diff --git a/lisp/align.el b/lisp/align.el
index 1a1d3dd..7ae067f 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1310,7 +1310,7 @@ aligner would have dealt with are."
(thissep (if rulesep (cdr rulesep) separate))
same (eol 0)
search-start
- groups group-c
+ groups ;; group-c
spacing spacing-c
tab-stop tab-stop-c
repeat repeat-c
@@ -1434,7 +1434,7 @@ aligner would have dealt with are."
;; lookup the `group' attribute the first time
;; that we need it
- (unless group-c
+ (unless nil ;; group-c
(setq groups (or (cdr (assq 'group rule)) 1))
(unless (listp groups)
(setq groups (list groups)))
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 6c9ceb0..83c5161 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -660,11 +660,11 @@ Does not signal an error if optional argument NOERROR is
non-nil."
(defun archive-mode (&optional force)
"Major mode for viewing an archive file in a dired-like way.
You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the archive and into its own buffer;
+Letters no longer insert themselves.\\<archive-mode-map>
+Type \\[archive-extract] to pull a file out of the archive and into its own
buffer;
or click mouse-2 on the file's line in the archive mode buffer.
-If you edit a sub-file of this archive (as with the `e' command) and
+If you edit a sub-file of this archive (as with the \\[archive-extract]
command) and
save it, the contents of that buffer will be saved back into the
archive.
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 14cae8a..2516b4b 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -162,7 +162,7 @@ let-binding."
(defvar auth-source-creation-prompts nil
"Default prompts for token values. Usually let-bound.")
-(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
+(make-obsolete 'auth-source-hide-passwords nil "24.1")
(defcustom auth-source-save-behavior 'ask
"If set, auth-source will respect it for save behavior."
@@ -2307,9 +2307,9 @@ See `auth-source-search' for details on SPEC."
;; deprecate the old interface
(make-obsolete 'auth-source-user-or-password
- 'auth-source-search "Emacs 24.1")
+ 'auth-source-search "24.1")
(make-obsolete 'auth-source-forget-user-or-password
- 'auth-source-forget "Emacs 24.1")
+ 'auth-source-forget "24.1")
(defun auth-source-user-or-password
(mode host port &optional username create-missing delete-existing)
diff --git a/lisp/button.el b/lisp/button.el
index 043de8e..69d7054 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -472,8 +472,8 @@ mouse event is used.
If there's no button at POS, do nothing and return nil, otherwise
return t.
-To get a description of what function will called when pushing a
-butting, use the `button-describe' command."
+To get a description of the function that will be invoked when
+pushing a button, use the `button-describe' command."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
(if (and (not (integerp pos)) (eventp pos))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index e5f0523..762adbd 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -639,7 +639,7 @@ Interactively, reads the register using
`register-read-with-preview'."
(calc-slow-wrapper
(when (eq n 0)
(setq n (calc-stack-size)))
- (let* ((flag nil)
+ (let* (;; (flag nil)
(allow-ret (> n 1))
(list (math-showing-full-precision
(mapcar (if (> n 1)
@@ -651,7 +651,8 @@ Interactively, reads the register using
`register-read-with-preview'."
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))
- (calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n)))
allow-ret)
+ (calc--edit-mode (lambda () (calc-finish-stack-edit n)) ;; (or flag n)
+ allow-ret)
(while list
(insert (car list) "\n")
(setq list (cdr list)))))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 0088398..6dd8d9a 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -291,7 +291,7 @@ user-defined operators, use `calculator-user-operators'
instead.")
5. The function's precedence -- should be in the range of 1 (lowest) to
9 (highest) (optional, defaults to 1);
-It it possible have a unary prefix version of a binary operator if it
+It is possible have a unary prefix version of a binary operator if it
comes later in this list. If the list begins with the symbol `nobind',
then no key binding will take place -- this is only used for predefined
keys.
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index dafdd41..8f4dbf0 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -773,9 +773,6 @@ American format: \"month day year\"."
;; datetime == nil
nil))
-(define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
- 'icalendar--datetime-to-american-date "icalendar 0.19")
-
(defun icalendar--datetime-to-european-date (datetime &optional separator)
"Convert the decoded DATETIME to European format.
Optional argument SEPARATOR gives the separator between month,
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 0daa153..dab468d 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -2279,7 +2279,7 @@ made in the number or names of categories."
(inc (prefix-numeric-value inc))
(buffer-read-only nil)
ndate ntime
- year monthname month day dayname)
+ year monthname month day) ;; dayname
(when marked (todo--user-error-if-marked-done-item))
(save-excursion
(or (and marked (goto-char (point-min))) (todo-item-start))
@@ -2437,7 +2437,7 @@ made in the number or names of categories."
(monthname monthname)
(month month)
(day day)
- (dayname dayname))
+ (dayname nil)) ;; dayname
(mapconcat #'eval calendar-date-display-form "")))))
(when ndate (replace-match ndate nil nil nil 1))
;; Add new time string to the header, if it was supplied.
@@ -3450,8 +3450,8 @@ containing only archived items, provided user option
are shown in `todo-archived-only' face."
(interactive)
(todo-display-categories)
- (let (sortkey)
- (todo-update-categories-display sortkey)))
+ ;; (let (sortkey)
+ (todo-update-categories-display nil)) ;; sortkey
(defun todo-next-button (n)
"Move point to the Nth next button in the table of categories."
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index e1fe856..47bb0c6 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -428,11 +428,11 @@ sources variable."
(let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default)))
- (conf-done nil)
+ ;; (conf-done nil)
)
;; Add in all variables from the configuration not already covered.
(mapc (lambda (c)
- (if (member (car c) conf-done)
+ (if nil ;; (member (car c) conf-done)
nil
(insert (car c) "=" (cdr c) "\n")))
conf-table))
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index d676c57..258917f 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -596,10 +596,8 @@ Strip out duplicates, and recurse on variables."
(project-am-expand-subdirlist
place (makefile-macro-file-list var))
;; Else, add SP in if it isn't a dup.
- (if (member sp (symbol-value place))
- nil ; don't do it twice.
- (set place (cons sp (symbol-value place))) ;; add
- ))))
+ (cl-pushnew sp (gv-deref place) :test #'equal) ;; add
+ )))
subdirs)
)
@@ -645,7 +643,7 @@ Strip out duplicates, and recurse on variables."
;; We still have a list of targets. For all buffers, make sure
;; their object still exists!
;; FIGURE THIS OUT
- (project-am-expand-subdirlist 'csubprojexpanded csubproj)
+ (project-am-expand-subdirlist (gv-ref csubprojexpanded) csubproj)
;; Ok, now let's look at all our sub-projects.
(mapc (lambda (sp)
(let* ((subdir (file-name-as-directory
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index b585e38..6be6dfd 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -41,7 +41,7 @@
;;; Variables
;;
-(defvar-local semantic-bovinate-nonterminal-check-obarray nil
+(defvar-local semantic-bovinate-nonterminal-check-map nil
"Obarray of streams already parsed for nonterminal symbols.
Use this to detect infinite recursion during a parse.")
@@ -79,21 +79,18 @@ environment of `semantic-bovinate-stream'."
(defun semantic-bovinate-nonterminal-check (stream nonterminal)
"Check if STREAM not already parsed for NONTERMINAL.
If so abort because an infinite recursive parse is suspected."
- (or (vectorp semantic-bovinate-nonterminal-check-obarray)
- (setq semantic-bovinate-nonterminal-check-obarray
- (make-vector 13 nil)))
- (let* ((nt (symbol-name nonterminal))
- (vs (symbol-value
- (intern-soft
- nt semantic-bovinate-nonterminal-check-obarray))))
+ (or (hash-table-p semantic-bovinate-nonterminal-check-map)
+ (setq semantic-bovinate-nonterminal-check-map
+ (make-hash-table :test #'eq)))
+ (let* ((vs (gethash nonterminal semantic-bovinate-nonterminal-check-map)))
(if (memq stream vs)
;; Always enter debugger to see the backtrace
(let ((debug-on-signal t)
(debug-on-error t))
- (setq semantic-bovinate-nonterminal-check-obarray nil)
- (error "Infinite recursive parse suspected on %s" nt))
- (set (intern nt semantic-bovinate-nonterminal-check-obarray)
- (cons stream vs)))))
+ (setq semantic-bovinate-nonterminal-check-map nil)
+ (error "Infinite recursive parse suspected on %s" nonterminal))
+ (push stream
+ (gethash nonterminal semantic-bovinate-nonterminal-check-map)))))
;;;###autoload
(defun semantic-bovinate-stream (stream &optional nonterminal)
@@ -110,6 +107,9 @@ list of semantic tokens found."
(or semantic--buffer-cache
(semantic-bovinate-nonterminal-check stream nonterminal))
+ ;; FIXME: `semantic-parse-region-c-mode' inspects `lse' to try and
+ ;; detect a recursive call (used with macroexpansion, to avoid inf-loops).
+ (with-suppressed-warnings ((lexical lse)) (defvar lse))
(let* ((table semantic--parse-table)
(matchlist (cdr (assq nonterminal table)))
(starting-stream stream)
@@ -216,7 +216,8 @@ list of semantic tokens found."
(setq cvl (cons
(if (memq (semantic-lex-token-class lse)
'(comment semantic-list))
- valdot val) cvl))) ;append
unchecked value.
+ valdot val)
+ cvl))) ;append unchecked value.
(setq end (semantic-lex-token-end lse))
)
(setq lte nil cvl nil)) ;No more matches, exit
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index fb55139..5712f9b 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/c.el --- Semantic details for C
+;;; semantic/bovine/c.el --- Semantic details for C -*- lexical-binding: t;
-*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -114,7 +114,8 @@ part of the preprocessor map.")
"Reset the C preprocessor symbol map based on all input variables."
(when (and semantic-mode
(featurep 'semantic/bovine/c))
- (remove-hook 'mode-local-init-hook
'semantic-c-reset-preprocessor-symbol-map)
+ (remove-hook 'mode-local-init-hook
+ #'semantic-c-reset-preprocessor-symbol-map)
;; Initialize semantic-lex-spp-macro-symbol-obarray with symbols.
(setq-mode-local c-mode
semantic-lex-spp-macro-symbol-obarray
@@ -154,7 +155,7 @@ part of the preprocessor map.")
;; Make sure the preprocessor symbols are set up when mode-local kicks
;; in.
-(add-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map)
+(add-hook 'mode-local-init-hook #'semantic-c-reset-preprocessor-symbol-map)
(defcustom semantic-lex-c-preprocessor-symbol-map nil
"Table of C Preprocessor keywords used by the Semantic C lexer.
@@ -237,8 +238,8 @@ Return the defined symbol as a special spp lex token."
(skip-chars-forward " \t")
(if (eolp)
nil
- (let* ((name (buffer-substring-no-properties
- (match-beginning 1) (match-end 1)))
+ (let* (;; (name (buffer-substring-no-properties
+ ;; (match-beginning 1) (match-end 1)))
(beginning-of-define (match-end 1))
(with-args (save-excursion
(goto-char (match-end 0))
@@ -488,7 +489,7 @@ code to parse."
(error nil))))
(let ((eval-form (condition-case err
- (eval parsedtokelist)
+ (eval parsedtokelist t)
(error
(semantic-push-parser-warning
(format "Hideif forms produced an error. Assuming
false.\n%S" err)
@@ -499,11 +500,11 @@ code to parse."
(equal eval-form 0)));; ifdef line resulted in false
;; The if indicates to skip this preprocessor section
- (let ((pt nil))
+ (let () ;; (pt nil)
(semantic-push-parser-warning (format "Skip %s"
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(point-at-bol) (point-at-eol))
(beginning-of-line)
- (setq pt (point))
+ ;; (setq pt (point))
;; This skips only a section of a conditional. Once that section
;; is opened, encountering any new #else or related conditional
;; should be skipped.
@@ -818,7 +819,9 @@ MACRO expansion mode is handled through the nature of
Emacs's non-lexical
binding of variables.
START, END, NONTERMINAL, DEPTH, and RETURNONERRORS are the same
as for the parent."
- (if (and (boundp 'lse) (or (/= start 1) (/= end (point-max))))
+ ;; FIXME: We shouldn't depend on the internals of `semantic-bovinate-stream'.
+ (with-suppressed-warnings ((lexical lse)) (defvar lse))
+ (if (and (boundp 'lse) (or (/= start (point-min)) (/= end (point-max))))
(let* ((last-lexical-token lse)
(llt-class (semantic-lex-token-class last-lexical-token))
(llt-fakebits (car (cdr last-lexical-token)))
@@ -926,7 +929,7 @@ the regular parser."
(semantic-lex-init)
(semantic-clear-toplevel-cache)
(remove-hook 'semantic-lex-reset-functions
- 'semantic-lex-spp-reset-hook t)
+ #'semantic-lex-spp-reset-hook t)
)
;; Get the macro symbol table right.
(setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
@@ -970,7 +973,7 @@ the regular parser."
;; Notify about the debug
(setq semantic-c-debug-mode-init-last-mode mm)
- (add-hook 'post-command-hook 'semantic-c-debug-mode-init-pch)))
+ (add-hook 'post-command-hook #'semantic-c-debug-mode-init-pch)))
(defun semantic-c-debug-mode-init-pch ()
"Notify user about needing to debug their major mode hooks."
@@ -987,7 +990,7 @@ M-x semantic-c-debug-mode-init
now.
")
- (remove-hook 'post-command-hook 'semantic-c-debug-mode-init-pch)))
+ (remove-hook 'post-command-hook #'semantic-c-debug-mode-init-pch)))
(defun semantic-expand-c-tag (tag)
"Expand TAG into a list of equivalent tags, or nil."
@@ -1228,7 +1231,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
(when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list
'semantic-tag-p tag)))
(let ((allhits nil)
(scope nil)
- (refs nil))
+ ) ;; (refs nil)
(save-excursion
(semantic-go-to-tag tag db)
(setq scope (semantic-calculate-scope))
@@ -1250,11 +1253,12 @@ Use `semantic-analyze-current-tag' to debug this fcn."
(reverse newparents)))
(setq allhits (semantic--analyze-refs-full-lookup tag scope t)))
- (setq refs (semantic-analyze-references (semantic-tag-name tag)
- :tag tag
- :tagdb db
- :scope scope
- :rawsearchdata allhits)))))
+ ;; (setq refs
+ (semantic-analyze-references (semantic-tag-name tag)
+ :tag tag
+ :tagdb db
+ :scope scope
+ :rawsearchdata allhits)))) ;;)
(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
"Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
@@ -1540,9 +1544,9 @@ This might be a string, or a list of tokens."
((semantic-tag-p templatespec)
(semantic-format-tag-abbreviate templatespec))
((listp templatespec)
- (mapconcat 'semantic-format-tag-abbreviate templatespec ", "))))
+ (mapconcat #'semantic-format-tag-abbreviate templatespec ", "))))
-(defun semantic-c-template-string (token &optional parent color)
+(defun semantic-c-template-string (token &optional parent _color)
"Return a string representing the TEMPLATE attribute of TOKEN.
This string is prefixed with a space, or is the empty string.
Argument PARENT specifies a parent type.
@@ -1550,8 +1554,8 @@ Argument COLOR specifies that the string should be
colorized."
(let ((t2 (semantic-c-tag-template-specifier token))
(t1 (semantic-c-tag-template token))
;; @todo - Need to account for a parent that is a template
- (pt1 (if parent (semantic-c-tag-template parent)))
- (pt2 (if parent (semantic-c-tag-template-specifier parent)))
+ (_pt1 (if parent (semantic-c-tag-template parent)))
+ (_pt2 (if parent (semantic-c-tag-template-specifier parent)))
)
(cond (t2 ;; we have a template with specifier
(concat " <"
@@ -1610,7 +1614,7 @@ handled. A class is abstract only if its destructor is
virtual."
(member "virtual" (semantic-tag-modifiers tag))))
(t (semantic-tag-abstract-p-default tag parent))))
-(defun semantic-c-dereference-typedef (type scope &optional type-declaration)
+(defun semantic-c-dereference-typedef (type _scope &optional type-declaration)
"If TYPE is a typedef, get TYPE's type by name or tag, and return.
SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef."
(if (and (eq (semantic-tag-class type) 'type)
@@ -1655,7 +1659,7 @@ return `ref<Foo,Bar>'."
(concat (semantic-tag-name type)
"<" (semantic-c--template-name-1 (cdr spec-list)) ">"))
-(defun semantic-c-dereference-template (type scope &optional type-declaration)
+(defun semantic-c-dereference-template (type _scope &optional type-declaration)
"Dereference any template specifiers in TYPE within SCOPE.
If TYPE is a template, return a TYPE copy with the templates types
instantiated as specified in TYPE-DECLARATION."
@@ -1677,7 +1681,7 @@ instantiated as specified in TYPE-DECLARATION."
(list type type-declaration))
;;; Patch here by "Raf" for instantiating templates.
-(defun semantic-c-dereference-member-of (type scope &optional type-declaration)
+(defun semantic-c-dereference-member-of (type _scope &optional
type-declaration)
"Dereference through the `->' operator of TYPE.
Uses the return type of the `->' operator if it is contained in TYPE.
SCOPE is the current local scope to perform searches in.
@@ -1700,7 +1704,7 @@ Such an alias can be created through `using' statements
in a
namespace declaration. This function checks the namespaces in
SCOPE for such statements."
(let ((scopetypes (oref scope scopetypes))
- typename currentns tmp usingname result namespaces)
+ typename currentns result namespaces) ;; usingname tmp
(when (and (semantic-tag-p type-declaration)
(or (null type) (semantic-tag-prototype-p type)))
(setq typename (semantic-analyze-split-name (semantic-tag-name
type-declaration)))
@@ -1739,11 +1743,11 @@ with a fully qualified name in the original namespace.
Returns
nil if NAMESPACE is not an alias."
(when (eq (semantic-tag-get-attribute namespace :kind) 'alias)
(let ((typename (semantic-analyze-split-name (semantic-tag-name type)))
- ns nstype originaltype newtype)
+ ns nstype originaltype) ;; newtype
;; Make typename unqualified
- (if (listp typename)
- (setq typename (last typename))
- (setq typename (list typename)))
+ (setq typename (if (listp typename)
+ (last typename)
+ (list typename)))
(when
(and
;; Get original namespace and make sure TYPE exists there.
@@ -1755,13 +1759,13 @@ nil if NAMESPACE is not an alias."
(semantic-tag-get-attribute nstype :members))))
;; Construct new type with name in original namespace.
(setq ns (semantic-analyze-split-name ns))
- (setq newtype
- (semantic-tag-clone
- (car originaltype)
- (semantic-analyze-unsplit-name
- (if (listp ns)
- (append ns typename)
- (append (list ns) typename)))))))))
+ ;; (setq newtype
+ (semantic-tag-clone
+ (car originaltype)
+ (semantic-analyze-unsplit-name
+ (if (listp ns)
+ (append ns typename)
+ (append (list ns) typename)))))))) ;; )
;; This searches a type in a namespace, following through all using
;; statements.
@@ -1769,7 +1773,7 @@ nil if NAMESPACE is not an alias."
"Check if TYPE is accessible in NAMESPACE through a using statement.
Returns the original type from the namespace where it is defined,
or nil if it cannot be found."
- (let (usings result usingname usingtype unqualifiedname members shortname
tmp)
+ (let (usings result usingname usingtype unqualifiedname members) ;;
shortname tmp
;; Get all using statements from NAMESPACE.
(when (and (setq usings (semantic-tag-get-attribute namespace :members))
(setq usings (semantic-find-tags-by-class 'using usings)))
@@ -1842,7 +1846,7 @@ These are constants which are of type TYPE."
(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist)
"Assemble the list of names NAMELIST into a namespace name."
- (mapconcat 'identity namelist "::"))
+ (mapconcat #'identity namelist "::"))
(define-mode-local-override semantic-ctxt-scoped-types c++-mode (&optional
point)
"Return a list of tags of CLASS type based on POINT.
@@ -1885,7 +1889,7 @@ DO NOT return the list of tags encompassing point."
(semantic-get-local-variables))))
(setq tagreturn
(append tagreturn
- (mapcar 'semantic-tag-type tmp))))))
+ (mapcar #'semantic-tag-type tmp))))))
;; Return the stuff
tagreturn))
@@ -1943,7 +1947,7 @@ namespace, since this means all tags inside this include
will
have to be wrapped in that namespace."
(let ((inctable (semanticdb-find-table-for-include-default includetag table))
(inside-ns (semantic-tag-get-attribute includetag :inside-ns))
- tags newtags namespaces prefix parenttable newtable)
+ tags newtags namespaces parenttable newtable) ;; prefix
(if (or (null inside-ns)
(not inctable)
(not (slot-boundp inctable 'tags)))
@@ -2111,13 +2115,11 @@ actually in their parent which is not accessible.")
"Set up a buffer for semantic parsing of the C language."
(semantic-c-by--install-parser)
(setq semantic-lex-syntax-modifications '((?> ".")
- (?< ".")
- )
- )
+ (?< ".")))
(setq semantic-lex-analyzer #'semantic-c-lexer)
- (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t)
- (when (eq major-mode 'c++-mode)
+ (add-hook 'semantic-lex-reset-functions #'semantic-lex-spp-reset-hook nil t)
+ (when (derived-mode-p 'c++-mode)
(add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" .
"")))
)
@@ -2142,7 +2144,7 @@ actually in their parent which is not accessible.")
(defun semantic-c-describe-environment ()
"Describe the Semantic features of the current C environment."
(interactive)
- (if (not (member 'c-mode (mode-local-equivalent-mode-p major-mode)))
+ (if (not (derived-mode-p 'c-mode))
(error "Not useful to query C mode in %s mode" major-mode))
(let ((gcc (when (boundp 'semantic-gcc-setup-data)
semantic-gcc-setup-data))
diff --git a/lisp/cedet/semantic/bovine/debug.el
b/lisp/cedet/semantic/bovine/debug.el
index 8ea9ac2..47850a5 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/debug.el --- Debugger support for bovinator
+;;; semantic/bovine/debug.el --- Debugger support for bovinator -*-
lexical-binding: t; -*-
;; Copyright (C) 2003, 2009-2021 Free Software Foundation, Inc.
@@ -123,7 +123,7 @@ Argument CONDITION is the thrown error condition."
frame)
frame))
-(cl-defmethod semantic-debug-frame-highlight ((frame
semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-highlight ((_frame
semantic-bovine-debug-error-frame))
"Highlight a frame from an action."
;; How do I get the location of the action in the source buffer?
)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 4d94d34..1170e71 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -940,7 +940,7 @@ ELisp variables can be pretty long, so track this one too.")
;; loaded into Emacs.
)
-(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
+(add-hook 'emacs-lisp-mode-hook #'semantic-default-elisp-setup)
;;; LISP MODE
;;
@@ -950,7 +950,7 @@ ELisp variables can be pretty long, so track this one too.")
;; See this syntax:
;; (defun foo () /#A)
;;
-(add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
+(add-hook 'lisp-mode-hook #'semantic-default-elisp-setup)
(eval-after-load "semantic/db"
'(require 'semantic/db-el)
diff --git a/lisp/cedet/semantic/bovine/gcc.el
b/lisp/cedet/semantic/bovine/gcc.el
index c2121e5..02bd0de 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -47,11 +47,11 @@ to give to the program."
(erase-buffer)
(setenv "LC_ALL" "C")
(condition-case nil
- (setq err (apply 'call-process gcc-cmd options))
+ (setq err (apply #'call-process gcc-cmd options))
(error ;; Some bogus directory for the first time perhaps?
(let ((default-directory (expand-file-name "~/")))
(condition-case nil
- (setq err (apply 'call-process gcc-cmd options))
+ (setq err (apply #'call-process gcc-cmd options))
(error ;; gcc doesn't exist???
nil)))))
(setenv "LC_ALL" old-lc-messages)
@@ -151,12 +151,12 @@ It should also include other symbols GCC was compiled
with.")
(let* ((fields (or semantic-gcc-setup-data
(semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
(cpp-options `("-E" "-dM" "-x" "c++" ,null-device))
- (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options)))
+ (query (let ((q (apply #'semantic-gcc-query "cpp" cpp-options)))
(if (stringp q)
q
;; `cpp' command in `semantic-gcc-setup' doesn't work on
;; Mac, try `gcc'.
- (apply 'semantic-gcc-query "gcc" cpp-options))))
+ (apply #'semantic-gcc-query "gcc" cpp-options))))
(defines (if (stringp query)
(semantic-cpp-defs query)
(message (concat "Could not query gcc for defines. "
diff --git a/lisp/cedet/semantic/bovine/make.el
b/lisp/cedet/semantic/bovine/make.el
index 8089556..2c9b78f 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/make.el --- Makefile parsing rules.
+;;; semantic/bovine/make.el --- Makefile parsing rules. -*- lexical-binding:
t; -*-
;; Copyright (C) 2000-2004, 2008-2021 Free Software Foundation, Inc.
@@ -103,13 +103,13 @@ Ignore them."
xpand))
(define-mode-local-override semantic-get-local-variables
- makefile-mode (&optional point)
+ makefile-mode (&optional _point)
"Override `semantic-get-local-variables' so it does not throw an error.
We never have local variables in Makefiles."
nil)
(define-mode-local-override semantic-ctxt-current-class-list
- makefile-mode (&optional point)
+ makefile-mode (&optional _point)
"List of classes that are valid to place at point."
(let ((tag (semantic-current-tag)))
(when tag
@@ -176,7 +176,7 @@ This is the same as a regular prototype."
(semantic-format-tag-prototype tag parent color))
(define-mode-local-override semantic-analyze-possible-completions
- makefile-mode (context &rest flags)
+ makefile-mode (context &rest _flags)
"Return a list of possible completions in a Makefile.
Uses default implementation, and also gets a list of filenames."
(require 'semantic/analyze/complete)
diff --git a/lisp/cedet/semantic/bovine/scm.el
b/lisp/cedet/semantic/bovine/scm.el
index aaa86a1..939348e 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
+;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile) -*-
lexical-binding: t; -*-
;;; Copyright (C) 2001-2004, 2008-2021 Free Software Foundation, Inc.
@@ -49,7 +49,7 @@ actually on the local machine.")
")")
(semantic-format-tag-prototype-default tag parent color))))
-(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag
&optional nosnarf)
+(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag
&optional _nosnarf)
"Return the documentation string for TAG.
Optional argument NOSNARF is ignored."
(let ((d (semantic-tag-docstring tag)))
@@ -57,7 +57,7 @@ Optional argument NOSNARF is ignored."
(substring d 1)
d)))
-(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag
tagfile)
+(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag
_tagfile)
"Insert TAG from TAGFILE at point.
Attempts a simple prototype for calling or using TAG."
(cond ((eq (semantic-tag-class tag) 'function)
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 4699e72..de84b97 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -195,9 +195,6 @@ If Emacs cannot resolve this symbol to a particular file,
then return nil."
(when tab (cons tab match))))))
(autoload 'help-function-arglist "help-fns")
-(defalias 'semanticdb-elisp-sym-function-arglist 'help-function-arglist)
-(make-obsolete 'semanticdb-elisp-sym-function-arglist
- 'help-function-arglist "CEDET 1.1")
(defun semanticdb-elisp-sym->tag (sym &optional toktype)
"Convert SYM into a semantic tag.
@@ -347,6 +344,9 @@ Return a list of tags."
)
taglst))))
+(define-obsolete-function-alias 'semanticdb-elisp-sym-function-arglist
+ #'help-function-arglist "24.3")
+
(provide 'semantic/db-el)
;;; semantic/db-el.el ends here
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 3c36c6c..bdead99 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -322,17 +322,7 @@ calling this one."
"Call `find-file-noselect' with various features turned off.
Use this when referencing a file that will be soon deleted.
FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'."
- ;; Hack -
- ;; Check if we are in set-auto-mode, and if so, warn about this.
- (when (boundp 'keep-mode-if-same)
- (let ((filename (or (and (boundp 'filename) filename)
- "(unknown)")))
- (message "WARNING: semantic-find-file-noselect called for \
-%s while in set-auto-mode for %s. You should call the responsible function \
-into `mode-local-init-hook'." file filename)
- (sit-for 1)))
-
- (let* ((recentf-exclude '( (lambda (f) t) ))
+ (let* ((recentf-exclude #'always)
;; This is a brave statement. Don't waste time loading in
;; lots of modes. Especially decoration mode can waste a lot
;; of time for a buffer we intend to kill.
diff --git a/lisp/cedet/semantic/grammar-wy.el
b/lisp/cedet/semantic/grammar-wy.el
index 9a7f393..b301403 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -24,7 +24,7 @@
;;; Code:
(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
+(require 'semantic/wisent)
;;; Prologue
;;
@@ -112,315 +112,312 @@
"Table of lexical tokens.")
(defconst semantic-grammar-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC
PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START
TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST
SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE
COLON SEMI OR LT GT)
- nil
- (grammar
- ((prologue))
- ((epilogue))
- ((declaration))
- ((nonterminal))
- ((PERCENT_PERCENT)))
- (prologue
- ((PROLOGUE)
+ (wisent-compiled-grammar
+ ((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE
EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE
USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE
EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT
GT)
+ nil
+ (grammar
+ ((prologue))
+ ((epilogue))
+ ((declaration))
+ ((nonterminal))
+ ((PERCENT_PERCENT)))
+ (prologue
+ ((PROLOGUE)
+ (wisent-raw-tag
+ (semantic-tag-new-code "prologue" nil))))
+ (epilogue
+ ((EPILOGUE)
+ (wisent-raw-tag
+ (semantic-tag-new-code "epilogue" nil))))
+ (declaration
+ ((decl)
+ (eval $1 t)))
+ (decl
+ ((default_prec_decl))
+ ((no_default_prec_decl))
+ ((languagemode_decl))
+ ((package_decl))
+ ((expectedconflicts_decl))
+ ((provide_decl))
+ ((precedence_decl))
+ ((put_decl))
+ ((quotemode_decl))
+ ((scopestart_decl))
+ ((start_decl))
+ ((keyword_decl))
+ ((token_decl))
+ ((type_decl))
+ ((use_macros_decl)))
+ (default_prec_decl
+ ((DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("t")))))
+ (no_default_prec_decl
+ ((NO-DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("nil")))))
+ (languagemode_decl
+ ((LANGUAGEMODE symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'languagemode :rest ',(cdr $2)))))
+ (package_decl
+ ((PACKAGE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag-new-package ',$2 nil))))
+ (expectedconflicts_decl
+ ((EXPECTEDCONFLICTS symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'expectedconflicts :rest ',(cdr $2)))))
+ (provide_decl
+ ((PROVIDE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'provide))))
+ (precedence_decl
+ ((associativity token_type_opt items)
+ `(wisent-raw-tag
+ (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
+ (associativity
+ ((LEFT)
+ (progn "left"))
+ ((RIGHT)
+ (progn "right"))
+ ((NONASSOC)
+ (progn "nonassoc")))
+ (put_decl
+ ((PUT put_name put_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'put :value ',(list $3))))
+ ((PUT put_name put_value_list)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'put :value ',$3)))
+ ((PUT put_name_list put_value)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'put :rest ',(cdr $2)
+ :value ',(list $3))))
+ ((PUT put_name_list put_value_list)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'put :rest ',(cdr $2)
+ :value ',$3))))
+ (put_name_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-name
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'put_names 1))))
+ (put_names
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((put_name)
+ (wisent-raw-tag
+ (semantic-tag $1 'put-name))))
+ (put_name
+ ((SYMBOL))
+ ((token_type)))
+ (put_value_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-code-detail
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'put_values 1))))
+ (put_values
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((put_value)
+ (wisent-raw-tag
+ (semantic-tag-new-code "put-value" $1))))
+ (put_value
+ ((SYMBOL any_value)
+ (cons $1 $2)))
+ (scopestart_decl
+ ((SCOPESTART SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'scopestart))))
+ (quotemode_decl
+ ((QUOTEMODE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'quotemode))))
+ (start_decl
+ ((START symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'start :rest ',(cdr $2)))))
+ (keyword_decl
+ ((KEYWORD SYMBOL string_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'keyword :value ',$3))))
+ (token_decl
+ ((TOKEN token_type_opt SYMBOL string_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$3 ',(if $2 'token 'keyword)
+ :type ',$2 :value ',$4)))
+ ((TOKEN token_type_opt symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $3)
+ 'token :type ',$2 :rest ',(cdr $3)))))
+ (token_type_opt
+ (nil)
+ ((token_type)))
+ (token_type
+ ((LT SYMBOL GT)
+ (progn $2)))
+ (type_decl
+ ((TYPE token_type plist_opt)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'type :value ',$3))))
+ (plist_opt
+ (nil)
+ ((plist)))
+ (plist
+ ((plist put_value)
+ (append
+ (list $2)
+ $1))
+ ((put_value)
+ (list $1)))
+ (use_name_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-name
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'use_names 1))))
+ (use_names
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((SYMBOL)
+ (wisent-raw-tag
+ (semantic-tag $1 'use-name))))
+ (use_macros_decl
+ ((USE-MACROS SYMBOL use_name_list)
+ `(wisent-raw-tag
+ (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
+ (string_value
+ ((STRING)
+ (read $1)))
+ (any_value
+ ((SYMBOL))
+ ((STRING))
+ ((PAREN_BLOCK))
+ ((PREFIXED_LIST))
+ ((SEXP)))
+ (symbols
+ ((lifo_symbols)
+ (nreverse $1)))
+ (lifo_symbols
+ ((lifo_symbols SYMBOL)
+ (cons $2 $1))
+ ((SYMBOL)
+ (list $1)))
+ (nonterminal
+ ((SYMBOL
+ (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
+ COLON rules SEMI)
+ (wisent-raw-tag
+ (semantic-tag $1 'nonterminal :children $4))))
+ (rules
+ ((lifo_rules)
+ (apply #'nconc
+ (nreverse $1))))
+ (lifo_rules
+ ((lifo_rules OR rule)
+ (cons $3 $1))
+ ((rule)
+ (list $1)))
+ (rule
+ ((rhs)
+ (let*
+ ((nterm semantic-grammar-wy--nterm)
+ (rindx semantic-grammar-wy--rindx)
+ (rhs $1)
+ comps prec action elt)
+ (setq semantic-grammar-wy--rindx
+ (1+ semantic-grammar-wy--rindx))
+ (while rhs
+ (setq elt
+ (car rhs)
+ rhs
+ (cdr rhs))
+ (cond
+ ((vectorp elt)
+ (if prec
+ (error "Duplicate %%prec in `%s:%d' rule" nterm rindx))
+ (setq prec
+ (aref elt 0)))
+ ((consp elt)
+ (if
+ (or action comps)
+ (setq comps
+ (cons elt comps)
+ semantic-grammar-wy--rindx
+ (1+ semantic-grammar-wy--rindx))
+ (setq action
+ (car elt))))
+ (t
+ (setq comps
+ (cons elt comps)))))
+ (wisent-cook-tag
(wisent-raw-tag
- (semantic-tag-new-code "prologue" nil))))
- (epilogue
- ((EPILOGUE)
- (wisent-raw-tag
- (semantic-tag-new-code "epilogue" nil))))
- (declaration
- ((decl)
- (eval $1)))
- (decl
- ((default_prec_decl))
- ((no_default_prec_decl))
- ((languagemode_decl))
- ((package_decl))
- ((expectedconflicts_decl))
- ((provide_decl))
- ((precedence_decl))
- ((put_decl))
- ((quotemode_decl))
- ((scopestart_decl))
- ((start_decl))
- ((keyword_decl))
- ((token_decl))
- ((type_decl))
- ((use_macros_decl)))
- (default_prec_decl
- ((DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("t")))))
- (no_default_prec_decl
- ((NO-DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("nil")))))
- (languagemode_decl
- ((LANGUAGEMODE symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'languagemode :rest ',(cdr $2)))))
- (package_decl
- ((PACKAGE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag-new-package ',$2 nil))))
- (expectedconflicts_decl
- ((EXPECTEDCONFLICTS symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'expectedconflicts :rest ',(cdr $2)))))
- (provide_decl
- ((PROVIDE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'provide))))
- (precedence_decl
- ((associativity token_type_opt items)
- `(wisent-raw-tag
- (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
- (associativity
- ((LEFT)
- (progn "left"))
- ((RIGHT)
- (progn "right"))
- ((NONASSOC)
- (progn "nonassoc")))
- (put_decl
- ((PUT put_name put_value)
- `(wisent-raw-tag
- (semantic-tag ',$2 'put :value ',(list $3))))
- ((PUT put_name put_value_list)
- `(wisent-raw-tag
- (semantic-tag ',$2 'put :value ',$3)))
- ((PUT put_name_list put_value)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'put :rest ',(cdr $2)
- :value ',(list $3))))
- ((PUT put_name_list put_value_list)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'put :rest ',(cdr $2)
- :value ',$3))))
- (put_name_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'put_names 1))))
- (put_names
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((put_name)
- (wisent-raw-tag
- (semantic-tag $1 'put-name))))
- (put_name
- ((SYMBOL))
- ((token_type)))
- (put_value_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-code-detail
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'put_values 1))))
- (put_values
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((put_value)
- (wisent-raw-tag
- (semantic-tag-new-code "put-value" $1))))
- (put_value
- ((SYMBOL any_value)
- (cons $1 $2)))
- (scopestart_decl
- ((SCOPESTART SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'scopestart))))
- (quotemode_decl
- ((QUOTEMODE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'quotemode))))
- (start_decl
- ((START symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'start :rest ',(cdr $2)))))
- (keyword_decl
- ((KEYWORD SYMBOL string_value)
- `(wisent-raw-tag
- (semantic-tag ',$2 'keyword :value ',$3))))
- (token_decl
- ((TOKEN token_type_opt SYMBOL string_value)
- `(wisent-raw-tag
- (semantic-tag ',$3 ',(if $2 'token 'keyword)
- :type ',$2 :value ',$4)))
- ((TOKEN token_type_opt symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $3)
- 'token :type ',$2 :rest ',(cdr $3)))))
- (token_type_opt
- (nil)
- ((token_type)))
- (token_type
- ((LT SYMBOL GT)
- (progn $2)))
- (type_decl
- ((TYPE token_type plist_opt)
- `(wisent-raw-tag
- (semantic-tag ',$2 'type :value ',$3))))
- (plist_opt
- (nil)
- ((plist)))
- (plist
- ((plist put_value)
- (append
- (list $2)
- $1))
- ((put_value)
- (list $1)))
- (use_name_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'use_names 1))))
- (use_names
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((SYMBOL)
- (wisent-raw-tag
- (semantic-tag $1 'use-name))))
- (use_macros_decl
- ((USE-MACROS SYMBOL use_name_list)
- `(wisent-raw-tag
- (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
- (string_value
- ((STRING)
- (read $1)))
- (any_value
- ((SYMBOL))
- ((STRING))
- ((PAREN_BLOCK))
- ((PREFIXED_LIST))
- ((SEXP)))
- (symbols
- ((lifo_symbols)
- (nreverse $1)))
- (lifo_symbols
- ((lifo_symbols SYMBOL)
- (cons $2 $1))
- ((SYMBOL)
- (list $1)))
- (nonterminal
- ((SYMBOL
- (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
- COLON rules SEMI)
- (wisent-raw-tag
- (semantic-tag $1 'nonterminal :children $4))))
- (rules
- ((lifo_rules)
- (apply 'nconc
- (nreverse $1))))
- (lifo_rules
- ((lifo_rules OR rule)
- (cons $3 $1))
- ((rule)
- (list $1)))
- (rule
- ((rhs)
- (let*
- ((nterm semantic-grammar-wy--nterm)
- (rindx semantic-grammar-wy--rindx)
- (rhs $1)
- comps prec action elt)
- (setq semantic-grammar-wy--rindx
- (1+ semantic-grammar-wy--rindx))
- (while rhs
- (setq elt
- (car rhs)
- rhs
- (cdr rhs))
- (cond
- ((vectorp elt)
- (if prec
- (error "Duplicate %%prec in `%s:%d' rule" nterm rindx))
- (setq prec
- (aref elt 0)))
- ((consp elt)
- (if
- (or action comps)
- (setq comps
- (cons elt comps)
- semantic-grammar-wy--rindx
- (1+ semantic-grammar-wy--rindx))
- (setq action
- (car elt))))
- (t
- (setq comps
- (cons elt comps)))))
- (wisent-cook-tag
- (wisent-raw-tag
- (semantic-tag
- (format "%s:%d" nterm rindx)
- 'rule :type
- (if comps "group" "empty")
- :value comps :prec prec :expr action))))))
- (rhs
- (nil)
- ((rhs item)
- (cons $2 $1))
- ((rhs action)
- (cons
- (list $2)
- $1))
- ((rhs PREC item)
- (cons
- (vector $3)
- $1)))
- (action
- ((PAREN_BLOCK))
- ((PREFIXED_LIST))
- ((BRACE_BLOCK)
- (format "(progn\n%s)"
- (let
- ((s $1))
- (if
- (string-match "^{[
\n ]*" s)
- (setq s
- (substring s
- (match-end 0))))
- (if
- (string-match "[
\n ]*}$" s)
- (setq s
- (substring s 0
- (match-beginning 0))))
- s))))
- (items
- ((lifo_items)
- (nreverse $1)))
- (lifo_items
- ((lifo_items item)
- (cons $2 $1))
- ((item)
- (list $1)))
- (item
- ((SYMBOL))
- ((CHARACTER))))
- '(grammar prologue epilogue declaration nonterminal rule put_names
put_values use_names)))
+ (semantic-tag
+ (format "%s:%d" nterm rindx)
+ 'rule :type
+ (if comps "group" "empty")
+ :value comps :prec prec :expr action))))))
+ (rhs
+ (nil)
+ ((rhs item)
+ (cons $2 $1))
+ ((rhs action)
+ (cons
+ (list $2)
+ $1))
+ ((rhs PREC item)
+ (cons
+ (vector $3)
+ $1)))
+ (action
+ ((PAREN_BLOCK))
+ ((PREFIXED_LIST))
+ ((BRACE_BLOCK)
+ (format "(progn\n%s)"
+ (let
+ ((s $1))
+ (if
+ (string-match "^{[
\n ]*" s)
+ (setq s
+ (substring s
+ (match-end 0))))
+ (if
+ (string-match "[
\n ]*}$" s)
+ (setq s
+ (substring s 0
+ (match-beginning 0))))
+ s))))
+ (items
+ ((lifo_items)
+ (nreverse $1)))
+ (lifo_items
+ ((lifo_items item)
+ (cons $2 $1))
+ ((item)
+ (list $1)))
+ (item
+ ((SYMBOL))
+ ((CHARACTER))))
+ (grammar prologue epilogue declaration nonterminal rule put_names
put_values use_names))
"Parser table.")
(defun semantic-grammar-wy--install-parser ()
@@ -434,7 +431,7 @@
semantic-lex-types-obarray semantic-grammar-wy--token-table)
;; Collect unmatched syntax lexical tokens
(add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
+ #'wisent-collect-unmatched-syntax nil t))
;;; Analyzers
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 4551811..8d8faac 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,4 +1,4 @@
-;;; semantic/grammar.el --- Major mode framework for Semantic grammars
+;;; semantic/grammar.el --- Major mode framework for Semantic grammars -*-
lexical-binding: t; -*-
;; Copyright (C) 2002-2005, 2007-2021 Free Software Foundation, Inc.
@@ -191,11 +191,11 @@ Warn if other tags of class CLASS exist."
That is tag names plus names defined in tag attribute `:rest'."
(let* ((tags (semantic-find-tags-by-class
class (current-buffer))))
- (apply 'append
+ (apply #'append
(mapcar
#'(lambda (tag)
(mapcar
- 'intern
+ #'intern
(cons (semantic-tag-name tag)
(semantic-tag-get-attribute tag :rest))))
tags))))
@@ -312,7 +312,7 @@ the keyword and TOKEN is the terminal symbol identifying
the keyword."
(setq put (car puts)
puts (cdr puts)
keys (mapcar
- 'intern
+ #'intern
(cons (semantic-tag-name put)
(semantic-tag-get-attribute put :rest))))
(while keys
@@ -565,6 +565,10 @@ Typically a DEFINE expression should look like this:
(goto-char start)
(indent-sexp))))
+(defvar semantic-grammar-require-form
+ '(eval-when-compile (require 'semantic/bovine))
+ "The form to use to load the parser engine.")
+
(defconst semantic-grammar-header-template
'("\
;;; " file " --- Generated parser support file
@@ -602,7 +606,7 @@ Typically a DEFINE expression should look like this:
;;; Code:
(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
+" require-form "
")
"Generated header template.
The symbols in the template are local variables in
@@ -651,6 +655,7 @@ The symbols in the list are local variables in
semantic--grammar-output-buffer))
(gram . ,(semantic-grammar-buffer-file))
(date . ,(format-time-string "%Y-%m-%d %T%z"))
+ (require-form . ,(format "%S" semantic-grammar-require-form))
(vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
;; Try to get the copyright from the input grammar, or
;; generate a new one if not found.
@@ -818,7 +823,7 @@ Block definitions are read from the current table of
lexical types."
(let ((semantic-lex-types-obarray
(semantic-lex-make-type-table tokens props))
semantic-grammar--lex-block-specs)
- (mapatoms 'semantic-grammar-insert-defanalyzer
+ (mapatoms #'semantic-grammar-insert-defanalyzer
semantic-lex-types-obarray))))
;;; Generation of the grammar support file.
@@ -846,7 +851,8 @@ Lisp code."
(semantic--grammar-package (semantic-grammar-package))
(semantic--grammar-provide (semantic-grammar-first-tag-name 'provide))
(output (concat (or semantic--grammar-provide
- semantic--grammar-package) ".el"))
+ semantic--grammar-package)
+ ".el"))
(semantic--grammar-input-buffer (current-buffer))
(semantic--grammar-output-buffer
(find-file-noselect
@@ -1197,20 +1203,20 @@ END is the limit of the search."
(defvar semantic-grammar-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "|" 'semantic-grammar-electric-punctuation)
- (define-key km ";" 'semantic-grammar-electric-punctuation)
- (define-key km "%" 'semantic-grammar-electric-punctuation)
- (define-key km "(" 'semantic-grammar-electric-punctuation)
- (define-key km ")" 'semantic-grammar-electric-punctuation)
- (define-key km ":" 'semantic-grammar-electric-punctuation)
-
- (define-key km "\t" 'semantic-grammar-indent)
- (define-key km "\M-\t" 'semantic-grammar-complete)
- (define-key km "\C-c\C-c" 'semantic-grammar-create-package)
- (define-key km "\C-cm" 'semantic-grammar-find-macro-expander)
- (define-key km "\C-cik" 'semantic-grammar-insert-keyword)
-;; (define-key km "\C-cc" 'semantic-grammar-generate-and-load)
-;; (define-key km "\C-cr" 'semantic-grammar-generate-one-rule)
+ (define-key km "|" #'semantic-grammar-electric-punctuation)
+ (define-key km ";" #'semantic-grammar-electric-punctuation)
+ (define-key km "%" #'semantic-grammar-electric-punctuation)
+ (define-key km "(" #'semantic-grammar-electric-punctuation)
+ (define-key km ")" #'semantic-grammar-electric-punctuation)
+ (define-key km ":" #'semantic-grammar-electric-punctuation)
+
+ (define-key km "\t" #'semantic-grammar-indent)
+ (define-key km "\M-\t" #'semantic-grammar-complete)
+ (define-key km "\C-c\C-c" #'semantic-grammar-create-package)
+ (define-key km "\C-cm" #'semantic-grammar-find-macro-expander)
+ (define-key km "\C-cik" #'semantic-grammar-insert-keyword)
+;; (define-key km "\C-cc" #'semantic-grammar-generate-and-load)
+;; (define-key km "\C-cr" #'semantic-grammar-generate-one-rule)
km)
"Keymap used in `semantic-grammar-mode'.")
@@ -1322,7 +1328,7 @@ the change bounds to encompass the whole nonterminal tag."
;; Setup Semantic to parse grammar
(semantic-grammar-wy--install-parser)
(setq semantic-lex-comment-regex ";;"
- semantic-lex-analyzer 'semantic-grammar-lexer
+ semantic-lex-analyzer #'semantic-grammar-lexer
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list
'(
@@ -1343,10 +1349,10 @@ the change bounds to encompass the whole nonterminal
tag."
;; Before each change, clear the cached regexp used to highlight
;; macros local in this grammar.
(add-hook 'before-change-functions
- 'semantic--grammar-clear-macros-regexp-2 nil t)
+ #'semantic--grammar-clear-macros-regexp-2 nil t)
;; Handle safe re-parse of grammar rules.
(add-hook 'semantic-edits-new-change-functions
- 'semantic-grammar-edits-new-change-hook-fcn
+ #'semantic-grammar-edits-new-change-hook-fcn
nil t))
;;;;
@@ -1734,7 +1740,7 @@ If it is a macro name, return a description of the
associated expander
function parameter list.
If it is a function name, return a description of this function
parameter list.
-It it is a variable name, return a brief (one-line) documentation
+If it is a variable name, return a brief (one-line) documentation
string for the variable.
If a default description of the current context can be obtained,
return it.
@@ -1876,7 +1882,7 @@ Optional argument COLOR determines if color is added to
the text."
(names (semantic-tag-get-attribute tag :rest))
(type (semantic-tag-type tag)))
(if names
- (setq name (mapconcat 'identity (cons name names) " ")))
+ (setq name (mapconcat #'identity (cons name names) " ")))
(setq desc (concat
(if type
(format " <%s>" type)
@@ -1893,7 +1899,7 @@ Optional argument COLOR determines if color is added to
the text."
(format " <%s>" type)
"")
(if val
- (concat " " (mapconcat 'identity val " "))
+ (concat " " (mapconcat #'identity val " "))
"")))))
(t
(setq desc (semantic-format-tag-abbreviate tag parent color))))
@@ -1944,7 +1950,7 @@ Optional argument COLOR determines if color is added to
the text."
context-return)))
(define-mode-local-override semantic-analyze-possible-completions
- semantic-grammar-mode (context &rest flags)
+ semantic-grammar-mode (context &rest _flags)
"Return a list of possible completions based on CONTEXT."
(require 'semantic/analyze/complete)
(if (semantic-grammar-in-lisp-p)
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 0f99747..9df9778 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -348,54 +348,56 @@ Returns t if all processing succeeded."
Visits Semantic controlled buffers, and makes sure all needed
include files have been parsed, and that the typecache is up to date.
Uses `semantic-idle-work-for-on-buffer' to do the work."
- (let ((errbuf nil)
- (interrupted
- (semantic-exit-on-input 'idle-work-timer
- (let* ((inhibit-quit nil)
- (cb (current-buffer))
- (buffers (delq (current-buffer)
- (delq nil
- (mapcar #'(lambda (b)
- (and (buffer-file-name b)
- b))
- (buffer-list)))))
- safe errbuf)
- ;; First, handle long tasks in the current buffer.
- (when (semantic-idle-scheduler-enabled-p)
- (save-excursion
- (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
- )))
- (when (not safe) (push (current-buffer) errbuf))
-
- ;; Now loop over other buffers with same major mode, trying to
- ;; update them as well. Stop on keypress.
- (dolist (b buffers)
- (semantic-throw-on-input 'parsing-mode-buffers)
- (with-current-buffer b
- (when (semantic-idle-scheduler-enabled-p)
- (and (semantic-idle-scheduler-enabled-p)
- (unless (semantic-idle-work-for-one-buffer
(current-buffer))
- (push (current-buffer) errbuf)))
- ))
- )
-
- (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
- ;; Save everything.
- (semanticdb-save-all-db-idle)
-
- ;; Parse up files near our active buffer
- (when semantic-idle-work-parse-neighboring-files-flag
- (semantic-safe "Idle Work Parse Neighboring Files: %S"
- (set-buffer cb)
- (semantic-idle-scheduler-work-parse-neighboring-files))
- t)
+ (let*
+ ((errbuf nil)
+ (interrupted
+ (semantic-exit-on-input 'idle-work-timer
+ (let* ((inhibit-quit nil)
+ (cb (current-buffer))
+ (buffers (delq (current-buffer)
+ (delq nil
+ (mapcar #'(lambda (b)
+ (and (buffer-file-name b)
+ b))
+ (buffer-list)))))
+ safe) ;; errbuf
+ ;; First, handle long tasks in the current buffer.
+ (when (semantic-idle-scheduler-enabled-p)
+ (save-excursion
+ (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
+ )))
+ (when (not safe) (push (current-buffer) errbuf))
+
+ ;; Now loop over other buffers with same major mode, trying to
+ ;; update them as well. Stop on keypress.
+ (dolist (b buffers)
+ (semantic-throw-on-input 'parsing-mode-buffers)
+ (with-current-buffer b
+ (when (semantic-idle-scheduler-enabled-p)
+ (and (semantic-idle-scheduler-enabled-p)
+ (unless (semantic-idle-work-for-one-buffer
+ (current-buffer))
+ (push (current-buffer) errbuf)))
+ ))
+ )
- ;; Save everything... again
- (semanticdb-save-all-db-idle)
- )
+ (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
+ ;; Save everything.
+ (semanticdb-save-all-db-idle)
+
+ ;; Parse up files near our active buffer
+ (when semantic-idle-work-parse-neighboring-files-flag
+ (semantic-safe "Idle Work Parse Neighboring Files: %S"
+ (set-buffer cb)
+ (semantic-idle-scheduler-work-parse-neighboring-files))
+ t)
+
+ ;; Save everything... again
+ (semanticdb-save-all-db-idle)
+ )
- ;; Done w/ processing
- nil))))
+ ;; Done w/ processing
+ nil))))
;; Done
(if interrupted
@@ -734,7 +736,8 @@ Call `semantic-idle-summary-current-symbol-info' for
getting the
current tag to display information."
(or (eq major-mode 'emacs-lisp-mode)
(not (semantic-idle-summary-useful-context-p))
- (let* ((found (semantic-idle-summary-current-symbol-info))
+ (let* ((found (save-excursion
+ (semantic-idle-summary-current-symbol-info)))
(str (cond ((stringp found) found)
((semantic-tag-p found)
(funcall semantic-idle-summary-function
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index b3399aa..29d8e29 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1098,26 +1098,21 @@ at the beginning of `semantic-lex-token-stream'.
This can be done by using `semantic-lex-push-token'."
(declare (debug (&define name stringp form def-body)))
`(eval-and-compile
- (defvar ,name nil ,doc)
- (defun ,name nil)
- ;; Do this part separately so that re-evaluation rebuilds this code.
- (setq ,name '(,condition ,@forms))
+ ;; This is the real info used by `define-lex' (via
semantic-lex-one-token).
+ (defconst ,name '(,condition ,@forms) ,doc)
;; Build a single lexical analyzer function, so the doc for
;; function help is automatically provided, and perhaps the
;; function could be useful for testing and debugging one
;; analyzer.
- (fset ',name (lambda () ,doc
- (let ((semantic-lex-token-stream nil)
- (semantic-lex-end-point (point))
- (semantic-lex-analysis-bounds
- (cons (point) (point-max)))
- (semantic-lex-current-depth 0)
- (semantic-lex-maximum-depth
- semantic-lex-depth)
- )
- (when ,condition ,@forms)
- semantic-lex-token-stream)))
- ))
+ (defun ,name ()
+ ,doc
+ (let ((semantic-lex-token-stream nil)
+ (semantic-lex-end-point (point))
+ (semantic-lex-analysis-bounds (cons (point) (point-max)))
+ (semantic-lex-current-depth 0)
+ (semantic-lex-maximum-depth semantic-lex-depth))
+ (when ,condition ,@forms)
+ semantic-lex-token-stream))))
(defmacro define-lex-regex-analyzer (name doc regexp &rest forms)
"Create a lexical analyzer with NAME and DOC that will match REGEXP.
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 6bd04b2..2d806e5 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -562,7 +562,7 @@ such as `public' or `private'."
;; @TODO - is this line needed?? Try w/out for a while
;; @note - I think C++ says no. elisp might, but methods
;; look like defuns, so it makes no difference.
- (extmeth nil) ; (semantic-tag-external-member-children type t))
+ ;;(extmeth nil) ; (semantic-tag-external-member-children type t))
;; INHERITED are tags found in classes that our TYPE tag
;; inherits from. Do not do this if it was not requested.
@@ -584,7 +584,7 @@ such as `public' or `private'."
(setq slots (nreverse copyslots))
))
;; Flatten the database output.
- (append slots extmeth inherited)
+ (append slots nil inherited) ;; extmeth
)))
(defun semantic-analyze-scoped-inherited-tags (type scope access)
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index ecd9683..f498e7e 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -224,7 +224,7 @@ the standard function `semantic-parse-stream'."
(error-message-string error-to-filter))
(message "wisent-parse-max-stack-size \
might need to be increased"))
- (apply 'signal error-to-filter))))))
+ (apply #'signal error-to-filter))))))
;; Manage returned lookahead token
(if wisent-lookahead
(if (eq (caar la-elt) wisent-lookahead)
@@ -252,6 +252,17 @@ might need to be increased"))
(if (consp cache) cache '(nil))
)))
+(defmacro wisent-compiled-grammar (grammar &optional start-list)
+ "Return a compiled form of the LALR(1) Wisent GRAMMAR.
+See `wisent--compile-grammar' for a description of the arguments
+and return value."
+ ;; Ensure that the grammar compiler is available.
+ (require 'semantic/wisent/comp)
+ (declare-function wisent-automaton-lisp-form "semantic/wisent/comp" (x))
+ (declare-function wisent--compile-grammar "semantic/wisent/comp" (grm st))
+ (wisent-automaton-lisp-form
+ (wisent--compile-grammar grammar start-list)))
+
(defun wisent-parse-region (start end &optional goal depth returnonerror)
"Parse the area between START and END using the Wisent LALR parser.
Return the list of semantic tags found.
diff --git a/lisp/cedet/semantic/wisent/comp.el
b/lisp/cedet/semantic/wisent/comp.el
index 7a64fe2..ae0823e 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
+;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler -*-
lexical-binding: t; -*-
;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2021 Free
;; Software Foundation, Inc.
@@ -54,15 +54,16 @@
;; bound locally, without all these "reference to free variable"
;; compiler warnings!
-(defmacro wisent-context-name (name)
- "Return the context name from NAME."
- `(if (and ,name (symbolp ,name))
- (intern (format "wisent-context-%s" ,name))
- (error "Invalid context name: %S" ,name)))
+(eval-when-compile
+ (defun wisent-context-name (name)
+ "Return the context name from NAME."
+ (if (and name (symbolp name))
+ (intern (format "wisent-context-%s" name))
+ (error "Invalid context name: %S" name)))
-(defmacro wisent-context-bindings (name)
- "Return the variables in context NAME."
- `(symbol-value (wisent-context-name ,name)))
+ (defun wisent-context-bindings (name)
+ "Return the variables in context NAME."
+ (symbol-value (wisent-context-name name))))
(defmacro wisent-defcontext (name &rest vars)
"Define a context NAME that will bind variables VARS."
@@ -77,12 +78,8 @@
(defmacro wisent-with-context (name &rest body)
"Bind variables in context NAME then eval BODY."
(declare (indent 1))
- (let ((bindings (wisent-context-bindings name)))
- `(progn
- ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding)))
- bindings)
- (let* ,bindings
- ,@body))))
+ `(dlet ,(wisent-context-bindings name)
+ ,@body))
;; Other utilities
@@ -101,6 +98,8 @@ If optional LEFT is non-nil insert spaces on left."
;;;; Environment dependencies
;;;; ------------------------
+;; FIXME: Use bignums or bool-vectors?
+
(defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum))
(defsubst wisent-WORDSIZE (n)
@@ -2774,7 +2773,7 @@ that likes a token gets to handle it."
"Figure out the actions for every state.
Return the action table."
;; Store the semantic action obarray in (unused) RCODE[0].
- (aset rcode 0 (make-vector 13 0))
+ (aset rcode 0 (obarray-make 13))
(let (i j action-table actrow action)
(setq action-table (make-vector nstates nil)
actrow (make-vector ntokens nil)
@@ -3388,7 +3387,7 @@ NONTERMS is the list of non terminal definitions (see
function
;;;; Compile input grammar
;;;; ---------------------
-(defun wisent-compile-grammar (grammar &optional start-list)
+(defun wisent--compile-grammar (grammar start-list)
"Compile the LALR(1) GRAMMAR.
GRAMMAR is a list (TOKENS ASSOCS . NONTERMS) where:
@@ -3440,7 +3439,7 @@ where:
(wisent-parser-automaton)))))
;;;; --------------------------
-;;;; Byte compile input grammar
+;;;; Obsolete byte compile support
;;;; --------------------------
(require 'bytecomp)
@@ -3449,25 +3448,32 @@ where:
"Byte compile the `wisent-compile-grammar' FORM.
Automatically called by the Emacs Lisp byte compiler as a
`byte-compile' handler."
- ;; Eval the `wisent-compile-grammar' form to obtain an LALR
- ;; automaton internal data structure. Then, because the internal
- ;; data structure contains an obarray, convert it to a lisp form so
- ;; it can be byte-compiled.
(byte-compile-form
- ;; FIXME: we macroexpand here since `byte-compile-form' expects
- ;; macroexpanded code, but that's just a workaround: for lexical-binding
- ;; the lisp form should have to pass through closure-conversion and
- ;; `wisent-byte-compile-grammar' is called much too late for that.
- ;; Why isn't this `wisent-automaton-lisp-form' performed at
- ;; macroexpansion time? --Stef
(macroexpand-all
(wisent-automaton-lisp-form (eval form)))))
-;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table
-;; instead of an obarray would work around the problem that obarrays
-;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t).
-(put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar)
+(defun wisent-compile-grammar (grammar &optional start-list)
+ ;; This is kept for compatibility with FOO-wy.el files generated
+ ;; with older Emacsen.
+ (declare (obsolete wisent-compiled-grammar "Mar 2021"))
+ (wisent--compile-grammar grammar start-list))
+
+(put 'wisent-compile-grammar 'byte-compile #'wisent-byte-compile-grammar)
+
+;;;; --------------------------
+;;;; Byte compile input grammar
+;;;; --------------------------
+;; `wisent--compile-grammar' generates the actual parse table
+;; we need at run-time, but in order to be able to compile the code it
+;; contains, we need to "reify" it back into a piece of ELisp code
+;; which (re)builds it.
+;; This is needed for 2 reasons:
+;; - The parse tables include an obarray and these don't survive the print+read
+;; steps involved in generating a `.elc' file and reading it back in.
+;; - Within the parse table vectors/obarrays we have ELisp functions which
+;; we want to byte-compile, but if we were to just `quote' the table
+;; we'd get them with the same non-compiled functions.
(defun wisent-automaton-lisp-form (automaton)
"Return a Lisp form that produces AUTOMATON.
See also `wisent-compile-grammar' for more details on AUTOMATON."
@@ -3477,7 +3483,7 @@ See also `wisent-compile-grammar' for more details on
AUTOMATON."
(let ((obn (make-symbol "ob")) ; Generated obarray name
(obv (aref automaton 3)) ; Semantic actions obarray
)
- `(let ((,obn (make-vector 13 0)))
+ `(let ((,obn (obarray-make 13)))
;; Generate code to initialize the semantic actions obarray,
;; in local variable OBN.
,@(let (obcode)
@@ -3496,7 +3502,9 @@ See also `wisent-compile-grammar' for more details on
AUTOMATON."
;; obarray.
(vector
,@(mapcar
- #'(lambda (state) ;; for each state
+ ;; Use name `st' rather than `state' since `state' is
+ ;; defined as dynbound in `semantic-actions' context above :-( !
+ #'(lambda (st) ;; for each state
`(list
,@(mapcar
#'(lambda (tr) ;; for each transition
@@ -3507,7 +3515,7 @@ See also `wisent-compile-grammar' for more details on
AUTOMATON."
`(cons ,(if (symbolp k) `(quote ,k) k)
(intern-soft ,(symbol-name a) ,obn))
`(quote ,tr))))
- state)))
+ st)))
(aref automaton 0)))
;; The code of the goto table is unchanged.
,(aref automaton 1)
diff --git a/lisp/cedet/semantic/wisent/grammar.el
b/lisp/cedet/semantic/wisent/grammar.el
index edc5c5c..819ebd5 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -286,12 +286,9 @@ Return the expanded expression."
(defun wisent-grammar-parsetable-builder ()
"Return the value of the parser table."
- `(progn
- ;; Ensure that the grammar [byte-]compiler is available.
- (eval-when-compile (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- ',(wisent-grammar-grammar)
- ',(semantic-grammar-start))))
+ `(wisent-compiled-grammar
+ ,(wisent-grammar-grammar)
+ ,(semantic-grammar-start)))
(defun wisent-grammar-setupcode-builder ()
"Return the parser setup code."
@@ -305,7 +302,7 @@ Return the expanded expression."
semantic-lex-types-obarray %s)\n\
;; Collect unmatched syntax lexical tokens\n\
(add-hook 'wisent-discarding-token-functions\n\
- 'wisent-collect-unmatched-syntax nil t)"
+ #'wisent-collect-unmatched-syntax nil t)"
(semantic-grammar-parsetable)
(buffer-name)
(semantic-grammar-keywordtable)
@@ -325,6 +322,7 @@ Menu items are appended to the common grammar menu.")
(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
"Major mode for editing Wisent grammars."
(semantic-grammar-setup-menu wisent-grammar-menu)
+ (setq-local semantic-grammar-require-form '(require 'semantic/wisent))
(semantic-install-function-overrides
'((semantic-grammar-parsetable-builder . wisent-grammar-parsetable-builder)
(semantic-grammar-setupcode-builder .
wisent-grammar-setupcode-builder))))
diff --git a/lisp/cedet/semantic/wisent/java-tags.el
b/lisp/cedet/semantic/wisent/java-tags.el
index d455c02..adb9a30 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
+;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs -*-
lexical-binding: t; -*-
;; Copyright (C) 2001-2006, 2009-2021 Free Software Foundation, Inc.
@@ -92,7 +92,7 @@ This function override `get-local-variables'."
(define-mode-local-override semantic-analyze-unsplit-name java-mode (namelist)
"Assemble the list of names NAMELIST into a namespace name."
- (mapconcat 'identity namelist "."))
+ (mapconcat #'identity namelist "."))
diff --git a/lisp/cedet/semantic/wisent/javascript.el
b/lisp/cedet/semantic/wisent/javascript.el
index 684eea1..9db51ad 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/javascript.el --- javascript parser support
+;;; semantic/wisent/javascript.el --- javascript parser support -*-
lexical-binding: t; -*-
;; Copyright (C) 2005, 2009-2021 Free Software Foundation, Inc.
@@ -70,7 +70,7 @@ This function overrides `get-local-variables'."
;; Does javascript have identifiable local variables?
nil)
-(define-mode-local-override semantic-tag-protection js-mode (tag &optional
parent)
+(define-mode-local-override semantic-tag-protection js-mode (_tag &optional
_parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
nil - No special protection. Language dependent.
@@ -85,7 +85,7 @@ The default behavior (if not overridden with `tag-protection'
is to return a symbol based on type modifiers."
nil)
-(define-mode-local-override semantic-analyze-scope-calculate-access js-mode
(type scope)
+(define-mode-local-override semantic-analyze-scope-calculate-access js-mode
(_type _scope)
"Calculate the access class for TYPE as defined by the current SCOPE.
Access is related to the :parents in SCOPE. If type is a member of SCOPE
then access would be `private'. If TYPE is inherited by a member of SCOPE,
@@ -101,7 +101,7 @@ This is currently needed for the mozrepl omniscient
database."
(save-excursion
(if point (goto-char point))
(let* ((case-fold-search semantic-case-fold)
- symlist tmp end)
+ tmp end) ;; symlist
(with-syntax-table semantic-lex-syntax-table
(save-excursion
(when (looking-at "\\w\\|\\s_")
@@ -110,10 +110,11 @@ This is currently needed for the mozrepl omniscient
database."
(unless (re-search-backward "\\s-" (point-at-bol) t)
(beginning-of-line))
(setq tmp (buffer-substring-no-properties (point) end))
+ ;; (setq symlist
(if (string-match "\\(.+\\)\\." tmp)
- (setq symlist (list (match-string 1 tmp)
- (substring tmp (1+ (match-end 1)) (length
tmp))))
- (setq symlist (list tmp))))))))
+ (list (match-string 1 tmp)
+ (substring tmp (1+ (match-end 1)) (length tmp)))
+ (list tmp)))))));; )
;;; Setup Function
;;
diff --git a/lisp/cedet/semantic/wisent/python.el
b/lisp/cedet/semantic/wisent/python.el
index 7769ad19..8732b2e 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,4 +1,4 @@
-;;; wisent-python.el --- Semantic support for Python
+;;; wisent-python.el --- Semantic support for Python -*- lexical-binding: t;
-*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@@ -464,19 +464,19 @@ To be implemented for Python! For now just return nil."
(define-mode-local-override semantic-tag-include-filename python-mode (tag)
"Return a suitable path for (some) Python imports."
(let ((name (semantic-tag-name tag)))
- (concat (mapconcat 'identity (split-string name "\\.") "/") ".py")))
+ (concat (mapconcat #'identity (split-string name "\\.") "/") ".py")))
;; Override ctxt-current-function/assignment defaults, since they do
;; not work properly with Python code, even leading to endless loops
;; (see bug #xxxxx).
-(define-mode-local-override semantic-ctxt-current-function python-mode
(&optional point)
+(define-mode-local-override semantic-ctxt-current-function python-mode
(&optional _point)
"Return the current function call the cursor is in at POINT.
The function returned is the one accepting the arguments that
the cursor is currently in. It will not return function symbol if the
cursor is on the text representing that function."
nil)
-(define-mode-local-override semantic-ctxt-current-assignment python-mode
(&optional point)
+(define-mode-local-override semantic-ctxt-current-assignment python-mode
(&optional _point)
"Return the current assignment near the cursor at POINT.
Return a list as per `semantic-ctxt-current-symbol'.
Return nil if there is nothing relevant."
diff --git a/lisp/cedet/semantic/wisent/wisent.el
b/lisp/cedet/semantic/wisent/wisent.el
index 26cf87f..df1fd73 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
+;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime -*-
lexical-binding: t; -*-
;;; Copyright (C) 2002-2007, 2009-2021 Free Software Foundation, Inc.
@@ -139,7 +139,7 @@ POSITIONS are available."
"Print a one-line message if `wisent-parse-verbose-flag' is set.
Pass STRING and ARGS arguments to `message'."
(and wisent-parse-verbose-flag
- (apply 'message string args)))
+ (apply #'message string args)))
;;;; --------------------
;;;; The LR parser engine
@@ -147,13 +147,11 @@ Pass STRING and ARGS arguments to `message'."
(defcustom wisent-parse-max-stack-size 500
"The parser stack size."
- :type 'integer
- :group 'wisent)
+ :type 'integer)
(defcustom wisent-parse-max-recover 3
"Number of tokens to shift before turning off error status."
- :type 'integer
- :group 'wisent)
+ :type 'integer)
(defvar wisent-discarding-token-functions nil
"List of functions to be called when discarding a lexical token.
@@ -397,9 +395,9 @@ automaton has only one entry point."
(wisent-error
(format "Syntax error, unexpected %s, expecting %s"
(wisent-token-to-string wisent-input)
- (mapconcat 'wisent-item-to-string
+ (mapconcat #'wisent-item-to-string
(delq wisent-error-term
- (mapcar 'car (cdr choices)))
+ (mapcar #'car (cdr choices)))
", "))))
;; Increment the error counter
(setq wisent-nerrs (1+ wisent-nerrs))
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index f6fcfae..cef0900 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1439,6 +1439,8 @@ ARGS is a list of image descriptors."
(apply #'create-image file doc-view--image-type nil
args)
(unless (member :width args)
(setq args `(,@args :width ,doc-view-image-width)))
+ (unless (member :transform-smoothing args)
+ (setq args `(,@args :transform-smoothing t)))
(apply #'create-image file doc-view--image-type nil
args))))
(slice (doc-view-current-slice))
(img-width (and image (car (image-size image))))
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 14bc281..2a3efbe 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -62,7 +62,8 @@ See also `benchmark-run-compiled'."
;; Take account of the loop overhead.
`(- (benchmark-elapse (dotimes (,i ,repetitions)
,@forms))
- (benchmark-elapse (dotimes (,i ,repetitions))))
+ (benchmark-elapse (dotimes (,i ,repetitions)
+ nil)))
`(benchmark-elapse ,@forms))
(- gcs-done ,gcs)
(- gc-elapsed ,gc)))))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index b332581..db8d825 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1327,6 +1327,8 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
radians-to-degrees rassq rassoc read-from-string regexp-opt
regexp-quote region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp
+ string> string-greaterp string-empty-p
+ string-prefix-p string-suffix-p string-blank-p
string-search string-to-char
string-to-number string-to-syntax substring
sxhash sxhash-equal sxhash-eq sxhash-eql
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 8ca4adc..921a25b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2575,12 +2575,14 @@ list that represents a doc string reference.
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile--declare-var (sym)
+(defun byte-compile--check-prefixed-var (sym)
(when (and (symbolp sym)
(not (string-match "[-*/:$]" (symbol-name sym)))
(byte-compile-warning-enabled-p 'lexical sym))
- (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
- sym))
+ (byte-compile-warn "global/dynamic var `%s' lacks a prefix" sym)))
+
+(defun byte-compile--declare-var (sym)
+ (byte-compile--check-prefixed-var sym)
(when (memq sym byte-compile-lexical-variables)
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
@@ -4278,9 +4280,15 @@ that suppresses all warnings during execution of BODY."
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
,condition '(boundp default-boundp local-variable-p)))
+ (new-bound-list
+ ;; (seq-difference byte-compile-bound-variables))
+ (delq nil (mapcar (lambda (s)
+ (if (memq s byte-compile-bound-variables) nil
s))
+ bound-list)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
- (append bound-list byte-compile-bound-variables)))
+ (append new-bound-list byte-compile-bound-variables)))
+ (mapc #'byte-compile--check-prefixed-var new-bound-list)
(unwind-protect
;; If things not being bound at all is ok, so must them being
;; obsolete. Note that we add to the existing lists since Tramp
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index bd0a3e8..afaa13a 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -295,8 +295,9 @@ of converted forms."
(if wrappers
(let ((special-forms '()))
;; Keep special forms at the beginning of the body.
- (while (or (stringp (car funcbody)) ;docstring.
- (memq (car-safe (car funcbody)) '(interactive declare)))
+ (while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring.
+ (memq (car-safe (car funcbody))
+ '(interactive declare :documentation)))
(push (pop funcbody) special-forms))
(let ((body (macroexp-progn funcbody)))
(dolist (wrapper wrappers) (setq body (funcall wrapper body)))
@@ -584,9 +585,6 @@ places where they originally did not directly appear."
(_ (or (cdr (assq form env)) form))))
-(unless (fboundp 'byte-compile-not-lexical-var-p)
- ;; Only used to test the code in non-lexbind Emacs.
- (defalias 'byte-compile-not-lexical-var-p 'boundp))
(defvar byte-compile-lexical-variables)
(defun cconv--analyze-use (vardata form varkind)
@@ -602,7 +600,14 @@ FORM is the parent form that binds this var."
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
(byte-compile-warn
- "%s `%S' not left unused" varkind var)))
+ "%s `%S' not left unused" varkind var))
+ ((and (let (or 'let* 'let) (car form))
+ `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
+ t nil ,_ ,_))
+ ;; FIXME: Convert this warning to use `macroexp--warn-wrap'
+ ;; so as to give better position information.
+ (unless (not (intern-soft var))
+ (byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata
(`(,binder nil ,_ ,_ nil)
(push (cons (cons binder form) :unused) cconv-var-classification))
@@ -783,7 +788,7 @@ This function does not return anything but instead fills the
(let ((dv (assq form env))) ; dv = declared and visible
(when dv
(setf (nth 1 dv) t))))))
-(define-obsolete-function-alias 'cconv-analyse-form 'cconv-analyze-form "25.1")
+(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form
"25.1")
(provide 'cconv)
;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 213ab43..6285166 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -931,35 +931,20 @@ don't move point."
;; Don't bug out if the file is empty (or a
;; definition ends prematurely.
(end-of-file)))
- (`(,(or 'defun 'defvar 'defcustom 'defmacro 'defconst 'defsubst 'defadvice
- 'cl-defun 'cl-defgeneric 'cl-defmacro)
+ (`(,(and (pred symbolp) def
+ (let (and doc (guard doc)) (function-get def 'doc-string-elt)))
,(pred symbolp)
;; Require an initializer, i.e. ignore single-argument `defvar'
;; forms, which never have a doc string.
,_ . ,_)
(down-list)
- ;; Skip over function or macro name, symbol to be defined, and
- ;; initializer or argument list.
- (forward-sexp 3)
- (skip-chars-forward " \n\t")
- t)
- (`(,'cl-defmethod
- ,(pred symbolp)
- . ,rest)
- (down-list)
- (forward-sexp (pcase (car rest)
- ;; No qualifier, so skip like we would have skipped in
- ;; the first clause of the outer `pcase'.
- ((pred listp) 3)
- (':extra
- ;; Skip the :extra qualifier together with its string
too.
- ;; Skip any additional qualifier.
- (if (memq (nth 2 rest) '(:around :before :after))
- 6
- 5))
- ;; Skip :before, :after or :around qualifier too.
- ((or ':around ':before ':after)
- 4)))
+ ;; Skip over function or macro name.
+ (forward-sexp 1)
+ ;; And now skip until the docstring.
+ (forward-sexp (1- ; We already skipped the function or macro name.
+ (cond
+ ((numberp doc) doc)
+ ((functionp doc) (funcall doc)))))
(skip-chars-forward " \n\t")
t)))
@@ -2149,8 +2134,8 @@ buffer, otherwise stop after the first error."
(user-error "No spellchecker installed: check the variable
`ispell-program-name'"))
(save-excursion
(skip-chars-forward "^a-zA-Z")
- (let (word sym case-fold-search err word-beginning word-end)
- (while (and (not err) (< (point) end))
+ (let (word sym case-fold-search word-beginning word-end) ;; err
+ (while (and (< (point) end)) ;; (not err)
(if (save-excursion (forward-char -1) (looking-at "[('`]"))
;; Skip lists describing meta-syntax, or bound variables
(forward-sexp 1)
@@ -2182,7 +2167,7 @@ buffer, otherwise stop after the first error."
(sit-for 0)
(message "Continuing..."))))))))
(skip-chars-forward "^a-zA-Z"))
- err))))
+ nil)))) ;; err
;;; Rogue space checking engine
;;
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index d9da0db..b2d54c7 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -321,7 +321,7 @@ the debugger will not be entered."
(make-obsolete 'debugger-insert-backtrace
"use a `backtrace-mode' buffer or `backtrace-to-string'."
- "Emacs 27.1")
+ "27.1")
(defun debugger-insert-backtrace (frames do-xrefs)
"Format and insert the backtrace FRAMES at point.
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 4a9e580..addb58c 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -332,12 +332,20 @@ or call the function `%s'."))))
t)))
;; Keep minor modes list up to date.
,@(if globalp
- `((setq global-minor-modes (delq ',modefun
global-minor-modes))
+ ;; 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 global-minor-modes)))
- `((setq local-minor-modes (delq ',modefun local-minor-modes))
- (when ,getter
- (push ',modefun local-minor-modes))))
+ (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))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 6f3c7d6..f1455ff 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3508,7 +3508,7 @@ canceled the first time the function is entered."
(defun edebug-cancel-on-entry (function)
"Cause Edebug to not stop when FUNCTION is called.
-The removes the effect of `edebug-on-entry'. If FUNCTION is is
+The removes the effect of `edebug-on-entry'. If FUNCTION is
nil, remove `edebug-on-entry' on all functions."
(interactive
(list (let ((name (completing-read
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 155b6a9..e91ec0a 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -261,7 +261,7 @@ DATA is displayed to the user and should state the reason
for skipping."
It should only be stopped when ran from inside ert--run-test-internal."
(when (and (not (symbolp debugger)) ; only run on anonymous debugger
(memq error-symbol '(ert-test-failed ert-test-skipped)))
- (funcall debugger 'error (list error-symbol data))))
+ (funcall debugger 'error (cons error-symbol data))))
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
@@ -1633,7 +1633,7 @@ default (if any)."
(defun ert-find-test-other-window (test-name)
"Find, in another window, the definition of TEST-NAME."
- (interactive (list (ert-read-test-name-at-point "Find test definition: ")))
+ (interactive (list (ert-read-test-name-at-point "Find test definition")))
(find-function-do-it test-name 'ert--test 'switch-to-buffer-other-window))
(defun ert-delete-test (test-name)
@@ -2083,6 +2083,7 @@ and how to display message."
(define-derived-mode ert-results-mode special-mode "ERT-Results"
"Major mode for viewing results of ERT test runs."
+ :interactive nil
(setq-local revert-buffer-function
(lambda (&rest _) (ert-results-rerun-all-tests))))
@@ -2178,7 +2179,7 @@ To be used in the ERT results buffer."
"Move point to the next test.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next
"No tests below"))
@@ -2186,7 +2187,7 @@ To be used in the ERT results buffer."
"Move point to the previous test.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev
"No tests above"))
@@ -2219,7 +2220,7 @@ user-error is signaled with the message ERROR-MESSAGE."
"Find the definition of the test at point in another window.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let ((name (ert-test-at-point)))
(unless name
(user-error "No test at point"))
@@ -2253,7 +2254,7 @@ To be used in the ERT results buffer."
;; the summary apparently needs to be easily accessible from the
;; error log, and perhaps it would be better to have it in a
;; separate buffer to keep it visible.
- (interactive)
+ (interactive nil ert-results-mode)
(let ((ewoc ert--results-ewoc)
(progress-bar-begin ert--results-progress-bar-button-begin))
(cond ((ert--results-test-node-or-null-at-point)
@@ -2370,7 +2371,7 @@ definition."
"Re-run all tests, using the same selector.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(cl-assert (eql major-mode 'ert-results-mode))
(let ((selector (ert--stats-selector ert--results-stats)))
(ert-run-tests-interactively selector (buffer-name))))
@@ -2379,7 +2380,7 @@ To be used in the ERT results buffer."
"Re-run the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(cl-destructuring-bind (test redefinition-state)
(ert--results-test-at-point-allow-redefinition)
(when (null test)
@@ -2414,7 +2415,7 @@ To be used in the ERT results buffer."
"Re-run the test at point with `ert-debug-on-error' bound to t.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let ((ert-debug-on-error t))
(ert-results-rerun-test-at-point)))
@@ -2422,7 +2423,7 @@ To be used in the ERT results buffer."
"Display the backtrace for the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@@ -2449,7 +2450,7 @@ To be used in the ERT results buffer."
"Display the part of the *Messages* buffer generated during the test at
point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@@ -2470,7 +2471,7 @@ To be used in the ERT results buffer."
"Display the list of `should' forms executed during the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@@ -2506,7 +2507,7 @@ To be used in the ERT results buffer."
"Toggle how much of the condition to print for the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((ewoc ert--results-ewoc)
(node (ert--results-test-node-at-point))
(entry (ewoc-data node)))
@@ -2518,7 +2519,7 @@ To be used in the ERT results buffer."
"Display test timings for the last run.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((stats ert--results-stats)
(buffer (get-buffer-create "*ERT timings*"))
(data (cl-loop for test across (ert--stats-tests stats)
@@ -2597,7 +2598,7 @@ To be used in the ERT results buffer."
"Display the documentation of the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(ert-describe-test (ert--results-test-at-point-no-redefinition t)))
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index bee2f96..6d5b04b 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -290,12 +290,13 @@ all RULES in total."
',(string-to-syntax (nth 1 action)))
,@(nthcdr 2 action))
`((let ((mb (match-beginning ,gn))
- (me (match-end ,gn))
- (syntax ,(nth 1 action)))
- (if syntax
- (put-text-property
- mb me 'syntax-table syntax))
- ,@(nthcdr 2 action)))))
+ (me (match-end ,gn)))
+ ,(macroexp-let2 nil syntax (nth 1 action)
+ `(progn
+ (if ,syntax
+ (put-text-property
+ mb me 'syntax-table ,syntax))
+ ,@(nthcdr 2 action)))))))
(t
`((let ((mb (match-beginning ,gn))
(me (match-end ,gn))
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 12b0dcf..d9db1d3 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -32,8 +32,8 @@
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
-(let* ((pause nil)
- (x (if pause "\^Xq" ""))
+(let* (;; (pause nil)
+ (x (if nil "\^Xq" "")) ;; pause
(y "\^X\^Fses-test.ses\r\^[<"))
;;Fiddle with the existing spreadsheet
(fset 'ses-exercise-example
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index e66050b..0039092 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -46,7 +46,7 @@ A cua-rectangle definition is a vector used for all actions in
TOP is the upper-left corner point.
-BOTTOM is the point at the end of line after the the lower-right
+BOTTOM is the point at the end of line after the lower-right
corner point.
LEFT and RIGHT are column numbers.
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index b8dea2f..8f90ed2 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -635,8 +635,7 @@ Argument NUM is the number of lines to move."
(defmacro edt-with-position (&rest body)
"Execute BODY with some position-related variables bound."
- `(let* ((left nil)
- (beg (edt-current-line))
+ `(let* ((beg (edt-current-line))
(height (window-height))
(top-percent
(if (zerop edt-top-scroll-margin) 10 edt-top-scroll-margin))
@@ -650,7 +649,7 @@ Argument NUM is the number of lines to move."
(far (save-excursion
(goto-char bottom)
(point-at-bol (1- height)))))
- (ignore top left far)
+ (ignore top far)
,@body))
;;;
@@ -668,9 +667,10 @@ Optional argument FIND is t is this function is called
from `edt-find'."
(search-backward edt-find-last-text)
(edt-set-match)
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left)
+ top-margin
+ (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin))))))
(defun edt-find-backward (&optional find)
@@ -707,9 +707,9 @@ Optional argument FIND is t if this function is called from
`edt-find'."
(search-backward edt-find-last-text)
(edt-set-match)
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left) top-margin
+ (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin))))
(backward-char 1)
(error "Search failed: \"%s\"" edt-find-last-text))))
@@ -1241,9 +1241,8 @@ Argument NUM is the positive number of sentences to move."
(forward-word 1)
(backward-sentence))
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left) top-margin (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin)))))
(defun edt-sentence-backward (num)
@@ -1282,9 +1281,8 @@ Argument NUM is the positive number of paragraphs to
move."
(forward-line 1))
(setq num (1- num)))
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left) top-margin (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin)))))
(defun edt-paragraph-backward (num)
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index 0e334e9..d76e0a3 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -110,11 +110,11 @@ ERC menu yet.")
(define-erc-module menu nil
"Enable a menu in ERC buffers."
((unless erc-menu-defined
- ;; make sure the menu only gets defined once, since Emacs 22
+ ;; make sure the menu only gets defined once, since Emacs
;; activates it immediately
(easy-menu-define erc-menu erc-mode-map "ERC menu" erc-menu-definition)
(setq erc-menu-defined t)))
- (;; `easy-menu-remove' is a no-op in Emacs 22
+ (;; `easy-menu-remove' is a no-op in Emacs
(message "You might have to restart Emacs to remove the ERC menu")))
(defun erc-menu-add ()
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 56f6656..a853a36 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -244,8 +244,6 @@ The effect may be disabled by setting this variable to nil."
(defcustom erc-track-position-in-mode-line 'before-modes
"Where to show modified channel information in the mode-line.
-Setting this variable only has effect in GNU Emacs versions above 21.3.
-
Choices are:
`before-modes' - add to the beginning of `mode-line-modes',
`after-modes' - add to the end of `mode-line-modes',
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7ee409b..939113a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -114,17 +114,6 @@
"Running scripts at startup and with /LOAD"
:group 'erc)
-;; compatibility with older ERC releases
-
-(define-obsolete-variable-alias 'erc-announced-server-name
- 'erc-server-announced-name "ERC 5.1")
-(define-obsolete-variable-alias 'erc-process 'erc-server-process "ERC 5.1")
-(define-obsolete-variable-alias 'erc-default-coding-system
- 'erc-server-coding-system "ERC 5.1")
-
-(define-obsolete-function-alias 'erc-send-command
- 'erc-server-send "ERC 5.1")
-
(require 'erc-backend)
;; tunable connection and authentication parameters
@@ -2155,15 +2144,15 @@ parameters SERVER and NICK."
(defun erc-select-read-args ()
"Prompt the user for values of nick, server, port, and password."
(let (user-input server port nick passwd)
- (setq user-input (read-from-minibuffer
+ (setq user-input (read-string
"IRC server: "
- (erc-compute-server) nil nil 'erc-server-history-list))
+ (erc-compute-server) 'erc-server-history-list))
(if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
(setq port (erc-string-to-port (match-string 2 user-input))
user-input (match-string 1 user-input))
(setq port
- (erc-string-to-port (read-from-minibuffer
+ (erc-string-to-port (read-string
"IRC port: " (erc-port-to-string
(erc-compute-port))))))
@@ -2172,13 +2161,12 @@ parameters SERVER and NICK."
user-input (match-string 2 user-input))
(setq nick
(if (erc-already-logged-in server port nick)
- (read-from-minibuffer
+ (read-string
(erc-format-message 'nick-in-use ?n nick)
- nick
- nil nil 'erc-nick-history-list)
- (read-from-minibuffer
+ nick 'erc-nick-history-list)
+ (read-string
"Nickname: " (erc-compute-nick nick)
- nil nil 'erc-nick-history-list))))
+ 'erc-nick-history-list))))
(setq server user-input)
@@ -2197,10 +2185,9 @@ parameters SERVER and NICK."
;; bnc with the same nick. actually it would be nice to have
;; bncs transparent, so that erc-compute-buffer-name displays
;; the server one is connected to.
- (setq nick (read-from-minibuffer
+ (setq nick (read-string
(erc-format-message 'nick-in-use ?n nick)
- nick
- nil nil 'erc-nick-history-list)))
+ nick 'erc-nick-history-list)))
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
@@ -3522,7 +3509,7 @@ The type of query window/frame/etc will depend on the
value of
If USER is omitted, close the current query buffer if one exists
- except this is broken now ;-)"
(interactive
- (list (read-from-minibuffer "Start a query with: " nil)))
+ (list (read-string "Start a query with: ")))
(let ((session-buffer (erc-server-buffer))
(erc-join-buffer erc-query-display))
(if user
@@ -4034,8 +4021,7 @@ If FACE is non-nil, it will be used to propertize the
prompt. If it is nil,
"Interactively input a user action and send it to IRC."
(interactive "")
(erc-set-active-buffer (current-buffer))
- (let ((action (read-from-minibuffer
- "Action: " nil nil nil 'erc-action-history-list)))
+ (let ((action (read-string "Action: " nil 'erc-action-history-list)))
(if (not (string-match "^\\s-*$" action))
(erc-send-action (erc-default-target) action))))
@@ -4052,24 +4038,25 @@ If `point' is at the beginning of a channel name, use
that as default."
(completing-read (format-prompt "Join channel" chnl)
table nil nil nil nil chnl))
(when (or current-prefix-arg erc-prompt-for-channel-key)
- (read-from-minibuffer "Channel key (RET for none): " nil))))
+ (read-string "Channel key (RET for none): "))))
(erc-cmd-JOIN channel (when (>= (length key) 1) key)))
(defun erc-part-from-channel (reason)
"Part from the current channel and prompt for a REASON."
(interactive
+ ;; FIXME: Has this ever worked? We're in the interactive-spec, so the
+ ;; argument `reason' can't be in scope yet!
+ ;;(if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
+ ;; reason
(list
- (if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
- reason
- (read-from-minibuffer (concat "Reason for leaving " (erc-default-target)
- ": ")))))
+ (read-string (concat "Reason for leaving " (erc-default-target) ": "))))
(erc-cmd-PART (concat (erc-default-target)" " reason)))
(defun erc-set-topic (topic)
"Prompt for a TOPIC for the current channel."
(interactive
(list
- (read-from-minibuffer
+ (read-string
(concat "Set topic of " (erc-default-target) ": ")
(when erc-channel-topic
(let ((ss (split-string erc-channel-topic "\C-o")))
@@ -4081,7 +4068,7 @@ If `point' is at the beginning of a channel name, use
that as default."
(defun erc-set-channel-limit (&optional limit)
"Set a LIMIT for the current channel. Remove limit if nil.
Prompt for one if called interactively."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
(format "Limit for %s (RET to remove limit): "
(erc-default-target)))))
(let ((tgt (erc-default-target)))
@@ -4092,7 +4079,7 @@ Prompt for one if called interactively."
(defun erc-set-channel-key (&optional key)
"Set a KEY for the current channel. Remove key if nil.
Prompt for one if called interactively."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
(format "Key for %s (RET to remove key): "
(erc-default-target)))))
(let ((tgt (erc-default-target)))
@@ -4103,7 +4090,7 @@ Prompt for one if called interactively."
(defun erc-quit-server (reason)
"Disconnect from current server after prompting for REASON.
`erc-quit-reason' works with this just like with `erc-cmd-QUIT'."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
(format "Reason for quitting %s: "
(or erc-server-announced-name
erc-session-server)))))
@@ -6290,7 +6277,6 @@ The following characters are replaced:
(defcustom erc-header-line-format "%n on %t (%m,%l) %o"
"A string to be formatted and shown in the header-line in `erc-mode'.
-Only used starting in Emacs 21.
Set this to nil if you do not want the header line to be
displayed.
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index e942ae2..3d7c43b 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -680,12 +680,12 @@ Each member of FILES is either a string or a cons cell of
the form
(let ((f files)
last-f
display-files
- ignore)
+ ) ;; ignore
(while f
(if (cdar f)
(setq last-f f
f (cdr f))
- (unless ignore
+ (unless nil ;; ignore
(funcall error-func
(format "%s: No such file or directory\n" (caar f))))
(if (eq f files)
@@ -698,7 +698,7 @@ Each member of FILES is either a string or a cons cell of
the form
(setcar f (cadr f))
(setcdr f (cddr f))))))
(if (not show-size)
- (setq display-files (mapcar 'eshell-ls-annotate files))
+ (setq display-files (mapcar #'eshell-ls-annotate files))
(dolist (file files)
(let* ((str (eshell-ls-printable-size (file-attribute-size (cdr
file)) t))
(len (length str)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 90f11bb..1e668a4 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2815,6 +2815,23 @@ Note: Other faces cannot inherit from the cursor face."
"Face to highlight argument names in *Help* buffers."
:group 'help)
+(defface help-key-binding
+ '((((class color) (min-colors 88) (background light)) :background "grey90")
+ (((class color) (min-colors 88) (background dark)) :background "grey25")
+ (((class color grayscale) (background light)) :background "grey90")
+ (((class color grayscale) (background dark)) :background "grey25")
+ (t :background "grey90"))
+ "Face for keybindings in *Help* buffers.
+
+This face is added by `substitute-command-keys', which see.
+
+Note that this face will also be used for key bindings in
+tooltips. This means that, for example, changing the :height of
+this face will increase the height of any tooltip containing key
+bindings. See also the face `tooltip'."
+ :version "28.1"
+ :group 'help)
+
(defface glyphless-char
'((((type tty)) :inherit underline)
(((type pc)) :inherit escape-glyph)
diff --git a/lisp/files.el b/lisp/files.el
index 6815354..99717ef 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -823,7 +823,9 @@ The path separator is colon in GNU and GNU-like systems."
(expand-file-name dir))
(locate-file dir cd-path nil
(lambda (f) (and (file-directory-p f) 'dir-ok)))
- (error "No such directory found via CDPATH environment variable"))))
+ (if (getenv "CDPATH")
+ (error "No such directory found via CDPATH environment variable: %s"
dir)
+ (error "No such directory: %s" dir)))))
(defun directory-files-recursively (dir regexp
&optional include-directories predicate
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 435ccab..ad32308 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -728,9 +728,6 @@ Each element is a regular expression."
:type '(repeat regexp)
:group 'gnus-article-various)
-(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
- "Gnus 5.10 (Emacs 22.1)")
-
(defface gnus-button
'((t (:weight bold)))
"Face used for highlighting a button in the article buffer."
@@ -1264,9 +1261,6 @@ Any symbol is used to look up a regular expression to
match the
banner in `gnus-list-identifiers'. A string is used as a regular
expression to match the identifier directly.")
-(make-obsolete-variable 'gnus-treat-strip-pgp nil
- "Gnus 5.10 (Emacs 22.1)")
-
(defcustom gnus-treat-strip-pem nil
"Strip PEM signatures.
Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1396,9 +1390,6 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
-(make-obsolete-variable 'gnus-treat-display-xface
- 'gnus-treat-display-x-face "Emacs 22.1")
-
(defcustom gnus-treat-display-x-face
(and (not noninteractive)
(gnus-image-type-available-p 'xbm)
@@ -1423,17 +1414,7 @@ See Info node `(gnus)Customizing Articles' and Info node
symbol
(cond ((or (boundp symbol) (get symbol 'saved-value))
value)
- ((boundp 'gnus-treat-display-xface)
- (message "\
-** gnus-treat-display-xface is an obsolete variable;\
- use gnus-treat-display-x-face instead")
- (default-value 'gnus-treat-display-xface))
- ((get 'gnus-treat-display-xface 'saved-value)
- (message "\
-** gnus-treat-display-xface is an obsolete variable;\
- use gnus-treat-display-x-face instead")
- (eval (car (get 'gnus-treat-display-xface 'saved-value)) t))
- (t
+ (t
value)))))
(put 'gnus-treat-display-x-face 'highlight t)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index b0e6cb5..f73627a 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -337,7 +337,7 @@ Returns the number of articles marked as read."
(gnus-newsgroup-kill-file gnus-newsgroup-name)))
(unreads (length gnus-newsgroup-unreads))
(gnus-summary-inhibit-highlight t)
- beg)
+ ) ;; beg
(setq gnus-newsgroup-kill-headers nil)
;; If there are any previously scored articles, we remove these
;; from the `gnus-newsgroup-headers' list that the score functions
@@ -381,7 +381,7 @@ Returns the number of articles marked as read."
(gnus-set-mode-line 'summary)
- (if beg
+ (if nil ;; beg
(let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
(or (eq nunreads 0)
(gnus-message 6 "Marked %d articles as read" nunreads))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index d7851f2..f1181d4 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -143,9 +143,6 @@ See Info node `(gnus)Posting Styles'."
:group 'gnus-message
:type 'boolean)
-(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
- 'gnus-gcc-mark-as-read "Emacs 22.1")
-
(defcustom gnus-gcc-externalize-attachments nil
"Should local-file attachments be included as external parts in Gcc copies?
If it is `all', attach files as external parts;
@@ -1659,9 +1656,7 @@ this is a reply."
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
(gnus-alive-p))
- (if (or gnus-gcc-mark-as-read
- (and (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read)))
+ (if gnus-gcc-mark-as-read
(gnus-group-mark-article-read group (cdr group-art))
(with-current-buffer gnus-group-buffer
(let ((gnus-group-marked (list group))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 339bff9..61a1d67 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -549,7 +549,7 @@ structure.
In the simplest case, they are simply consed together. String
KEY is converted to a symbol."
- (let (return)
+ (let () ;; return
(cond
((member key gnus-search-date-keys)
(when (string= "after" key)
@@ -559,7 +559,7 @@ KEY is converted to a symbol."
(setq value (gnus-search-query-parse-mark value)))
((string= "message-id" key)
(setq key "id")))
- (or return
+ (or nil ;; return
(cons (intern key) value))))
(defun gnus-search-query-parse-date (value &optional rel-date)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index a3112bd..44e97d5 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -663,7 +663,6 @@ the first newsgroup."
(defvar mail-sources)
(defvar nnmail-scan-directory-mail-source-once)
(defvar nnmail-split-history)
-(defvar nnmail-spool-file)
(defun gnus-close-all-servers ()
"Close all servers."
@@ -1173,7 +1172,7 @@ for new groups, and subscribe the new groups as zombies."
gnus-check-new-newsgroups)
gnus-secondary-select-methods))))
(groups 0)
- group new-newsgroups got-new method hashtb
+ new-newsgroups got-new method hashtb ;; group
gnus-override-subscribe-method)
(unless gnus-killed-hashtb
(gnus-make-hashtable-from-killed))
@@ -1204,14 +1203,14 @@ for new groups, and subscribe the new groups as
zombies."
(cond
((eq do-sub 'subscribe)
(cl-incf groups)
- (puthash g-name group gnus-killed-hashtb)
+ (puthash g-name nil gnus-killed-hashtb) ;; group
(gnus-call-subscribe-functions
gnus-subscribe-options-newsgroup-method g-name))
((eq do-sub 'ignore)
nil)
(t
(cl-incf groups)
- (puthash g-name group gnus-killed-hashtb)
+ (puthash g-name nil gnus-killed-hashtb) ;; group
(if gnus-subscribe-hierarchical-interactive
(push g-name new-newsgroups)
(gnus-call-subscribe-functions
@@ -2379,6 +2378,11 @@ If FORCE is non-nil, the .newsrc file is read."
(unless (gnus-yes-or-no-p (concat errmsg "; continue? "))
(error "%s" errmsg)))))))))
+;; IIUC these 3 vars were used in older .newsrc files.
+(defvar gnus-killed-assoc)
+(defvar gnus-marked-assoc)
+(defvar gnus-newsrc-assoc)
+
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
(when (file-exists-p ding-file)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index ee74f01..97da550 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -6354,9 +6354,9 @@ The resulting hash table is returned, or nil if no Xrefs
were found."
;; First peel off all invalid article numbers.
(when active
(let ((ids articles)
- id first)
+ id) ;; first
(while (setq id (pop ids))
- (when (and first (> id (cdr active)))
+ (when nil ;; (and first (> id (cdr active)))
;; We'll end up in this situation in one particular
;; obscure situation. If you re-scan a group and get
;; a new article that is cross-posted to a different
@@ -12741,7 +12741,7 @@ If REVERSE, save parts that do not match TYPE."
;; so we highlight the entire line instead.
(when (= (+ to 2) from)
(setq from beg)
- (setq to end))
+ (setq to (1+ end)))
(if gnus-newsgroup-selected-overlay
;; Move old overlay.
(move-overlay
@@ -12796,7 +12796,7 @@ If REVERSE, save parts that do not match TYPE."
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (gnus-get-text-property-excluding-characters-with-faces
beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
- beg (point-at-eol) 'face
+ beg (1+ (point-at-eol)) 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 7f2f01b..7de1cd1 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1138,7 +1138,7 @@ no need to set this variable."
:group 'gnus-message
:type '(choice (const :tag "default" nil)
string))
-(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")
+(make-obsolete-variable 'gnus-local-domain nil "24.1")
;; Customization variables
@@ -2310,7 +2310,7 @@ automatically cache the article in the agent cache."
;; The carpal mode has been removed, but define the variable for
;; backwards compatibility.
(defvar gnus-carpal nil)
-(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1")
+(make-obsolete-variable 'gnus-carpal nil "24.1")
(defvar gnus-agent-fetching nil
"Whether Gnus agent is in fetching mode.")
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 3e6f9e8..5f486f4 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -323,7 +323,7 @@
(nnbabyl-possibly-change-newsgroup group server)
(nnmail-check-syntax)
(let ((buf (current-buffer))
- result beg)
+ result) ;; beg
(and
(nnmail-activate 'nnbabyl)
(save-excursion
@@ -331,7 +331,7 @@
(search-forward "\n\n" nil t)
(forward-line -1)
(save-excursion
- (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
+ (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) ;; beg
(delete-region (point) (progn (forward-line 1) (point)))))
(when nnmail-cache-accepted-message-ids
(nnmail-cache-insert (nnmail-fetch-field "message-id")
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 1dd784d..2de5b83 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -706,7 +706,7 @@ deleted. Point is left where the deleted region was."
(if dont-check
(setq nnfolder-current-group group
nnfolder-current-buffer nil)
- (let (inf file)
+ (let (file) ;; inf
;; If we have to change groups, see if we don't already have
;; the folder in memory. If we do, verify the modtime and
;; destroy the folder if needed so we can rescan it.
@@ -718,7 +718,7 @@ deleted. Point is left where the deleted region was."
;; touched the file since last time.
(when (and nnfolder-current-buffer
(not (gnus-buffer-live-p nnfolder-current-buffer)))
- (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
+ (setq nnfolder-buffer-alist (delq nil nnfolder-buffer-alist) ;; inf
nnfolder-current-buffer nil))
(setq nnfolder-current-group group)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index f4f4ef8..93e1c47 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -95,7 +95,7 @@ Uses the same syntax as `nnmail-split-methods'.")
"Articles with the flags in the list will not be considered when splitting.")
(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'."
- "Emacs 24.1")
+ "24.1")
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 9826bc6..bcf01cf 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -240,11 +240,6 @@ If non-nil, also update the cache when copy or move
articles."
:group 'nnmail
:type 'boolean)
-(make-obsolete-variable 'nnmail-spool-file 'mail-sources
- "Gnus 5.9 (Emacs 22.1)")
-;; revision 5.29 / p0-85 / Gnus 5.9
-;; Variable removed in No Gnus v0.7
-
(defcustom nnmail-resplit-incoming nil
"If non-nil, re-split incoming procmail sorted mail."
:group 'nnmail-procmail
@@ -1321,9 +1316,6 @@ Eudora has a broken References line, but an OK
In-Reply-To."
(when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
(replace-match "\\1" t))))
-(defalias 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references)
-(make-obsolete 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references
"Emacs 23.1")
-
(custom-add-option 'nnmail-prepare-incoming-header-hook
'nnmail-ignore-broken-references)
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 231583f..0923b8e 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -503,6 +503,8 @@ as unread by Gnus.")
(setcdr active (1+ (cdr active))))
(cdr active)))
+(defvar nnmh-newsgroup-articles)
+
(defun nnmh-update-gnus-unreads (group)
;; Go through the .nnmh-articles file and compare with the actual
;; articles in this folder. The articles that are "new" will be
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index aa7c8e5..36b7af0 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -200,7 +200,7 @@ for decoding when the cdr that the data specify is not
available.")
(nnrss-possibly-change-group group server)
(let ((e (assq article nnrss-group-data))
(nntp-server-buffer (or buffer nntp-server-buffer))
- err) ;; post
+ ) ;; err post
(when e
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -302,8 +302,7 @@ for decoding when the cdr that the data specify is not
available.")
(when nnrss-content-function
(funcall nnrss-content-function e group article))))
(cond
- (err
- (nnheader-report 'nnrss err))
+ ;; (err (nnheader-report 'nnrss err))
((not e)
(nnheader-report 'nnrss "no such id: %d" article))
(t
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 1eb604d..1fd2ed0 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -233,7 +233,7 @@ server there that you can connect to. See also
(const :format "" "password")
(string :format "Password: %v")))))))
-(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1")
+(make-obsolete 'nntp-authinfo-file nil "24.1")
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 057f18f..e20a1a5 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -466,13 +466,16 @@ suitable file is found, return nil."
;; If lots of ordinary text characters run this command,
;; don't mention them one by one.
(if (< (length non-modified-keys) 10)
- (princ (mapconcat #'key-description keys ", "))
+ (with-current-buffer standard-output
+ (insert (mapconcat #'help--key-description-fontified
+ keys ", ")))
(dolist (key non-modified-keys)
(setq keys (delq key keys)))
(if keys
- (progn
- (princ (mapconcat #'key-description keys ", "))
- (princ ", and many ordinary text characters"))
+ (with-current-buffer standard-output
+ (insert (mapconcat #'help--key-description-fontified
+ keys ", "))
+ (insert ", and many ordinary text characters"))
(princ "many ordinary text characters"))))
(when (or remapped keys non-modified-keys)
(princ ".")
@@ -1826,10 +1829,12 @@ documentation for the major and minor modes of that
buffer."
(save-excursion
(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
- (help-xref-button 1 'help-function-def mode file-name)))))
- (princ ":\n")
- (princ (help-split-fundoc (documentation major-mode) nil 'doc))
- (princ (help-fns--list-local-commands)))))
+ (help-xref-button 1 'help-function-def mode file-name)))))
+ (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc)))
+ (with-current-buffer standard-output
+ (insert ":\n")
+ (insert fundoc)
+ (insert (help-fns--list-local-commands)))))))
;; For the sake of IELM and maybe others
nil)
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 791b10a..72371a8 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -92,119 +92,117 @@ If HELP-TEXT contains the sequence `%THIS-KEY%', that is
replaced
with the key sequence that invoked FNAME.
When FNAME finally does get a command, it executes that command
and then returns."
- (let ((doc-fn (intern (concat (symbol-name fname) "-doc"))))
- `(progn
- (defun ,doc-fn () ,help-text nil)
- (defun ,fname ()
- "Help command."
- (interactive)
- (let ((line-prompt
- (substitute-command-keys ,help-line)))
- (when three-step-help
- (message "%s" line-prompt))
- (let* ((help-screen (documentation (quote ,doc-fn)))
- ;; We bind overriding-local-map for very small
- ;; sections, *excluding* where we switch buffers
- ;; and where we execute the chosen help command.
- (local-map (make-sparse-keymap))
- (new-minor-mode-map-alist minor-mode-map-alist)
- (prev-frame (selected-frame))
- config new-frame key char)
- (when (string-match "%THIS-KEY%" help-screen)
- (setq help-screen
- (replace-match (key-description
- (substring (this-command-keys) 0 -1))
- t t help-screen)))
- (unwind-protect
- (let ((minor-mode-map-alist nil))
- (setcdr local-map ,helped-map)
- (define-key local-map [t] 'undefined)
- ;; Make the scroll bar keep working normally.
- (define-key local-map [vertical-scroll-bar]
- (lookup-key global-map [vertical-scroll-bar]))
- (if three-step-help
- (progn
- (setq key (let ((overriding-local-map local-map))
- (read-key-sequence nil)))
- ;; Make the HELP key translate to C-h.
- (if (lookup-key function-key-map key)
- (setq key (lookup-key function-key-map key)))
- (setq char (aref key 0)))
- (setq char ??))
- (when (or (eq char ??) (eq char help-char)
- (memq char help-event-list))
- (setq config (current-window-configuration))
- (pop-to-buffer " *Metahelp*" nil t)
- (and (fboundp 'make-frame)
- (not (eq (window-frame)
- prev-frame))
- (setq new-frame (window-frame)
- config nil))
- (setq buffer-read-only nil)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert help-screen))
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- (help-mode)
- (setq new-minor-mode-map-alist minor-mode-map-alist))
- (goto-char (point-min))
- (while (or (memq char (append help-event-list
- (cons help-char '(?? ?\C-v
?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
- (eq (car-safe char) 'switch-frame)
- (equal key "\M-v"))
- (condition-case nil
- (cond
- ((eq (car-safe char) 'switch-frame)
- (handle-switch-frame char))
- ((memq char '(?\C-v ?\s))
- (scroll-up))
- ((or (memq char '(?\177 ?\M-v delete backspace))
- (equal key "\M-v"))
- (scroll-down)))
- (error nil))
- (let ((cursor-in-echo-area t)
- (overriding-local-map local-map))
- (setq key (read-key-sequence
- (format "Type one of the options listed%s: "
- (if (pos-visible-in-window-p
- (point-max))
- "" ", or SPACE or DEL to
scroll")))
- char (aref key 0)))
-
- ;; If this is a scroll bar command, just run it.
- (when (eq char 'vertical-scroll-bar)
- (command-execute (lookup-key local-map key) nil key))))
- ;; We don't need the prompt any more.
- (message "")
- ;; Mouse clicks are not part of the help feature,
- ;; so reexecute them in the standard environment.
- (if (listp char)
- (setq unread-command-events
- (cons char unread-command-events)
- config nil)
- (let ((defn (lookup-key local-map key)))
- (if defn
- (progn
- (when config
- (set-window-configuration config)
- (setq config nil))
- ;; Temporarily rebind `minor-mode-map-alist'
- ;; to `new-minor-mode-map-alist' (Bug#10454).
- (let ((minor-mode-map-alist
new-minor-mode-map-alist))
- ;; `defn' must make sure that its frame is
- ;; selected, so we won't iconify it below.
- (call-interactively defn))
- (when new-frame
- ;; Do not iconify the selected frame.
- (unless (eq new-frame (selected-frame))
- (iconify-frame new-frame))
- (setq new-frame nil)))
- (ding)))))
- (when config
- (set-window-configuration config))
- (when new-frame
- (iconify-frame new-frame))
- (setq minor-mode-map-alist new-minor-mode-map-alist))))))))
+ (declare (indent defun))
+ `(defun ,fname ()
+ "Help command."
+ (interactive)
+ (let ((line-prompt
+ (substitute-command-keys ,help-line)))
+ (when three-step-help
+ (message "%s" line-prompt))
+ (let* ((help-screen ,help-text)
+ ;; We bind overriding-local-map for very small
+ ;; sections, *excluding* where we switch buffers
+ ;; and where we execute the chosen help command.
+ (local-map (make-sparse-keymap))
+ (new-minor-mode-map-alist minor-mode-map-alist)
+ (prev-frame (selected-frame))
+ config new-frame key char)
+ (when (string-match "%THIS-KEY%" help-screen)
+ (setq help-screen
+ (replace-match (help--key-description-fontified
+ (substring (this-command-keys) 0 -1))
+ t t help-screen)))
+ (unwind-protect
+ (let ((minor-mode-map-alist nil))
+ (setcdr local-map ,helped-map)
+ (define-key local-map [t] 'undefined)
+ ;; Make the scroll bar keep working normally.
+ (define-key local-map [vertical-scroll-bar]
+ (lookup-key global-map [vertical-scroll-bar]))
+ (if three-step-help
+ (progn
+ (setq key (let ((overriding-local-map local-map))
+ (read-key-sequence nil)))
+ ;; Make the HELP key translate to C-h.
+ (if (lookup-key function-key-map key)
+ (setq key (lookup-key function-key-map key)))
+ (setq char (aref key 0)))
+ (setq char ??))
+ (when (or (eq char ??) (eq char help-char)
+ (memq char help-event-list))
+ (setq config (current-window-configuration))
+ (pop-to-buffer " *Metahelp*" nil t)
+ (and (fboundp 'make-frame)
+ (not (eq (window-frame)
+ prev-frame))
+ (setq new-frame (window-frame)
+ config nil))
+ (setq buffer-read-only nil)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (substitute-command-keys help-screen)))
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ (help-mode)
+ (setq new-minor-mode-map-alist minor-mode-map-alist))
+ (goto-char (point-min))
+ (while (or (memq char (append help-event-list
+ (cons help-char '(?? ?\C-v ?\s
?\177 delete backspace vertical-scroll-bar ?\M-v))))
+ (eq (car-safe char) 'switch-frame)
+ (equal key "\M-v"))
+ (condition-case nil
+ (cond
+ ((eq (car-safe char) 'switch-frame)
+ (handle-switch-frame char))
+ ((memq char '(?\C-v ?\s))
+ (scroll-up))
+ ((or (memq char '(?\177 ?\M-v delete backspace))
+ (equal key "\M-v"))
+ (scroll-down)))
+ (error nil))
+ (let ((cursor-in-echo-area t)
+ (overriding-local-map local-map))
+ (setq key (read-key-sequence
+ (format "Type one of the options listed%s: "
+ (if (pos-visible-in-window-p
+ (point-max))
+ "" ", or SPACE or DEL to scroll")))
+ char (aref key 0)))
+
+ ;; If this is a scroll bar command, just run it.
+ (when (eq char 'vertical-scroll-bar)
+ (command-execute (lookup-key local-map key) nil key))))
+ ;; We don't need the prompt any more.
+ (message "")
+ ;; Mouse clicks are not part of the help feature,
+ ;; so reexecute them in the standard environment.
+ (if (listp char)
+ (setq unread-command-events
+ (cons char unread-command-events)
+ config nil)
+ (let ((defn (lookup-key local-map key)))
+ (if defn
+ (progn
+ (when config
+ (set-window-configuration config)
+ (setq config nil))
+ ;; Temporarily rebind `minor-mode-map-alist'
+ ;; to `new-minor-mode-map-alist' (Bug#10454).
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ ;; `defn' must make sure that its frame is
+ ;; selected, so we won't iconify it below.
+ (call-interactively defn))
+ (when new-frame
+ ;; Do not iconify the selected frame.
+ (unless (eq new-frame (selected-frame))
+ (iconify-frame new-frame))
+ (setq new-frame nil)))
+ (ding)))))
+ (when config
+ (set-window-configuration config))
+ (when new-frame
+ (iconify-frame new-frame))
+ (setq minor-mode-map-alist new-minor-mode-map-alist))))))
(provide 'help-macro)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index e6a5fe8..c7eaae5 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -66,11 +66,11 @@
(defvar help-mode-tool-bar-map
(let ((map (make-sparse-keymap)))
(tool-bar-local-item "close" 'quit-window 'quit map
- :label "Quit help."
+ :help "Quit help"
:vert-only t)
(define-key-after map [separator-1] menu-bar-separator)
(tool-bar-local-item "search" 'isearch-forward 'search map
- :label "Search" :vert-only t)
+ :help "Search" :vert-only t)
(tool-bar-local-item-from-menu 'help-go-back "left-arrow" map help-mode-map
:rtl "right-arrow" :vert-only t)
(tool-bar-local-item-from-menu 'help-go-forward "right-arrow" map
help-mode-map
diff --git a/lisp/help.el b/lisp/help.el
index a8af51c..45194dd 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -104,8 +104,8 @@
(define-key map "R" 'info-display-manual)
(define-key map "s" 'describe-syntax)
(define-key map "t" 'help-with-tutorial)
- (define-key map "w" 'where-is)
(define-key map "v" 'describe-variable)
+ (define-key map "w" 'where-is)
(define-key map "q" 'help-quit)
map)
"Keymap for characters following the Help key.")
@@ -187,64 +187,58 @@ Do not call this in the scope of `with-help-window'."
;; So keyboard macro definitions are documented correctly
(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
-(defalias 'help 'help-for-help-internal)
-;; find-function can find this.
-(defalias 'help-for-help 'help-for-help-internal)
-;; It can't find this, but nobody will look.
-(make-help-screen help-for-help-internal
+(defalias 'help 'help-for-help)
+(make-help-screen help-for-help
(purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or
?")
- ;; Don't purecopy this one, because it's not evaluated (it's
- ;; directly used as a docstring in a function definition, so it'll
- ;; be moved to the DOC file anyway: no need for purecopying it).
"You have typed %THIS-KEY%, the help character. Type a Help option:
\(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit]
to exit the Help command.)
-a PATTERN Show commands whose name matches the PATTERN (a list of words
- or a regexp). See also the `apropos' command.
-b Display all key bindings.
-c KEYS Display the command name run by the given key sequence.
-C CODING Describe the given coding system, or RET for current ones.
-d PATTERN Show a list of functions, variables, and other items whose
+\\[apropos-command] PATTERN Show commands whose name matches the PATTERN (a
list of words
+ or a regexp). See also \\[apropos].
+\\[describe-bindings] Display all key bindings.
+\\[describe-key-briefly] KEYS Display the command name run by the given
key sequence.
+\\[describe-coding-system] CODING Describe the given coding system, or RET
for current ones.
+\\[apropos-documentation] PATTERN Show a list of functions, variables, and
other items whose
documentation matches the PATTERN (a list of words or a regexp).
-e Go to the *Messages* buffer which logs echo-area messages.
-f FUNCTION Display documentation for the given function.
-F COMMAND Show the Emacs manual's section that describes the command.
-g Display information about the GNU project.
-h Display the HELLO file which illustrates various scripts.
-i Start the Info documentation reader: read included manuals.
-I METHOD Describe a specific input method, or RET for current.
-k KEYS Display the full documentation for the key sequence.
-K KEYS Show the Emacs manual's section for the command bound to KEYS.
-l Show last 300 input keystrokes (lossage).
-L LANG-ENV Describes a specific language environment, or RET for current.
-m Display documentation of current minor modes and current major
mode,
- including their special commands.
-n Display news of recent Emacs changes.
-o SYMBOL Display the given function or variable's documentation and value.
-p TOPIC Find packages matching a given topic keyword.
-P PACKAGE Describe the given Emacs Lisp package.
-r Display the Emacs manual in Info mode.
-R Prompt for a manual and then display it in Info mode.
-s Display contents of current syntax table, plus explanations.
-S SYMBOL Show the section for the given symbol in the Info manual
+\\[view-echo-area-messages] Go to the *Messages* buffer which logs
echo-area messages.
+\\[describe-function] FUNCTION Display documentation for the given function.
+\\[Info-goto-emacs-command-node] COMMAND Show the Emacs manual's section
that describes the command.
+\\[describe-gnu-project] Display information about the GNU project.
+\\[view-hello-file] Display the HELLO file which illustrates various
scripts.
+\\[info] Start the Info documentation reader: read included manuals.
+\\[describe-input-method] METHOD Describe a specific input method, or RET
for current.
+\\[describe-key] KEYS Display the full documentation for the key sequence.
+\\[Info-goto-emacs-key-command-node] KEYS Show the Emacs manual's section
for the command bound to KEYS.
+\\[view-lossage] Show last 300 input keystrokes (lossage).
+\\[describe-language-environment] LANG-ENV Describes a specific language
environment, or RET for current.
+\\[describe-mode] Display documentation of current minor modes and
current major mode,
+ including their special commands.
+\\[view-emacs-news] Display news of recent Emacs changes.
+\\[describe-symbol] SYMBOL Display the given function or variable's
documentation and value.
+\\[finder-by-keyword] TOPIC Find packages matching a given topic keyword.
+\\[describe-package] PACKAGE Describe the given Emacs Lisp package.
+\\[info-emacs-manual] Display the Emacs manual in Info mode.
+\\[info-display-manual] Prompt for a manual and then display it in
Info mode.
+\\[describe-syntax] Display contents of current syntax table, plus
explanations.
+\\[info-lookup-symbol] SYMBOL Show the section for the given symbol in the
Info manual
for the programming language used in this buffer.
-t Start the Emacs learn-by-doing tutorial.
-v VARIABLE Display the given variable's documentation and value.
-w COMMAND Display which keystrokes invoke the given command (where-is).
-. Display any available local help at point in the echo area.
-
-C-a Information about Emacs.
-C-c Emacs copying permission (GNU General Public License).
-C-d Instructions for debugging GNU Emacs.
-C-e External packages and information about Emacs.
-C-f Emacs FAQ.
+\\[help-with-tutorial] Start the Emacs learn-by-doing tutorial.
+\\[describe-variable] VARIABLE Display the given variable's documentation and
value.
+\\[where-is] COMMAND Display which keystrokes invoke the given command
(where-is).
+\\[display-local-help] Display any available local help at point in
the echo area.
+
+\\[about-emacs] Information about Emacs.
+\\[describe-copying] Emacs copying permission (GNU General Public
License).
+\\[view-emacs-debugging] Instructions for debugging GNU Emacs.
+\\[view-external-packages] External packages and information about
Emacs.
+\\[view-emacs-FAQ] Emacs FAQ.
C-m How to order printed Emacs manuals.
C-n News of recent Emacs changes.
-C-o Emacs ordering and distribution information.
-C-p Info about known Emacs problems.
-C-s Search forward \"help window\".
-C-t Emacs TODO list.
-C-w Information on absence of warranty for GNU Emacs."
+\\[describe-distribution] Emacs ordering and distribution information.
+\\[view-emacs-problems] Info about known Emacs problems.
+\\[search-forward-help-for-help] Search forward \"help window\".
+\\[view-emacs-todo] Emacs TODO list.
+\\[describe-no-warranty] Information on absence of warranty for GNU
Emacs."
help-map)
@@ -492,6 +486,15 @@ To record all your input, use `open-dribble-file'."
;; Key bindings
+(defun help--key-description-fontified (keys &optional prefix)
+ "Like `key-description' but add face for \"*Help*\" buffers."
+ ;; We add both the `font-lock-face' and `face' properties here, as this
+ ;; seems to be the only way to get this to work reliably in any
+ ;; buffer.
+ (propertize (key-description keys prefix)
+ 'font-lock-face 'help-key-binding
+ 'face 'help-key-binding))
+
(defun describe-bindings (&optional prefix buffer)
"Display a buffer showing a list of all defined keys, and their definitions.
The keys are displayed in order of precedence.
@@ -511,7 +514,6 @@ or a buffer name."
(with-current-buffer (help-buffer)
(describe-buffer-bindings buffer prefix))))
-;; This function used to be in keymap.c.
(defun describe-bindings-internal (&optional menus prefix)
"Show a list of all defined keys, and their definitions.
We put that list in a buffer, and display the buffer.
@@ -559,7 +561,8 @@ If INSERT (the prefix arg) is non-nil, insert the message
in the buffer."
(let* ((remapped (command-remapping symbol))
(keys (where-is-internal
symbol overriding-local-map nil nil remapped))
- (keys (mapconcat 'key-description keys ", "))
+ (keys (mapconcat #'help--key-description-fontified
+ keys ", "))
string)
(setq string
(if insert
@@ -587,11 +590,11 @@ If INSERT (the prefix arg) is non-nil, insert the message
in the buffer."
nil)
(defun help-key-description (key untranslated)
- (let ((string (key-description key)))
+ (let ((string (help--key-description-fontified key)))
(if (or (not untranslated)
(and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
string
- (let ((otherstring (key-description untranslated)))
+ (let ((otherstring (help--key-description-fontified untranslated)))
(if (equal string otherstring)
string
(format "%s (translated from %s)" string otherstring))))))
@@ -979,7 +982,7 @@ is currently activated with completion."
"Substitute key descriptions for command names in STRING.
Each substring of the form \\\\=[COMMAND] is replaced by either a
keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
-is not on any keys.
+is not on any keys. Keybindings will use the face `help-key-binding'.
Each substring of the form \\\\={MAPVAR} is replaced by a summary of
the value of MAPVAR as a keymap. This summary is similar to the one
@@ -999,7 +1002,7 @@ into the output, \\\\==\\[ puts \\[ into the output, and
\\\\==\\=` puts \\=` in
output.
Return the original STRING if no substitutions are made.
-Otherwise, return a new string (without any text properties)."
+Otherwise, return a new string."
(when (not (null string))
;; KEYMAP is either nil (which means search all the active
;; keymaps) or a specified local map (which means search just that
@@ -1053,12 +1056,16 @@ Otherwise, return a new string (without any text
properties)."
(where-is-internal fun keymap t))))
(if (not key)
;; Function is not on any key.
- (progn (insert "M-x ")
- (goto-char (+ end-point 3))
- (delete-char 1))
+ (let ((op (point)))
+ (insert "M-x ")
+ (goto-char (+ end-point 3))
+ (add-text-properties op (point)
+ '( face help-key-binding
+ font-lock-face
help-key-binding))
+ (delete-char 1))
;; Function is on a key.
(delete-char (- end-point (point)))
- (insert (key-description key)))))
+ (insert (help--key-description-fontified key)))))
;; 1D. \{foo} is replaced with a summary of the keymap
;; (symbol-value foo).
;; \<foo> just sets the keymap used for \[cmd].
@@ -1172,7 +1179,7 @@ Any inserted text ends in two newlines (used by
(concat title
(if prefix
(concat " Starting With "
- (key-description prefix)))
+ (help--key-description-fontified
prefix)))
":\n"))
"key binding\n"
"--- -------\n")))
@@ -1228,7 +1235,11 @@ Return nil if the key sequence is too long."
(=
help--previous-description-column 32)))
32)
(t 16))))
- (indent-to description-column 1)
+ ;; Avoid using the `help-keymap' face.
+ (let ((op (point)))
+ (indent-to description-column 1)
+ (set-text-properties op (point) '( face nil
+ font-lock-face nil)))
(setq help--previous-description-column description-column)
(cond ((symbolp definition)
(insert (symbol-name definition) "\n"))
@@ -1240,7 +1251,11 @@ Return nil if the key sequence is too long."
(defun help--describe-translation (definition)
;; Converted from describe_translation in keymap.c.
- (indent-to 16 1)
+ ;; Avoid using the `help-keymap' face.
+ (let ((op (point)))
+ (indent-to 16 1)
+ (set-text-properties op (point) '( face nil
+ font-lock-face nil)))
(cond ((symbolp definition)
(insert (symbol-name definition) "\n"))
((or (stringp definition) (vectorp definition))
@@ -1351,9 +1366,9 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
(setq end (caar vect))))
;; Now START .. END is the range to describe next.
;; Insert the string to describe the event START.
- (insert (key-description (vector start) prefix))
+ (insert (help--key-description-fontified (vector start) prefix))
(when (not (eq start end))
- (insert " .. " (key-description (vector end) prefix)))
+ (insert " .. " (help--key-description-fontified (vector end)
prefix)))
;; Print a description of the definition of this character.
;; Called function will take care of spacing out far enough
;; for alignment purposes.
@@ -1420,7 +1435,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
;; (setq first nil))
;; (when (and prefix (> (length prefix) 0))
;; (insert (format "%s" prefix)))
-;; (insert (key-description (vector start-idx) prefix))
+;; (insert (help--key-description-fontified (vector start-idx)
prefix))
;; ;; Find all consecutive characters or rows that have the
;; ;; same definition.
;; (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
@@ -1433,7 +1448,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
;; (insert " .. ")
;; (when (and prefix (> (length prefix) 0))
;; (insert (format "%s" prefix)))
-;; (insert (key-description (vector idx) prefix)))
+;; (insert (help--key-description-fontified (vector idx) prefix)))
;; (if transl
;; (help--describe-translation definition)
;; (help--describe-command definition))
@@ -1930,6 +1945,8 @@ the suggested string to use instead. See
(add-function :after command-error-function
#'help-command-error-confusable-suggestions)
+(define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1")
+
(provide 'help)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 7939bbb..b484dd7 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2297,7 +2297,7 @@ buffers which are visiting a file."
(defun ibuffer (&optional other-window-p name qualifiers noselect
shrink filter-groups formats)
"Begin using Ibuffer to edit a list of buffers.
-Type `h' after entering ibuffer for more information.
+Type \\<ibuffer-mode-map>\\[describe-mode] after entering ibuffer for more
information.
All arguments are optional.
OTHER-WINDOW-P says to use another window.
@@ -2579,7 +2579,7 @@ will be inserted before the group at point."
(setq buffer-read-only t)
(buffer-disable-undo)
(setq truncate-lines ibuffer-truncate-lines)
- ;; This makes things less ugly for Emacs 21 users with a non-nil
+ ;; This makes things less ugly for users with a non-nil
;; `show-trailing-whitespace'.
(setq show-trailing-whitespace nil)
;; disable `show-paren-mode' buffer-locally
diff --git a/lisp/ido.el b/lisp/ido.el
index 3ed0d95..9362904 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1746,7 +1746,7 @@ is enabled then some keybindings are changed in the
keymap."
ido-max-file-prompt-width))
(literal (and (boundp 'ido-find-literal) ido-find-literal "(literal)
"))
(vc-off (and ido-saved-vc-hb (not vc-handled-backends) "[-VC] "))
- (prefix nil)
+ ;; (prefix nil)
(rule ido-rewrite-file-prompt-rules))
(let ((case-fold-search nil))
(while rule
@@ -1762,7 +1762,7 @@ is enabled then some keybindings are changed in the
keymap."
; (if ido-process-ignore-lists "" "&")
(or literal "")
(or vc-off "")
- (or prefix "")
+ ;; (or prefix "")
(let ((l (length dirname)))
(if (and max-width (> max-width 0) (> l max-width))
(let* ((s (substring dirname (- max-width)))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 7384abf..2de16cb 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -95,6 +95,9 @@ Its value should be one of the following:
(defvar-local image-transform-rotation 0.0
"Rotation angle for the image in the current Image mode buffer.")
+(defvar-local image--transform-smoothing nil
+ "Whether to use transform smoothing.")
+
(defvar image-transform-right-angle-fudge 0.0001
"Snap distance to a multiple of a right angle.
There's no deep theory behind the default value, it should just
@@ -457,6 +460,7 @@ call."
(define-key map "sb" 'image-transform-fit-both)
(define-key map "ss" 'image-transform-set-scale)
(define-key map "sr" 'image-transform-set-rotation)
+ (define-key map "sm" 'image-transform-set-smoothing)
(define-key map "so" 'image-transform-original)
(define-key map "s0" 'image-transform-reset)
@@ -523,6 +527,8 @@ call."
:help "Rotate the image"]
["Set Rotation..." image-transform-set-rotation
:help "Set rotation angle of the image"]
+ ["Set Smoothing..." image-transform-set-smoothing
+ :help "Toggle smoothing"]
["Original Size" image-transform-original
:help "Reset image to actual size"]
["Reset to Default Size" image-transform-reset
@@ -1138,8 +1144,8 @@ replacing the current Image mode buffer."
(funcall next))))
(defun image-mode--directory-buffers (file)
- "Return a alist of type/buffer for all \"parent\" buffers to image FILE.
-This is normally a list of dired buffers, but can also be archive and
+ "Return an alist of type/buffer for all \"parent\" buffers to image FILE.
+This is normally a list of Dired buffers, but can also be archive and
tar mode buffers."
(let ((buffers nil)
(dir (file-name-directory file)))
@@ -1474,7 +1480,10 @@ return value is suitable for appending to an image spec."
,@(when (cdr resized)
(list :height (cdr resized)))
,@(unless (= 0.0 image-transform-rotation)
- (list :rotation image-transform-rotation))))))
+ (list :rotation image-transform-rotation))
+ ,@(when image--transform-smoothing
+ (list :transform-smoothing
+ (string= image--transform-smoothing "smooth")))))))
(defun image-transform-set-scale (scale)
"Prompt for a number, and resize the current image by that amount."
@@ -1507,6 +1516,12 @@ ROTATION should be in degrees."
(setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
+(defun image-transform-set-smoothing (smoothing)
+ (interactive (list (completing-read "Smoothing: "
+ '("none" "smooth") nil t)))
+ (setq image--transform-smoothing smoothing)
+ (image-toggle-display-image))
+
(defun image-transform-original ()
"Display the current image with the original (actual) size and rotation."
(interactive)
@@ -1519,7 +1534,8 @@ ROTATION should be in degrees."
(interactive)
(setq image-transform-resize image-auto-resize
image-transform-rotation 0.0
- image-transform-scale 1)
+ image-transform-scale 1
+ image--transform-smoothing nil)
(image-toggle-display-image))
(provide 'image-mode)
diff --git a/lisp/image.el b/lisp/image.el
index 6955a90..4ede1fb 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -141,6 +141,18 @@ based on the font pixel size."
(const :tag "Automatically compute" auto))
:version "26.1")
+(defcustom image-transform-smoothing #'image--default-smoothing
+ "Whether to do smoothing when applying transforms to images.
+Common transforms are rescaling and rotation.
+
+Valid values are nil (no smoothing), t (smoothing) or a predicate
+function that is called with the image specification and should return
+either nil or non-nil."
+ :type '(choice (const :tag "Do smoothing" t)
+ (const :tag "No smoothing" nil)
+ function)
+ :version "28.1")
+
(defcustom image-use-external-converter nil
"If non-nil, `create-image' will use external converters for exotic formats.
Emacs handles most of the common image formats (SVG, JPEG, PNG, GIF
@@ -485,11 +497,40 @@ Image file names that are not absolute are searched for
in the
type 'png
data-p t)))
(when (image-type-available-p type)
- (append (list 'image :type type (if data-p :data :file) file-or-data)
- (and (not (plist-get props :scale))
- (list :scale
- (image-compute-scaling-factor image-scaling-factor)))
- props)))
+ (let ((image
+ (append (list 'image :type type (if data-p :data :file)
+ file-or-data)
+ (and (not (plist-get props :scale))
+ ;; Add default scaling.
+ (list :scale
+ (image-compute-scaling-factor
+ image-scaling-factor)))
+ props)))
+ ;; Add default smoothing.
+ (unless (plist-member props :transform-smoothing)
+ (setq image (nconc image
+ (list :transform-smoothing
+ (pcase image-transform-smoothing
+ ('t t)
+ ('nil nil)
+ (func (funcall func image)))))))
+ image)))
+
+(defun image--default-smoothing (image)
+ "Say whether IMAGE should be smoothed when transformed."
+ (let* ((props (nthcdr 5 image))
+ (scaling (plist-get props :scale))
+ (rotation (plist-get props :rotation)))
+ (cond
+ ;; We always smooth when scaling down and small upwards scaling.
+ ((and scaling (< scaling 2))
+ t)
+ ;; Smooth when doing non-90-degree rotation
+ ((and rotation
+ (or (not (zerop (mod rotation 1)))
+ (not (zerop (% (truncate rotation) 90)))))
+ t)
+ (t nil))))
(defun image--set-property (image property value)
"Set PROPERTY in IMAGE to VALUE.
diff --git a/lisp/info.el b/lisp/info.el
index e7324ef..dd7e16f 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4797,10 +4797,10 @@ first line or header line, and for breadcrumb links.")
(skip-syntax-backward " ("))
(setq other-tag
(cond ((save-match-data (looking-back "\\(^\\| \\)see"
- (- (point) 3)))
+ (- (point) 4)))
"")
((save-match-data (looking-back "\\(^\\| \\)in"
- (- (point) 2)))
+ (- (point) 3)))
"")
((memq (char-before) '(nil ?\. ?! ??))
"See ")
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f527470..87a9050 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1075,7 +1075,7 @@ The installed decode map can be referred by the function
`quail-decode-map'."
KEY is a string meaning a sequence of keystrokes to be translated.
TRANSLATION is a character, a string, a vector, a Quail map,
a function, or a cons.
-It it is a character, it is the sole translation of KEY.
+If it is a character, it is the sole translation of KEY.
If it is a string, each character is a candidate for the translation.
If it is a vector, each element (string or character) is a candidate
for the translation.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index e7926ac..943e24a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -460,11 +460,11 @@ and doesn't remove full-buffer highlighting after a
search."
(make-help-screen isearch-help-for-help-internal
(purecopy "Type a help option: [bkm] or ?")
"You have typed %THIS-KEY%, the help character. Type a Help option:
-\(Type \\<help-map>\\[help-quit] to exit the Help command.)
+\(Type \\<isearch-help-map>\\[help-quit] to exit the Help command.)
-b Display all Isearch key bindings.
-k KEYS Display full documentation of Isearch key sequence.
-m Display documentation of Isearch mode.
+\\[isearch-describe-bindings] Display all Isearch key bindings.
+\\[isearch-describe-key] KEYS Display full documentation of Isearch key
sequence.
+\\[isearch-describe-mode] Display documentation of Isearch mode.
You can't type here other help keys available in the global help map,
but outside of this help window when you type them in Isearch mode,
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index d169e40..a128792 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -105,7 +105,7 @@ This means those subsequent lines are refontified to
reflect their new
syntactic context, after `jit-lock-context-time' seconds.
If any other value, e.g., `syntax-driven', it means refontification of
subsequent lines to reflect their new syntactic context may or may not
-occur after `jit-lock-context-time', depending on the the font-lock
+occur after `jit-lock-context-time', depending on the font-lock
definitions of the buffer. Specifically, if `font-lock-keywords-only'
is nil in a buffer, which generally means the syntactic fontification
is done using the buffer mode's syntax table, the syntactic
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index edb52b6..af32744 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -38,19 +38,16 @@
"Non-nil value should be a string that names a binhex decoder.
The program should expect to read binhex data on its standard
input and write the converted data to its standard output."
- :type 'string
- :group 'binhex)
+ :type 'string)
(defcustom binhex-decoder-switches '("-d")
"List of command line flags passed to the command `binhex-decoder-program'."
- :group 'binhex
:type '(repeat string))
(defcustom binhex-use-external
(executable-find binhex-decoder-program)
"Use external binhex program."
:version "22.1"
- :group 'binhex
:type 'boolean)
(defconst binhex-alphabet-decoding-alist
@@ -80,7 +77,7 @@ input and write the converted data to its standard output."
(make-obsolete-variable 'binhex-temporary-file-directory
'temporary-file-directory "28.1")
-(defun binhex-insert-char (char &optional count ignored buffer)
+(defun binhex-insert-char (char &optional count _ignored buffer)
"Insert COUNT copies of CHARACTER into BUFFER."
(if (or (null buffer) (eq buffer (current-buffer)))
(insert-char char count)
@@ -273,7 +270,8 @@ If HEADER-ONLY is non-nil only decode header and return
filename."
(defun binhex-decode-region-external (start end)
"Binhex decode region between START and END using external decoder."
(interactive "r")
- (let ((cbuf (current-buffer)) firstline work-buffer
+ (let ((cbuf (current-buffer))
+ work-buffer ;; firstline
(file-name (expand-file-name
(concat (binhex-decode-region-internal start end t)
".data")
@@ -287,9 +285,9 @@ If HEADER-ONLY is non-nil only decode header and return
filename."
(set-buffer (setq work-buffer
(generate-new-buffer " *binhex-work*")))
(buffer-disable-undo work-buffer)
- (insert-buffer-substring cbuf firstline end)
+ (insert-buffer-substring cbuf nil end) ;; firstline
(cd temporary-file-directory)
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min)
(point-max)
binhex-decoder-program
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index 505ce5d..f380f0d 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -1,4 +1,4 @@
-;;; blessmail.el --- decide whether movemail needs special privileges -*-
no-byte-compile: t -*-
+;;; blessmail.el --- decide whether movemail needs special privileges -*-
no-byte-compile: t; lexical-binding: t; -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 4d88da5..14c93f2 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,4 +1,4 @@
-;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
+;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
-*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1994, 1997-1998, 2000-2021 Free Software
;; Foundation, Inc.
@@ -45,12 +45,10 @@
(defcustom report-emacs-bug-no-confirmation nil
"If non-nil, suppress the confirmations asked for the sake of novice users."
- :group 'emacsbug
:type 'boolean)
(defcustom report-emacs-bug-no-explanations nil
"If non-nil, suppress the explanations given for the sake of novice users."
- :group 'emacsbug
:type 'boolean)
;; User options end here.
@@ -204,7 +202,7 @@ This requires either the macOS \"open\" command, or the
freedesktop
(defvar message-sendmail-envelope-from)
;;;###autoload
-(defun report-emacs-bug (topic &optional unused)
+(defun report-emacs-bug (topic &optional _unused)
"Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer.
@@ -219,10 +217,10 @@ Already submitted bugs can be found in the Emacs bug
tracker:
(let ((from-buffer (current-buffer))
(can-insert-mail (or (report-emacs-bug-can-use-xdg-email)
(report-emacs-bug-can-use-osx-open)))
- user-point message-end-point)
- (setq message-end-point
- (with-current-buffer (messages-buffer)
- (point-max-marker)))
+ user-point) ;; message-end-point
+ ;; (setq message-end-point
+ ;; (with-current-buffer (messages-buffer)
+ ;; (point-max-marker)))
(condition-case nil
;; For the novice user make sure there's always enough space for
;; the mail and the warnings buffer on this frame (Bug#10873).
@@ -263,7 +261,7 @@ Already submitted bugs can be found in the Emacs bug
tracker:
"Bug-GNU-Emacs"
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
- 'action (lambda (button)
+ 'action (lambda (_button)
(browse-url "https://lists.gnu.org/r/bug-gnu-emacs/";))
'follow-link t)
(insert " mailing list\nand the GNU bug tracker at ")
@@ -271,7 +269,7 @@ Already submitted bugs can be found in the Emacs bug
tracker:
"debbugs.gnu.org"
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
- 'action (lambda (button)
+ 'action (lambda (_button)
(browse-url
"https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1";))
'follow-link t)
@@ -347,10 +345,10 @@ usually do not have translators for other
languages.\n\n")))
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-i" 'info-emacs-bug)
+ (define-key (current-local-map) "\C-c\C-i" #'info-emacs-bug)
(if can-insert-mail
(define-key (current-local-map) "\C-c\M-i"
- 'report-emacs-bug-insert-to-mailer))
+ #'report-emacs-bug-insert-to-mailer))
(setq report-emacs-bug-send-command (get mail-user-agent 'sendfunc)
report-emacs-bug-send-hook (get mail-user-agent 'hookvar))
(if report-emacs-bug-send-command
@@ -376,7 +374,7 @@ usually do not have translators for other languages.\n\n")))
(shrink-window-if-larger-than-buffer (get-buffer-window "*Bug Help*")))
;; Make it less likely people will send empty messages.
(if report-emacs-bug-send-hook
- (add-hook report-emacs-bug-send-hook 'report-emacs-bug-hook nil t))
+ (add-hook report-emacs-bug-send-hook #'report-emacs-bug-hook nil t))
(goto-char (point-max))
(skip-chars-backward " \t\n")
(setq-local report-emacs-bug-orig-text
@@ -398,7 +396,7 @@ usually do not have translators for other languages.\n\n")))
;; This is used not only for X11 but also W32 and others.
(insert "Windowing system distributor '" (x-server-vendor)
"', version "
- (mapconcat 'number-to-string (x-server-version) ".") "\n")
+ (mapconcat #'number-to-string (x-server-version) ".") "\n")
(error t)))
(let ((os (ignore-errors (report-emacs-bug--os-description))))
(if (stringp os)
@@ -409,7 +407,7 @@ usually do not have translators for other languages.\n\n")))
system-configuration-options "'\n\n")
(fill-region (line-beginning-position -1) (point))))
-(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3")
+(define-obsolete-function-alias 'report-emacs-bug-info #'info-emacs-bug "24.3")
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 2bcbdf4..d76017b 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -1381,7 +1381,7 @@ It shows the simple addresses and gets a confirmation.
Use as:
(save-window-excursion
(display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
(erase-buffer)
- (insert (mapconcat 'identity feedmail-address-list " "))
+ (insert (mapconcat #'identity feedmail-address-list " "))
(if (not (y-or-n-p "How do you like them apples? "))
(error "FQM: Sending...gave up in last chance hook"))))
@@ -1592,10 +1592,10 @@ Feeds the buffer to it."
(feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid)
(set-buffer prepped)
(apply
- 'call-process-region
+ #'call-process-region
(append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
(format feedmail-binmail-template
- (mapconcat 'identity addr-listoid " "))))))
+ (mapconcat #'identity addr-listoid " "))))))
(defvar sendmail-program)
@@ -1609,7 +1609,7 @@ local gurus."
(require 'sendmail)
(feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
(set-buffer prepped)
- (apply 'call-process-region
+ (apply #'call-process-region
(append (list (point-min) (point-max) sendmail-program
nil errors-to nil "-oi" "-t")
;; provide envelope "from" to sendmail; results will vary
@@ -2042,7 +2042,7 @@ backup file names and the like)."
(message "FQM: Trapped `%s', message left in queue."
(car signal-stuff))
(sit-for 3)
(message "FQM: Trap details: \"%s\""
- (mapconcat 'identity (cdr signal-stuff) "\"
\""))
+ (mapconcat #'identity (cdr signal-stuff) "\"
\""))
(sit-for 3)))
(kill-buffer blobby-buffer)
(feedmail-say-chatter
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 0fab1b2..5319ab9 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -81,7 +81,7 @@ RFC 2646 suggests 66 characters for readability."
(while (setq end (text-property-any start (point-max) 'hard 't))
(save-restriction
(narrow-to-region start end)
- (let ((fill-column (eval fill-flowed-encode-column)))
+ (let ((fill-column (eval fill-flowed-encode-column t)))
(fill-flowed-fill-buffer))
(goto-char (point-min))
(while (re-search-forward "\n" nil t)
@@ -119,7 +119,7 @@ If BUFFER is nil, default to the current buffer.
If DELETE-SPACE, delete RFC2646 spaces padding at the end of
lines."
(with-current-buffer (or buffer (current-buffer))
- (let ((fill-column (eval fill-flowed-display-column)))
+ (let ((fill-column (eval fill-flowed-display-column t)))
(goto-char (point-min))
(while (not (eobp))
(cond
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 795e37d..2d68357 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -232,13 +232,13 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding
performed
;; If we found no display-name, then we look for comments.
(if display-name
(setq display-string
- (mapconcat 'identity (reverse display-name) " "))
+ (mapconcat #'identity (reverse display-name) " "))
(setq display-string (ietf-drums-get-comment string)))
(if (not mailbox)
(when (and display-string
(string-match "@" display-string))
(cons
- (mapconcat 'identity (nreverse display-name) "")
+ (mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
(cons mailbox (if decode
(rfc2047-decode-string display-string)
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 4e3bf78..7fbdfef 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,4 +1,4 @@
-;;; mail-extr.el --- extract full name and address from email header
+;;; mail-extr.el --- extract full name and address from email header -*-
lexical-binding: t; -*-
;; Copyright (C) 1991-1994, 1997, 2001-2021 Free Software Foundation,
;; Inc.
@@ -222,23 +222,20 @@
"Whether to try to guess middle initial from mail address.
If true, then when we see an address like \"John Smith <jqs@host.com>\"
we will assume that \"John Q. Smith\" is the fellow's name."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
(defcustom mail-extr-ignore-single-names nil
"Whether to ignore a name that is just a single word.
If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
we will act as though we couldn't find a full name in the address."
:type 'boolean
- :version "22.1"
- :group 'mail-extr)
+ :version "22.1")
(defcustom mail-extr-ignore-realname-equals-mailbox-name t
"Whether to ignore a name that is equal to the mailbox name.
If true, then when the address is like \"Single <single@address.com>\"
we will act as though we couldn't find a full name in the address."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
;; Matches a leading title that is not part of the name (does not
;; contribute to uniquely identifying the person).
@@ -248,19 +245,16 @@ we will act as though we couldn't find a full name in the
address."
"Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
uniquely identifying the person."
- :type 'regexp
- :group 'mail-extr)
+ :type 'regexp)
(defcustom mail-extr-@-binds-tighter-than-! nil
"Whether the local mail transport agent looks at ! before @."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
(defcustom mail-extr-mangle-uucp nil
"Whether to throw away information in UUCP addresses
by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
;;----------------------------------------------------------------------
;; what orderings are meaningful?????
@@ -760,7 +754,6 @@ non-display use, you should probably use
end-of-address
<-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos
group-:-pos group-\;-pos route-addr-:-pos
- record-pos-symbol
first-real-pos last-real-pos
phrase-beg phrase-end
;; Dynamically set in mail-extr-voodoo.
@@ -852,13 +845,16 @@ non-display use, you should probably use
)
;; record the position of various interesting chars, determine
;; validity later.
- ((setq record-pos-symbol
- (cdr (assq char
- '((?< . <-pos) (?> . >-pos) (?@ . @-pos)
- (?: . colon-pos) (?, . comma-pos) (?! . !-pos)
- (?% . %-pos) (?\; . \;-pos)))))
- (set record-pos-symbol
- (cons (point) (symbol-value record-pos-symbol)))
+ ((memq char '(?< ?> ?@ ?: ?, ?! ?% ?\;))
+ (push (point) (pcase-exhaustive char
+ (?< <-pos)
+ (?> >-pos)
+ (?@ @-pos)
+ (?: colon-pos)
+ (?, comma-pos)
+ (?! !-pos)
+ (?% %-pos)
+ (?\; \;-pos)))
(forward-char 1))
((eq char ?.)
(forward-char 1))
@@ -1065,7 +1061,7 @@ non-display use, you should probably use
(mail-extr-demarkerize route-addr-:-pos)
(setq route-addr-:-pos nil
>-pos (mail-extr-demarkerize >-pos)
- %-pos (mapcar 'mail-extr-demarkerize %-pos)))
+ %-pos (mapcar #'mail-extr-demarkerize %-pos)))
;; de-listify @-pos
(setq @-pos (car @-pos))
@@ -1122,7 +1118,7 @@ non-display use, you should probably use
(setq insert-point (point-max)))
(%-pos
(setq insert-point (car (last %-pos))
- saved-%-pos (mapcar 'mail-extr-markerize %-pos)
+ saved-%-pos (mapcar #'mail-extr-markerize %-pos)
%-pos nil
@-pos (mail-extr-markerize @-pos)))
(@-pos
@@ -1162,7 +1158,7 @@ non-display use, you should probably use
"uucp"))
(setq !-pos (cdr !-pos))))
(and saved-%-pos
- (setq %-pos (append (mapcar 'mail-extr-demarkerize
+ (setq %-pos (append (mapcar #'mail-extr-demarkerize
saved-%-pos)
%-pos)))
(setq @-pos (mail-extr-demarkerize @-pos))
@@ -1461,8 +1457,7 @@ If it is neither nil nor a string, modifying of names
will never take
place. It affects how `mail-extract-address-components' works."
:type '(choice (regexp :size 0)
(const :tag "Always enabled" nil)
- (const :tag "Always disabled" t))
- :group 'mail-extr)
+ (const :tag "Always disabled" t)))
(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer)
(unless (and mail-extr-disable-voodoo
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 37c8ad6..239b386 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,4 +1,4 @@
-;;; mail-hist.el --- headers and message body history for outgoing mail
+;;; mail-hist.el --- headers and message body history for outgoing mail -*-
lexical-binding: t; -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@@ -69,8 +69,8 @@
;;;###autoload
(defun mail-hist-enable ()
- (add-hook 'mail-mode-hook 'mail-hist-define-keys)
- (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history))
+ (add-hook 'mail-mode-hook #'mail-hist-define-keys)
+ (add-hook 'mail-send-hook #'mail-hist-put-headers-into-history))
(defvar mail-hist-header-ring-alist nil
"Alist of form (header-name . history-ring).
@@ -80,14 +80,12 @@ previous/next input.")
(defcustom mail-hist-history-size (or kill-ring-max 1729)
"The maximum number of elements in a mail field's history.
Oldest elements are dumped first."
- :type 'integer
- :group 'mail-hist)
+ :type 'integer)
;;;###autoload
(defcustom mail-hist-keep-history t
"Non-nil means keep a history for headers and text of outgoing mail."
- :type 'boolean
- :group 'mail-hist)
+ :type 'boolean)
;; For handling repeated history requests
(defvar mail-hist-access-count 0)
@@ -184,8 +182,7 @@ HEADER is a string without the colon."
(defcustom mail-hist-text-size-limit nil
"Don't store any header or body with more than this many characters.
If the value is nil, that means no limit on text size."
- :type '(choice (const nil) integer)
- :group 'mail-hist)
+ :type '(choice (const nil) integer))
(defun mail-hist-text-too-long-p (text)
"Return non-nil if TEXT's length exceeds `mail-hist-text-size-limit'."
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 83125a0..bb1f8f1 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -134,7 +134,7 @@ we expect to find and remove the wrapper characters
=?ISO-8859-1?Q?....?=."
(aref string (1+ (match-beginning 1))))))
strings)))
(setq i (match-end 0)))
- (apply 'concat (nreverse (cons (substring string i) strings))))))
+ (apply #'concat (nreverse (cons (substring string i) strings))))))
;; FIXME Gnus for some reason has `quoted-printable-decode-region' in qp.el.
;;;###autoload
@@ -194,7 +194,7 @@ Also delete leading/trailing whitespace and replace FOO
<BAR> with just BAR.
Return a modified address list."
(when address
(if mail-use-rfc822
- (mapconcat 'identity (rfc822-addresses address) ", ")
+ (mapconcat #'identity (rfc822-addresses address) ", ")
(let (pos)
;; Strip comments.
@@ -282,7 +282,7 @@ comma-separated list, and return the pruned list."
destinations))
;; Legacy name
-(define-obsolete-function-alias 'rmail-dont-reply-to 'mail-dont-reply-to
"24.1")
+(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to
"24.1")
;;;###autoload
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 2147049..5cb4a74 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -1,4 +1,4 @@
-;;; mailabbrev.el --- abbrev-expansion of mail aliases
+;;; mailabbrev.el --- abbrev-expansion of mail aliases -*- lexical-binding:
t; -*-
;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2021 Free
;; Software Foundation, Inc.
@@ -140,15 +140,13 @@ abbrev-like expansion is performed when editing certain
mail
headers (those specified by `mail-abbrev-mode-regexp'), based on
the entries in your `mail-personal-alias-file'."
:global t
- :group 'mail-abbrev
:version "20.3"
(if mail-abbrevs-mode (mail-abbrevs-enable) (mail-abbrevs-disable)))
(defcustom mail-abbrevs-only nil
"Non-nil means only mail abbrevs should expand automatically.
Other abbrevs expand only when you explicitly use `expand-abbrev'."
- :type 'boolean
- :group 'mail-abbrev)
+ :type 'boolean)
;; originally defined in sendmail.el - used to be an alist, now is a table.
(defvar mail-abbrevs nil
@@ -186,11 +184,11 @@ no aliases, which is represented by this being a table
with no entries.)")
(abbrev-mode 1))
(defun mail-abbrevs-enable ()
- (add-hook 'mail-mode-hook 'mail-abbrevs-setup))
+ (add-hook 'mail-mode-hook #'mail-abbrevs-setup))
(defun mail-abbrevs-disable ()
"Turn off use of the `mailabbrev' package."
- (remove-hook 'mail-mode-hook 'mail-abbrevs-setup)
+ (remove-hook 'mail-mode-hook #'mail-abbrevs-setup)
(abbrev-mode (if (default-value 'abbrev-mode) 1 -1)))
;;;###autoload
@@ -258,8 +256,7 @@ By default this is the file specified by
`mail-personal-alias-file'."
"String inserted between addresses in multi-address mail aliases.
This has to contain a comma, so \", \" is a reasonable value. You might
also want something like \",\\n \" to get each address on its own line."
- :type 'string
- :group 'mail-abbrev)
+ :type 'string)
;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
;; to be called before expanding abbrevs if it's necessary.
@@ -367,7 +364,7 @@ double-quotes."
(defun mail-resolve-all-aliases-1 (sym &optional so-far)
(if (memq sym so-far)
(error "mail alias loop detected: %s"
- (mapconcat 'symbol-name (cons sym so-far) " <- ")))
+ (mapconcat #'symbol-name (cons sym so-far) " <- ")))
(let ((definition (and (boundp sym) (symbol-value sym))))
(if definition
(let ((result '())
@@ -420,8 +417,7 @@ of the current line; if it matches, abbrev mode will be
turned on, otherwise
it will be turned off. (You don't need to worry about continuation lines.)
This should be set to match those mail fields in which you want abbreviations
turned on."
- :type 'regexp
- :group 'mail-abbrev)
+ :type 'regexp)
(defvar mail-abbrev-syntax-table nil
"The syntax-table used for abbrev-expansion purposes.
@@ -433,14 +429,14 @@ of a mail alias. The value is set up, buffer-local, when
first needed.")
(make-local-variable 'mail-abbrev-syntax-table)
(unless mail-abbrev-syntax-table
(let ((tab (copy-syntax-table (syntax-table)))
- (_ (aref (standard-syntax-table) ?_))
+ (syntax-_ (aref (standard-syntax-table) ?_))
(w (aref (standard-syntax-table) ?w)))
(map-char-table
(lambda (key value)
(if (null value)
;; Fetch the inherited value
(setq value (aref tab key)))
- (if (equal value _)
+ (if (equal value syntax-_)
(set-char-table-range tab key w)))
tab)
(modify-syntax-entry ?@ "w" tab)
@@ -600,12 +596,12 @@ In other respects, this behaves like `end-of-buffer',
which see."
(eval-after-load "sendmail"
'(progn
- (define-key mail-mode-map "\C-c\C-a" 'mail-abbrev-insert-alias)
+ (define-key mail-mode-map "\C-c\C-a" #'mail-abbrev-insert-alias)
(define-key mail-mode-map "\e\t" ; like completion-at-point
- 'mail-abbrev-complete-alias)))
+ #'mail-abbrev-complete-alias))) ;; FIXME: Use `completion-at-point'.
-;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
-;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
+;;(define-key mail-mode-map "\C-n" #'mail-abbrev-next-line)
+;;(define-key mail-mode-map "\M->" #'mail-abbrev-end-of-buffer)
(provide 'mailabbrev)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 3cba6a6..5c153ce 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -1,4 +1,4 @@
-;;; mailclient.el --- mail sending via system's mail client.
+;;; mailclient.el --- mail sending via system's mail client. -*-
lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index cbc01e4..0443279 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -1,4 +1,4 @@
-;;; mailheader.el --- mail header parsing, merging, formatting
+;;; mailheader.el --- mail header parsing, merging, formatting -*-
lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -99,23 +99,23 @@ value."
headers)
;; Advertised part of the interface; see mail-header, mail-header-set.
-(with-suppressed-warnings ((lexical headers))
- (defvar headers))
-(defsubst mail-header (header &optional header-alist)
+(defun mail-header (header &optional header-alist)
"Return the value associated with header HEADER in HEADER-ALIST.
If the value is a string, it is the original value of the header. If the
value is a list, its first element is the original value of the header,
-with any subsequent elements being the result of parsing the value.
-If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+with any subsequent elements being the result of parsing the value."
(declare (gv-setter (lambda (value)
`(mail-header-set ,header ,value ,header-alist))))
+ (with-suppressed-warnings ((lexical headers)) (defvar headers))
(cdr (assq header (or header-alist headers))))
(defun mail-header-set (header value &optional header-alist)
"Set the value associated with header HEADER to VALUE in HEADER-ALIST.
HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
See `mail-header' for the semantics of VALUE."
+ (declare (obsolete alist-get "28.1"))
+ (with-suppressed-warnings ((lexical headers)) (defvar headers))
(let* ((alist (or header-alist headers))
(entry (assq header alist)))
(if entry
@@ -131,10 +131,13 @@ should be a string or a list of string. The first
element may be nil to
denote that the formatting functions must use the remaining elements, or
skip the header altogether if there are no other elements.
The macro `mail-header' can be used to access headers in HEADERS."
- (mapcar
- (lambda (rule)
- (cons (car rule) (eval (cdr rule))))
- merge-rules))
+ (declare (obsolete alist-get "28.1"))
+ (with-suppressed-warnings ((lexical headers)) (defvar headers))
+ (let ((headers headers))
+ (mapcar
+ (lambda (rule)
+ (cons (car rule) (eval (cdr rule) t)))
+ merge-rules)))
(defvar mail-header-format-function
(lambda (header value)
@@ -167,7 +170,7 @@ A key of nil has as its value a list of defaulted headers
to ignore."
(mapcar #'car format-rules))))
(dolist (rule format-rules)
(let* ((header (car rule))
- (value (mail-header header)))
+ (value (alist-get header headers)))
(if (stringp header)
(setq header (intern header)))
(cond ((null header) 'ignore)
@@ -176,13 +179,11 @@ A key of nil has as its value a list of defaulted headers
to ignore."
(unless (memq (car defaulted) ignore)
(let* ((header (car defaulted))
(value (cdr defaulted)))
- (if (cdr rule)
- (funcall (cdr rule) header value)
- (funcall mail-header-format-function header value))))))
+ (funcall (or (cdr rule) mail-header-format-function)
+ header value)))))
(value
- (if (cdr rule)
- (funcall (cdr rule) header value)
- (funcall mail-header-format-function header value))))))
+ (funcall (or (cdr rule) mail-header-format-function)
+ header value)))))
(insert "\n")))
(provide 'mailheader)
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 970f52c..6d83414 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -167,11 +167,11 @@ your primary spool is. If this fails, set it to
something like
(defvar mspools-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'mspools-visit-spool)
- (define-key map "\C-m" 'mspools-visit-spool)
- (define-key map " " 'mspools-visit-spool)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
+ (define-key map "\C-c\C-c" #'mspools-visit-spool)
+ (define-key map "\C-m" #'mspools-visit-spool)
+ (define-key map " " #'mspools-visit-spool)
+ (define-key map "n" #'next-line)
+ (define-key map "p" #'previous-line)
map)
"Keymap for the *spools* buffer.")
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index f07fcdf..2e97226 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -1,4 +1,4 @@
-;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc.
+;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc. -*-
lexical-binding: t; -*-
;; Copyright (C) 1986-1987, 1990, 2001-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index dda472e..d833685 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -1,4 +1,4 @@
-;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader
+;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader -*-
lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
@@ -82,50 +82,42 @@
(defcustom rmail-use-spam-filter nil
"Non-nil to activate the Rmail spam filter.
Set `rsf-definitions-alist' to define what you consider spam emails."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-file "~/XRMAIL-SPAM"
"Name of Rmail file for optionally saving some of the spam.
You can either just delete spam, or save it in this file for
later review. Which action to take for each spam definition is
specified by the \"action\" element of the definition."
- :type 'string
- :group 'rmail-spam-filter)
+ :type 'string)
(defcustom rsf-no-blind-cc nil
"Non-nil means mail with no explicit To: or Cc: is spam."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-ignore-case nil
"Non-nil means to ignore case in `rsf-definitions-alist'."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-beep nil
"Non-nil means to beep if spam is found."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-sleep-after-message 2.0
"Seconds to wait after displaying a message that spam was found."
- :type 'number
- :group 'rmail-spam-filter)
+ :type 'number)
(defcustom rsf-min-region-to-spam-list 7
"Minimum size of region that you can add to the spam list.
The aim is to avoid adding too short a region, which could result
in false positive identification of a valid message as spam."
- :type 'integer
- :group 'rmail-spam-filter)
+ :type 'integer)
(defcustom rsf-autosave-newly-added-definitions nil
"Non-nil to auto-save new spam entries.
Any time you add an entry via the \"Spam\" menu, immediately saves
the custom file."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-white-list nil
"List of regexps to identify valid senders.
@@ -133,8 +125,7 @@ If any element matches the \"From\" header, the message is
flagged as a valid, non-spam message. E.g., if your domain is
\"emacs.com\" then including \"emacs\\\\.com\" in this list would
flag all mail (purporting to be) from your colleagues as valid."
- :type '(repeat regexp)
- :group 'rmail-spam-filter)
+ :type '(repeat regexp))
(defcustom rsf-definitions-alist nil
"A list of rules (definitions) matching spam messages.
@@ -178,8 +169,7 @@ A rule matches only if all the specified elements match."
(choice :tag "Action selection"
(const :tag "Output and delete" output-and-delete)
(const :tag "Delete" delete-spam)
- ))))
- :group 'rmail-spam-filter)
+ )))))
;; FIXME nothing uses this, and it could just be let-bound.
(defvar rsf-scanning-messages-now nil
@@ -224,6 +214,8 @@ the cdr is set to t. Else, the car is set to nil."
;; empty buffer.
(1- (or (rmail-first-unseen-message) 1))))
+(defvar bbdb/mail_auto_create_p)
+
(defun rmail-spam-filter (msg)
"Return nil if message number MSG is spam based on `rsf-definitions-alist'.
If spam, optionally output message to a file `rsf-file' and delete
@@ -522,12 +514,12 @@ to the spam list (remember to save it)"
region-to-spam-list))))))
["Customize spam definitions" rsf-customize-spam-definitions]
["Browse spam customizations" rsf-customize-group]
))
- (define-key map "\C-cSt" 'rsf-add-subject-to-spam-list)
- (define-key map "\C-cSr" 'rsf-add-sender-to-spam-list)
- (define-key map "\C-cSn" 'rsf-add-region-to-spam-list)
- (define-key map "\C-cSa" 'rsf-custom-save-all)
- (define-key map "\C-cSd" 'rsf-customize-spam-definitions)
- (define-key map "\C-cSg" 'rsf-customize-group))
+ (define-key map "\C-cSt" #'rsf-add-subject-to-spam-list)
+ (define-key map "\C-cSr" #'rsf-add-sender-to-spam-list)
+ (define-key map "\C-cSn" #'rsf-add-region-to-spam-list)
+ (define-key map "\C-cSa" #'rsf-custom-save-all)
+ (define-key map "\C-cSd" #'rsf-customize-spam-definitions)
+ (define-key map "\C-cSg" #'rsf-customize-group))
(defun rsf-add-content-type-field ()
"Maintain backward compatibility for `rmail-spam-filter'.
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 8ccf1bf..2bd3ffa 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1721,7 +1721,7 @@ not be a new one). It returns non-nil if it got any new
messages."
(buffer-read-only nil)
;; Don't make undo records while getting mail.
(buffer-undo-list t)
- delete-files files file-last-names)
+ files file-last-names) ;; delete-files
;; Pull files off all-files onto files as long as there is
;; no name conflict. A conflict happens when two inbox
;; file names have the same last component.
@@ -1743,7 +1743,7 @@ not be a new one). It returns non-nil if it got any new
messages."
(while (not (looking-back "\n\n" (- (point) 2)))
(insert "\n")))
(setq found (or
- (rmail-get-new-mail-1 file-name files delete-files)
+ (rmail-get-new-mail-1 file-name files nil) ;;
delete-files
found))))
;; Move to the first new message unless we have other unseen
;; messages before it.
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index c3b351d..fd24bdc 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -1,4 +1,4 @@
-;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
+;;; rmailedit.el --- "RMAIL edit mode" Edit the current message -*-
lexical-binding: t; -*-
;; Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
@@ -38,8 +38,8 @@
(let ((map (make-sparse-keymap)))
;; Make a keymap that inherits text-mode-map.
(set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" 'rmail-cease-edit)
- (define-key map "\C-c\C-]" 'rmail-abort-edit)
+ (define-key map "\C-c\C-c" #'rmail-cease-edit)
+ (define-key map "\C-c\C-]" #'rmail-abort-edit)
map))
(declare-function rmail-summary-disable "rmailsum" ())
@@ -69,7 +69,7 @@ This function runs the hooks `text-mode-hook' and
`rmail-edit-mode-hook'.
(setq-local auto-save-include-big-deletions t)
;; If someone uses C-x C-s, don't clobber the rmail file (bug#2625).
(add-hook 'write-region-annotate-functions
- 'rmail-write-region-annotate nil t)
+ #'rmail-write-region-annotate nil t)
(run-mode-hooks 'rmail-edit-mode-hook)))
;; Rmail Edit mode is suitable only for specially formatted data.
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index 657b362..acbb588 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -1,4 +1,4 @@
-;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
+;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs -*-
lexical-binding: t; -*-
;; Copyright (C) 1985, 1988, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -73,7 +73,7 @@ according to the choice made, and returns a symbol."
(or (eq major-mode 'rmail-summary-mode)
(rmail-summary-exists)
(and (setq old (rmail-get-keywords))
- (mapc 'rmail-make-label (split-string old ", "))))
+ (mapc #'rmail-make-label (split-string old ", "))))
(completing-read (concat prompt
(if rmail-last-label
(concat " (default "
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index ab5b49a..cdb994a 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1,4 +1,4 @@
-;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
+;;; rmailmm.el --- MIME decoding and display stuff for RMAIL -*-
lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -78,6 +78,7 @@
(require 'rmail)
(require 'mail-parse)
(require 'message)
+(require 'cl-lib)
;;; User options.
@@ -101,8 +102,7 @@ all others are handled by `rmail-mime-bulk-handler'.
Note also that this alist is ignored when the variable
`rmail-enable-mime' is non-nil."
:type '(alist :key-type regexp :value-type (repeat function))
- :version "23.1"
- :group 'rmail-mime)
+ :version "23.1")
(defcustom rmail-mime-attachment-dirs-alist
`(("text/.*" "~/Documents")
@@ -114,8 +114,7 @@ The first item is a regular expression matching a
content-type.
The remaining elements are directories, in order of decreasing preference.
The first directory that exists is used."
:type '(alist :key-type regexp :value-type (repeat directory))
- :version "23.1"
- :group 'rmail-mime)
+ :version "23.1")
(defcustom rmail-mime-show-images 'button
"What to do with image attachments that Emacs is capable of displaying.
@@ -128,12 +127,11 @@ automatically display the image in the buffer."
(const :tag "No special treatment" nil)
(number :tag "Show if smaller than certain size")
(other :tag "Always show" show))
- :version "23.2"
- :group 'rmail-mime)
+ :version "23.2")
(defcustom rmail-mime-render-html-function
- (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr)
- ((executable-find "lynx") 'rmail-mime-render-html-lynx)
+ (cond ((fboundp 'libxml-parse-html-region) #'rmail-mime-render-html-shr)
+ ((executable-find "lynx") #'rmail-mime-render-html-lynx)
(t nil))
"Function to convert HTML to text.
Called with buffer containing HTML extracted from message in a
@@ -177,9 +175,12 @@ operations such as HTML decoding")
;;; MIME-entity object
-(defun rmail-mime-entity (type disposition transfer-encoding
- display header tagline body children handler
- &optional truncated)
+(cl-defstruct (rmail-mime-entity
+ (:copier nil) (:constructor nil)
+ (:constructor rmail-mime-entity
+ ( type disposition transfer-encoding
+ display header tagline body children handler
+ &optional truncated)
"Return a newly created MIME-entity object from arguments.
A MIME-entity is a vector of 10 elements:
@@ -210,12 +211,7 @@ Content-Transfer-Encoding, and is a lower-case string.
DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
the header, tag line, and body of the entity are displayed now,
and NEW indicates how their display should be updated.
-Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
-where each constituent element is a symbol for the corresponding
-item with these values:
- nil: not displayed
- t: displayed by the decoded presentation form
- raw: displayed by the raw MIME data (for the header and body only)
+Both elements are `rmail-mime-display' objects.
HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
END are markers that specify the region of the header or body lines
@@ -236,24 +232,13 @@ has just one child. Any other entity has no child.
HANDLER is a function to insert the entity according to DISPLAY.
It is called with one argument ENTITY.
-TRUNCATED is non-nil if the text of this entity was truncated."
-
- (vector type disposition transfer-encoding
- display header tagline body children handler truncated))
-
-;; Accessors for a MIME-entity object.
-(defsubst rmail-mime-entity-type (entity) (aref entity 0))
-(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
-(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
-(defsubst rmail-mime-entity-display (entity) (aref entity 3))
-(defsubst rmail-mime-entity-header (entity) (aref entity 4))
-(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
-(defsubst rmail-mime-entity-body (entity) (aref entity 6))
-(defsubst rmail-mime-entity-children (entity) (aref entity 7))
-(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
-(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
+TRUNCATED is non-nil if the text of this entity was truncated."))
+ type disposition transfer-encoding
+ display header tagline body children handler truncated)
+
(defsubst rmail-mime-entity-set-truncated (entity truncated)
- (aset entity 9 truncated))
+ (declare (obsolete (setf rmail-mime-entity-truncated) "28.1"))
+ (setf (rmail-mime-entity-truncated entity) truncated))
;;; Buttons
@@ -303,9 +288,16 @@ TRUNCATED is non-nil if the text of this entity was
truncated."
;; Display options returned by rmail-mime-entity-display.
;; Value is on of nil, t, raw.
-(defsubst rmail-mime-display-header (disp) (aref disp 0))
-(defsubst rmail-mime-display-tagline (disp) (aref disp 1))
-(defsubst rmail-mime-display-body (disp) (aref disp 2))
+(cl-defstruct (rmail-mime-display
+ (:copier rmail-mime--copy-display) (:constructor nil)
+ (:constructor rmail-mime--make-display (header tagline body)
+ "Make an object describing how to display.
+Each field's value is a symbol for the corresponding
+item with these values:
+ nil: not displayed
+ t: displayed by the decoded presentation form
+ raw: displayed by the raw MIME data (for the header and body only)."))
+ header tagline body)
(defun rmail-mime-entity-segment (pos &optional entity)
"Return a vector describing the displayed region of a MIME-entity at POS.
@@ -371,27 +363,30 @@ The value is a vector [INDEX HEADER TAGLINE BODY END],
where
(defun rmail-mime-shown-mode (entity)
"Make MIME-entity ENTITY display in the default way."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 (aref (rmail-mime-entity-header entity) 2))
- (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
- (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
+ (setf (rmail-mime-display-header new)
+ (aref (rmail-mime-entity-header entity) 2))
+ (setf (rmail-mime-display-tagline new)
+ (aref (rmail-mime-entity-tagline entity) 2))
+ (setf (rmail-mime-display-body new)
+ (aref (rmail-mime-entity-body entity) 2)))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-shown-mode child)))
(defun rmail-mime-hidden-mode (entity)
"Make MIME-entity ENTITY display in hidden mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 nil)
- (aset new 1 t)
- (aset new 2 nil))
+ (setf (rmail-mime-display-header new) nil)
+ (setf (rmail-mime-display-tagline new) t)
+ (setf (rmail-mime-display-body new) nil))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-hidden-mode child)))
(defun rmail-mime-raw-mode (entity)
"Make MIME-entity ENTITY display in raw mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 'raw)
- (aset new 1 nil)
- (aset new 2 'raw))
+ (setf (rmail-mime-display-header new) 'raw)
+ (setf (rmail-mime-display-tagline new) nil)
+ (setf (rmail-mime-display-body new) 'raw))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-raw-mode child)))
@@ -404,8 +399,8 @@ Use `raw' for raw mode, and any other non-nil value for
decoded mode."
(current (aref (rmail-mime-entity-display entity) 0))
(segment (rmail-mime-entity-segment pos entity)))
(if (or (eq state 'raw)
- (and (not state)
- (not (eq (rmail-mime-display-header current) 'raw))))
+ (not (or state
+ (eq (rmail-mime-display-header current) 'raw))))
;; Enter the raw mode.
(rmail-mime-raw-mode entity)
;; Enter the shown mode.
@@ -439,7 +434,7 @@ Use `raw' for raw mode, and any other non-nil value for
decoded mode."
;; header.
(if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 t))))
+ (setf (rmail-mime-display-header new) t))))
;; Query as a warning before showing if truncated.
(if (and (not (stringp entity))
(rmail-mime-entity-truncated entity))
@@ -448,7 +443,8 @@ Use `raw' for raw mode, and any other non-nil value for
decoded mode."
;; Enter the shown mode.
(rmail-mime-shown-mode entity)
;; Force this body shown.
- (aset (aref (rmail-mime-entity-display entity) 1) 2 t))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (setf (rmail-mime-display-body new) t)))
(let ((inhibit-read-only t)
(modified (buffer-modified-p))
(rmail-mime-mbox-buffer rmail-view-buffer)
@@ -458,9 +454,9 @@ Use `raw' for raw mode, and any other non-nil value for
decoded mode."
(rmail-mime-insert entity)
(restore-buffer-modified-p modified))))))
-(define-key rmail-mode-map "\t" 'forward-button)
-(define-key rmail-mode-map [backtab] 'backward-button)
-(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
+(define-key rmail-mode-map "\t" #'forward-button)
+(define-key rmail-mode-map [backtab] #'backward-button)
+(define-key rmail-mode-map "\r" #'rmail-mime-toggle-hidden)
;;; Handlers
@@ -483,7 +479,7 @@ to the tag line."
(when item
(if (stringp item)
(insert item)
- (apply 'insert-button item))))
+ (apply #'insert-button item))))
;; Follow the tagline by an empty line to make it a separate
;; paragraph, so that the paragraph direction of the following text
;; is determined based on that text.
@@ -495,8 +491,10 @@ to the tag line."
(modified (buffer-modified-p))
;; If we are going to show the body, the new button label is
;; "Hide". Otherwise, it's "Show".
- (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
- "Show"))
+ (label
+ (if (rmail-mime-display-body
+ (aref (rmail-mime-entity-display entity) 1))
+ "Hide" "Show"))
(button (next-button (point))))
;; Go to the second character of the button "Show" or "Hide".
(goto-char (1+ (button-start button)))
@@ -556,9 +554,10 @@ HEADER is a header component of a MIME-entity object (see
(rmail-mime-insert-text
(rmail-mime-entity content-type content-disposition
content-transfer-encoding
- (vector (vector nil nil nil) (vector nil nil t))
+ (vector (rmail-mime--make-display nil nil nil)
+ (rmail-mime--make-display nil nil t))
(vector nil nil nil) (vector "" (cons nil nil) t)
- (vector nil nil nil) nil 'rmail-mime-insert-text))
+ (vector nil nil nil) nil #'rmail-mime-insert-text))
t)
(defun rmail-mime-insert-decoded-text (entity)
@@ -592,7 +591,7 @@ HEADER is a header component of a MIME-entity object (see
(let ((current (aref (rmail-mime-entity-display entity) 0))
(new (aref (rmail-mime-entity-display entity) 1))
(header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
(body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
@@ -634,7 +633,7 @@ HEADER is a header component of a MIME-entity object (see
(defun rmail-mime-insert-image (entity)
"Decode and insert the image body of MIME-entity ENTITY."
- (let* ((content-type (car (rmail-mime-entity-type entity)))
+ (let* (;; (content-type (car (rmail-mime-entity-type entity)))
(bulk-data (aref (rmail-mime-entity-tagline entity) 1))
(body (rmail-mime-entity-body entity))
data)
@@ -709,6 +708,9 @@ HEADER is a header component of a MIME-entity object (see
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
+(defvar shr-inhibit-images)
+(defvar shr-width)
+
(defun rmail-mime-render-html-shr (source-buffer)
(let ((dom (with-current-buffer source-buffer
(libxml-parse-html-region (point-min) (point-max))))
@@ -759,7 +761,8 @@ For images that Emacs is capable of displaying, the behavior
depends upon the value of `rmail-mime-show-images'."
(rmail-mime-insert-bulk
(rmail-mime-entity content-type content-disposition
content-transfer-encoding
- (vector (vector nil nil nil) (vector nil t nil))
+ (vector (rmail-mime--make-display nil nil nil)
+ (rmail-mime--make-display nil t nil))
(vector nil nil nil) (vector "" (cons nil nil) t)
(vector nil nil nil) nil 'rmail-mime-insert-bulk)))
@@ -1024,9 +1027,10 @@ The other arguments are the same as
`rmail-mime-multipart-handler'."
nil (format "%s/%d" parse-tag index)
content-type content-disposition)))
;; Display a tagline.
- (aset (aref (rmail-mime-entity-display child) 1) 1
+ (setf (rmail-mime-display-tagline
+ (aref (rmail-mime-entity-display child) 1))
(aset (rmail-mime-entity-tagline child) 2 t))
- (rmail-mime-entity-set-truncated child truncated)
+ (setf (rmail-mime-entity-truncated child) truncated)
(push child entities)))
(delete-region end next)
@@ -1072,8 +1076,8 @@ The other arguments are the same as
`rmail-mime-multipart-handler'."
(let ((current (aref (rmail-mime-entity-display entity) 0))
(new (aref (rmail-mime-entity-display entity) 1))
(header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
- (body (rmail-mime-entity-body entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
+ ;; (body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
;; header
@@ -1169,13 +1173,11 @@ The parsed header value:
content-transfer-encoding))
(save-restriction
(widen)
- (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
- current new)
+ (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity)))
(when entity
- (setq current (aref (rmail-mime-entity-display entity) 0)
- new (aref (rmail-mime-entity-display entity) 1))
- (dotimes (i 3)
- (aset current i (aref new i)))))))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (setf (aref (rmail-mime-entity-display entity) 0)
+ (rmail-mime--copy-display new)))))))
(defun rmail-mime-show (&optional show-headers)
"Handle the current buffer as a MIME message.
@@ -1240,13 +1242,15 @@ modified."
(header (vector (point-min-marker) hdr-end nil))
(tagline (vector parse-tag (cons nil nil) t))
(body (vector hdr-end (point-max-marker) is-inline))
- (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
+ (new (rmail-mime--make-display
+ (aref header 2) (aref tagline 2) (aref body 2)))
children handler entity)
(cond ((string-match "multipart/.*" (car content-type))
(save-restriction
(narrow-to-region (1- end) (point-max))
(if (zerop (length parse-tag)) ; top level of message
- (aset new 1 (aset tagline 2 nil))) ; don't show tagline
+ (setf (rmail-mime-display-tagline new)
+ (aset tagline 2 nil))) ; don't show tagline
(setq children (rmail-mime-process-multipart
content-type
content-disposition
@@ -1260,37 +1264,38 @@ modified."
'("text/plain") '("inline")))
(msg-new (aref (rmail-mime-entity-display msg) 1)))
;; Show header of the child.
- (aset msg-new 0 t)
+ (setf (rmail-mime-display-header msg-new) t)
(aset (rmail-mime-entity-header msg) 2 t)
;; Hide tagline of the child.
- (aset msg-new 1 nil)
+ (setf (rmail-mime-display-tagline msg-new) nil)
(aset (rmail-mime-entity-tagline msg) 2 nil)
(setq children (list msg)
handler 'rmail-mime-insert-multipart))))
((and is-inline (string-match "text/html" (car content-type)))
;; Display tagline, so part can be detached
- (aset new 1 (aset tagline 2 t))
- (aset new 2 (aset body 2 t)) ; display body also.
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
+ (setf (rmail-mime-display-body new) (aset body 2 t)) ; display
body also.
(setq handler 'rmail-mime-insert-bulk))
;; Inline non-HTML text
((and is-inline (string-match "text/" (car content-type)))
;; Don't need a tagline.
- (aset new 1 (aset tagline 2 nil))
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 nil))
(setq handler 'rmail-mime-insert-text))
(t
;; Force hidden mode.
- (aset new 1 (aset tagline 2 t))
- (aset new 2 (aset body 2 nil))
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
+ (setf (rmail-mime-display-body new) (aset body 2 nil))
(setq handler 'rmail-mime-insert-bulk)))
- (setq entity (rmail-mime-entity content-type
- content-disposition
- content-transfer-encoding
- (vector (vector nil nil nil) new)
- header tagline body children handler))
+ (setq entity (rmail-mime-entity
+ content-type
+ content-disposition
+ content-transfer-encoding
+ (vector (rmail-mime--make-display nil nil nil) new)
+ header tagline body children handler))
(if (and (eq handler 'rmail-mime-insert-bulk)
(rmail-mime-set-bulk-data entity))
;; Show the body.
- (aset new 2 (aset body 2 t)))
+ (setf (rmail-mime-display-body new) (aset body 2 t)))
entity)
;; Hide headers and handle the part.
@@ -1324,7 +1329,8 @@ If an error occurs, return an error message string."
'("text/plain") '("inline")))
(new (aref (rmail-mime-entity-display entity) 1)))
;; Show header.
- (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
+ (setf (rmail-mime-display-header new)
+ (aset (rmail-mime-entity-header entity) 2 t))
entity)))
(error (format "%s" err)))))
@@ -1339,7 +1345,7 @@ available."
;; Not a raw-mode. Each handler should handle it.
(funcall (rmail-mime-entity-handler entity) entity)
(let ((header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
(body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
@@ -1370,15 +1376,15 @@ available."
(aref body 0) (aref body 1))
(or (bolp) (insert "\n")))
(put-text-property beg (point) 'rmail-mime-entity entity)))))
- (dotimes (i 3)
- (aset current i (aref new i)))))
+ (setf (aref (rmail-mime-entity-display entity) 0)
+ (rmail-mime--copy-display new))))
(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
"Major mode used in `rmail-mime' buffers."
(setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
;;;###autoload
-(defun rmail-mime (&optional arg state)
+(defun rmail-mime (&optional _arg state)
"Toggle the display of a MIME message.
The actual behavior depends on the value of `rmail-enable-mime'.
@@ -1442,7 +1448,7 @@ The arguments ARG and STATE have no effect in this case."
(rmail-mime-view-buffer rmail-view-buffer)
(rmail-mime-coding-system nil))
;; If ENTITY is not a vector, it is a string describing an error.
- (if (vectorp entity)
+ (if (rmail-mime-entity-p entity)
(with-current-buffer rmail-mime-view-buffer
(erase-buffer)
;; This condition-case is for catching an error in the
@@ -1530,7 +1536,7 @@ This is the usual value of
`rmail-insert-mime-forwarded-message-function'."
(rmail-mime-view-buffer rmail-view-buffer)
(header-end (save-excursion
(re-search-forward "^$" nil 'move) (point)))
- (body-end (point-max))
+ ;; (body-end (point-max))
(entity (rmail-mime-parse)))
(or
;; At first, just search the headers.
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index ef5f3c3..673b2c5 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -1,4 +1,4 @@
-;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
+;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
-*- lexical-binding: t; -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -45,7 +45,7 @@ This applies only to the current session."
(nreverse (mail-parse-comma-list)))))
(when (or (not rmail-inbox-list)
(y-or-n-p (concat "Replace "
- (mapconcat 'identity
+ (mapconcat #'identity
rmail-inbox-list
", ")
"? ")))
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 9305a48..eb8590f 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,4 +1,4 @@
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
+;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
-*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1987, 1993-1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -81,14 +81,14 @@ This uses `rmail-output-file-alist'."
(widen)
(narrow-to-region beg end)
(let ((tail rmail-output-file-alist)
- answer err)
+ answer) ;; err
;; Suggest a file based on a pattern match.
(while (and tail (not answer))
(goto-char (point-min))
(if (re-search-forward (caar tail) nil t)
(setq answer
(condition-case err
- (eval (cdar tail))
+ (eval (cdar tail) t)
(error
(display-warning
'rmail-output
@@ -197,7 +197,8 @@ display message number MSG."
(defun rmail-convert-to-babyl-format ()
"Convert the mbox message in the current buffer to Babyl format."
- (let ((count 0) (start (point-min))
+ (let (;; (count 0)
+ (start (point-min))
(case-fold-search nil)
(buffer-undo-list t))
(goto-char (point-min))
@@ -357,7 +358,7 @@ unless NOMSG is a symbol (neither nil nor t).
AS-SEEN is non-nil if we are copying the message \"as seen\"."
(let ((case-fold-search t)
encrypted-file-name
- from date)
+ ) ;; from date
(goto-char (point-min))
;; Preserve the Mail-From and MIME-Version fields
;; even if they have been pruned.
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index 2c42e6c..1669c8c 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -1,4 +1,4 @@
-;;; rmailsort.el --- Rmail: sort messages
+;;; rmailsort.el --- Rmail: sort messages -*- lexical-binding: t; -*-
;; Copyright (C) 1990, 1993-1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -142,7 +142,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse
order."
"\\(,\\|\\'\\)")
labelvec))
(setq labels (substring labels (match-end 0))))
- (setq labelvec (apply 'vector (nreverse labelvec))
+ (setq labelvec (apply #'vector (nreverse labelvec))
nmax (length labelvec))
(rmail-sort-messages reverse
;; If no labels match, returns nmax; if they
@@ -205,7 +205,7 @@ Numeric keys are sorted numerically, all others as strings."
(inhibit-read-only t)
(current-message nil)
(msgnum 1)
- (msginfo nil)
+ ;; (msginfo nil)
(undo (not (eq buffer-undo-list t))))
;; There's little hope that we can easily undo after that.
(buffer-disable-undo (current-buffer))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 5526f2f..ac5e8c3 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -186,7 +186,7 @@ mean \"try again\"."
(defvar smtpmail-auth-supported '(cram-md5 plain login)
"List of supported SMTP AUTH mechanisms.
The list is in preference order.
-Every element should have a matching `cl-defmethod' for
+Every element should have a matching `cl-defmethod'
for `smtpmail-try-auth-method'.")
(defvar smtpmail-mail-address nil
@@ -326,7 +326,7 @@ for `smtpmail-try-auth-method'.")
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line)
+ (if (eval mail-mailer-swallows-blank-line t)
(newline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
@@ -627,7 +627,7 @@ USER and PASSWORD should be non-nil."
(= code (car response)))))
(defun smtpmail-response-text (response)
- (mapconcat 'identity (cdr response) "\n"))
+ (mapconcat #'identity (cdr response) "\n"))
(defun smtpmail-query-smtp-server ()
"Query for an SMTP server and try to contact it.
@@ -741,7 +741,7 @@ Returns an error if the server cannot be contacted."
"Unable to contact server")))
;; set the send-filter
- (set-process-filter process 'smtpmail-process-filter)
+ (set-process-filter process #'smtpmail-process-filter)
(let* ((greeting (plist-get (cdr result) :greeting))
(code (smtpmail-response-code greeting)))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 99ac41d..dc1c641 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1,4 +1,4 @@
-;;; supercite.el --- minor mode for citing mail and news replies
+;;; supercite.el --- minor mode for citing mail and news replies -*-
lexical-binding: t; -*-
;; Copyright (C) 1993, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -527,71 +527,71 @@ string."
(defvar sc-T-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'sc-S-preferred-attribution-list)
- (define-key map "b" 'sc-T-mail-nuke-blank-lines)
- (define-key map "c" 'sc-T-confirm-always)
- (define-key map "d" 'sc-T-downcase)
- (define-key map "e" 'sc-T-electric-references)
- (define-key map "f" 'sc-T-auto-fill-region)
- (define-key map "h" 'sc-T-describe)
- (define-key map "l" 'sc-S-cite-region-limit)
- (define-key map "n" 'sc-S-mail-nuke-mail-headers)
- (define-key map "N" 'sc-S-mail-header-nuke-list)
- (define-key map "o" 'sc-T-electric-circular)
- (define-key map "p" 'sc-S-preferred-header-style)
- (define-key map "s" 'sc-T-nested-citation)
- (define-key map "u" 'sc-T-use-only-preferences)
- (define-key map "w" 'sc-T-fixup-whitespace)
- (define-key map "?" 'sc-T-describe)
+ (define-key map "a" #'sc-S-preferred-attribution-list)
+ (define-key map "b" #'sc-T-mail-nuke-blank-lines)
+ (define-key map "c" #'sc-T-confirm-always)
+ (define-key map "d" #'sc-T-downcase)
+ (define-key map "e" #'sc-T-electric-references)
+ (define-key map "f" #'sc-T-auto-fill-region)
+ (define-key map "h" #'sc-T-describe)
+ (define-key map "l" #'sc-S-cite-region-limit)
+ (define-key map "n" #'sc-S-mail-nuke-mail-headers)
+ (define-key map "N" #'sc-S-mail-header-nuke-list)
+ (define-key map "o" #'sc-T-electric-circular)
+ (define-key map "p" #'sc-S-preferred-header-style)
+ (define-key map "s" #'sc-T-nested-citation)
+ (define-key map "u" #'sc-T-use-only-preferences)
+ (define-key map "w" #'sc-T-fixup-whitespace)
+ (define-key map "?" #'sc-T-describe)
map)
"Keymap for sub-keymap of setting and toggling functions.")
(defvar sc-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "c" 'sc-cite-region)
- (define-key map "f" 'sc-mail-field-query)
- (define-key map "g" 'sc-mail-process-headers)
- (define-key map "h" 'sc-describe)
- (define-key map "i" 'sc-insert-citation)
- (define-key map "o" 'sc-open-line)
- (define-key map "r" 'sc-recite-region)
- (define-key map "\C-p" 'sc-raw-mode-toggle)
- (define-key map "u" 'sc-uncite-region)
- (define-key map "w" 'sc-insert-reference)
- (define-key map "\C-t" sc-T-keymap)
- (define-key map "?" 'sc-describe)
+ (define-key map "c" #'sc-cite-region)
+ (define-key map "f" #'sc-mail-field-query)
+ (define-key map "g" #'sc-mail-process-headers)
+ (define-key map "h" #'sc-describe)
+ (define-key map "i" #'sc-insert-citation)
+ (define-key map "o" #'sc-open-line)
+ (define-key map "r" #'sc-recite-region)
+ (define-key map "\C-p" #'sc-raw-mode-toggle)
+ (define-key map "u" #'sc-uncite-region)
+ (define-key map "w" #'sc-insert-reference)
+ (define-key map "\C-t" sc-T-keymap)
+ (define-key map "?" #'sc-describe)
map)
"Keymap for Supercite quasi-mode.")
(defvar sc-electric-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "p" 'sc-eref-prev)
- (define-key map "n" 'sc-eref-next)
- (define-key map "s" 'sc-eref-setn)
- (define-key map "j" 'sc-eref-jump)
- (define-key map "x" 'sc-eref-abort)
- (define-key map "q" 'sc-eref-abort)
- (define-key map "\r" 'sc-eref-exit)
- (define-key map "\n" 'sc-eref-exit)
- (define-key map "g" 'sc-eref-goto)
- (define-key map "?" 'describe-mode)
- (define-key map "\C-h" 'describe-mode)
- (define-key map [f1] 'describe-mode)
- (define-key map [help] 'describe-mode)
+ (define-key map "p" #'sc-eref-prev)
+ (define-key map "n" #'sc-eref-next)
+ (define-key map "s" #'sc-eref-setn)
+ (define-key map "j" #'sc-eref-jump)
+ (define-key map "x" #'sc-eref-abort)
+ (define-key map "q" #'sc-eref-abort)
+ (define-key map "\r" #'sc-eref-exit)
+ (define-key map "\n" #'sc-eref-exit)
+ (define-key map "g" #'sc-eref-goto)
+ (define-key map "?" #'describe-mode)
+ (define-key map "\C-h" #'describe-mode)
+ (define-key map [f1] #'describe-mode)
+ (define-key map [help] #'describe-mode)
map)
"Keymap for `sc-electric-mode' electric references mode.")
(defvar sc-minibuffer-local-completion-map
(let ((map (copy-keymap minibuffer-local-completion-map)))
- (define-key map "\C-t" 'sc-toggle-fn)
- (define-key map " " 'self-insert-command)
+ (define-key map "\C-t" #'sc-toggle-fn)
+ (define-key map " " #'self-insert-command)
map)
"Keymap for minibuffer confirmation of attribution strings.")
(defvar sc-minibuffer-local-map
(let ((map (copy-keymap minibuffer-local-map)))
- (define-key map "\C-t" 'sc-toggle-fn)
+ (define-key map "\C-t" #'sc-toggle-fn)
map)
"Keymap for minibuffer confirmation of attribution strings.")
@@ -1109,6 +1109,8 @@ Only used during confirmation."
(setq sc-attrib-or-cite (not sc-attrib-or-cite))
(throw 'sc-reconfirm t))
+(defvar completer-disable) ;; From some `completer.el' package.
+
(defun sc-select-attribution ()
"Select an attribution from `sc-attributions'.
@@ -1150,7 +1152,7 @@ to the auto-selected attribution string."
(setq attribution attrib
attriblist nil))
((listp attrib)
- (setq attribution (eval attrib))
+ (setq attribution (eval attrib t))
(if (stringp attribution)
(setq attriblist nil)
(setq attribution nil
@@ -1593,7 +1595,7 @@ error occurs."
(let ((ref (nth sc-eref-style sc-rewrite-header-list)))
(condition-case err
(progn
- (eval ref)
+ (eval ref t)
(let ((lines (count-lines (point-min) (point-max))))
(or nomsg (message "Ref header %d [%d line%s]: %s"
sc-eref-style lines
@@ -1767,8 +1769,7 @@ querying you by typing `C-h'. Note that the format is
changed
slightly from that used by `set-variable' -- the current value is
printed just after the variable's name instead of at the bottom of the
help window."
- (let* ((minibuffer-help-form '(funcall myhelp))
- (myhelp
+ (let* ((myhelp
(lambda ()
(with-output-to-temp-buffer "*Help*"
(prin1 var)
@@ -1784,7 +1785,8 @@ help window."
1))
(with-current-buffer standard-output
(help-mode))
- nil))))
+ nil)))
+ (minibuffer-help-form `(funcall #',myhelp)))
(set var (eval-minibuffer (format "Set %s to value: " var)))))
(defmacro sc-toggle-symbol (rootname)
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index a573c8a..9ebffef 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -1,4 +1,4 @@
-;;; uce.el --- facilitate reply to unsolicited commercial email
+;;; uce.el --- facilitate reply to unsolicited commercial email -*-
lexical-binding: t; -*-
;; Copyright (C) 1996, 1998, 2000-2021 Free Software Foundation, Inc.
@@ -127,14 +127,12 @@
"A symbol indicating which mail reader you are using.
Choose from: `gnus', `rmail'."
:type '(choice (const gnus) (const rmail))
- :version "20.3"
- :group 'uce)
+ :version "20.3")
(defcustom uce-setup-hook nil
"Hook to run after UCE rant message is composed.
This hook is run after `mail-setup-hook', which is run as well."
- :type 'hook
- :group 'uce)
+ :type 'hook)
(defcustom uce-message-text
"Recently, I have received an Unsolicited Commercial E-mail from you.
@@ -180,36 +178,31 @@ on beginning of some line from the spamming list. So,
when you set it
up, it might be a good idea to actually use this feature.
Value nil means insert no text by default, lets you type it in."
- :type '(choice (const nil) string)
- :group 'uce)
+ :type '(choice (const nil) string))
(defcustom uce-uce-separator
"----- original unsolicited commercial email follows -----"
"Line that will begin quoting of the UCE.
Value nil means use no separator."
- :type '(choice (const nil) string)
- :group 'uce)
+ :type '(choice (const nil) string))
(defcustom uce-signature mail-signature
"Text to put as your signature after the note to UCE sender.
Value nil means none, t means insert `~/.signature' file (if it happens
to exist), if this variable is a string this string will be inserted
as your signature."
- :type '(choice (const nil) (const t) string)
- :group 'uce)
+ :type '(choice (const nil) (const t) string))
(defcustom uce-default-headers
"Errors-To: nobody@localhost\nPrecedence: bulk\n"
"Additional headers to use when responding to a UCE with
\\[uce-reply-to-uce].
These are mostly meant for headers that prevent delivery errors reporting."
- :type '(choice (const nil) string)
- :group 'uce)
+ :type '(choice (const nil) string))
(defcustom uce-subject-line
"Spam alert: unsolicited commercial e-mail"
"Subject of the message that will be sent in response to a UCE."
- :type 'string
- :group 'uce)
+ :type 'string)
;; End of user options.
@@ -221,7 +214,7 @@ These are mostly meant for headers that prevent delivery
errors reporting."
(declare-function rmail-toggle-header "rmail" (&optional arg))
;;;###autoload
-(defun uce-reply-to-uce (&optional ignored)
+(defun uce-reply-to-uce (&optional _ignored)
"Compose a reply to unsolicited commercial email (UCE).
Sets up a reply buffer addressed to: the sender, his postmaster,
his abuse@ address, and the postmaster of the mail relay used.
@@ -367,7 +360,7 @@ You might need to set `uce-mail-reader' before using this."
;; functions in mail-mode, etc.
(run-hooks 'mail-setup-hook 'uce-setup-hook))))
-(defun uce-insert-ranting (&optional ignored)
+(defun uce-insert-ranting (&optional _ignored)
"Insert text of the usual reply to UCE into current buffer."
(interactive "P")
(insert uce-message-text))
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 34de416..5b1abd5 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -1,4 +1,4 @@
-;;; unrmail.el --- convert Rmail Babyl files to mbox files
+;;; unrmail.el --- convert Rmail Babyl files to mbox files -*-
lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@@ -235,7 +235,7 @@ The variable `unrmail-mbox-format' controls which mbox
format to use."
;; Insert the `From ' line.
(insert mail-from)
;; Record the keywords and attributes in our special way.
- (insert "X-RMAIL-ATTRIBUTES: " (apply 'string attrs) "\n")
+ (insert "X-RMAIL-ATTRIBUTES: " (apply #'string attrs) "\n")
(when keywords
(insert "X-RMAIL-KEYWORDS: " keywords "\n"))
;; Convert From to >From, etc.
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index 8155c9d..14fbb51 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -1,4 +1,4 @@
-;;; mouse-copy.el --- one-click text copy and move
+;;; mouse-copy.el --- one-click text copy and move -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -213,8 +213,7 @@ by johnh@ficus.cs.ucla.edu."
(if (mouse-drag-secondary start-event)
(progn
(mouse-kill-preserving-secondary)
- (insert (gui-get-selection 'SECONDARY))))
-)
+ (insert (gui-get-selection 'SECONDARY)))))
(provide 'mouse-copy)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index b2960a4..b424b6e 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -1,4 +1,4 @@
-;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
+;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling -*-
lexical-binding: t -*-
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index fa13dd5..86b5d44 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -3716,7 +3716,7 @@ so return the size on the remote host exactly. See RFC
3659."
(binary (or (ange-ftp-binary-file filename)
(ange-ftp-binary-file newname)))
temp1
- temp2)
+ ) ;; temp2
;; check to see if we can overwrite
(if (or (not ok-if-already-exists)
@@ -3750,7 +3750,7 @@ so return the size on the remote host exactly. See RFC
3659."
filename newname binary msg
f-parsed f-host f-user f-name f-abbr
t-parsed t-host t-user t-name t-abbr
- temp1 temp2 cont nowait)
+ temp1 nil cont nowait) ;; temp2
nowait))
;; filename wasn't remote. newname must be remote. call the
@@ -6111,8 +6111,7 @@ Other orders of $ and _ seem to all work just fine.")
(1- (match-end 2)))))
(filename (if (match-beginning 3)
(substring name (match-beginning 3)))))
- (if (and (boundp 'filename)
- (stringp filename)
+ (if (and (stringp filename)
(string-match "[#@].+" filename))
(setq filename (concat ange-ftp-bs2000-special-prefix
(substring filename 1))))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 58f01d5..1c98335 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -826,7 +826,7 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it
instead."
(if (and file-name (file-exists-p file-name))
(delete-file file-name))))
-(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
+(add-hook 'kill-buffer-hook #'browse-url-delete-temp-file)
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
@@ -1064,7 +1064,7 @@ xdg-open is a desktop utility that calls your preferred
web browser."
(executable-find "xdg-open")))
;;;###autoload
-(defun browse-url-xdg-open (url &optional ignored)
+(defun browse-url-xdg-open (url &optional _ignored)
"Pass the specified URL to the \"xdg-open\" command.
xdg-open is a desktop utility that calls your preferred web browser.
The optional argument IGNORED is not used."
@@ -1095,7 +1095,7 @@ used instead of `browse-url-new-window-flag'."
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process
- (apply 'start-process
+ (apply #'start-process
(concat "netscape " url) nil
browse-url-netscape-program
(append
@@ -1125,7 +1125,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
(message "Starting %s..." browse-url-netscape-program)
- (apply 'start-process (concat "netscape" url) nil
+ (apply #'start-process (concat "netscape" url) nil
browse-url-netscape-program
(append browse-url-netscape-startup-arguments (list url))))))
@@ -1144,7 +1144,7 @@ How depends on `browse-url-netscape-version'."
"Send a remote control command to Netscape."
(declare (obsolete nil "25.1"))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process "netscape" nil
+ (apply #'start-process "netscape" nil
browse-url-netscape-program
(append browse-url-netscape-arguments
(list "-remote" command)))))
@@ -1170,7 +1170,7 @@ used instead of `browse-url-new-window-flag'."
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process
- (apply 'start-process
+ (apply #'start-process
(concat "mozilla " url) nil
browse-url-mozilla-program
(append
@@ -1196,7 +1196,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Mozilla is not running - start it
(message "Starting %s..." browse-url-mozilla-program)
- (apply 'start-process (concat "mozilla " url) nil
+ (apply #'start-process (concat "mozilla " url) nil
browse-url-mozilla-program
(append browse-url-mozilla-startup-arguments (list url))))))
@@ -1219,7 +1219,7 @@ instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process
+ (apply #'start-process
(concat "firefox " url) nil
browse-url-firefox-program
(append
@@ -1242,7 +1242,7 @@ The optional argument NEW-WINDOW is not used."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process
+ (apply #'start-process
(concat "chromium " url) nil
browse-url-chromium-program
(append
@@ -1260,7 +1260,7 @@ The optional argument NEW-WINDOW is not used."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process
+ (apply #'start-process
(concat "google-chrome " url) nil
browse-url-chrome-program
(append
@@ -1290,7 +1290,7 @@ used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
- (process (apply 'start-process
+ (process (apply #'start-process
(concat "galeon " url)
nil
browse-url-galeon-program
@@ -1315,7 +1315,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
(message "Starting %s..." browse-url-galeon-program)
- (apply 'start-process (concat "galeon " url) nil
+ (apply #'start-process (concat "galeon " url) nil
browse-url-galeon-program
(append browse-url-galeon-startup-arguments (list url))))))
@@ -1338,7 +1338,7 @@ used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
- (process (apply 'start-process
+ (process (apply #'start-process
(concat "epiphany " url)
nil
browse-url-epiphany-program
@@ -1362,7 +1362,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Epiphany is not running - start it
(message "Starting %s..." browse-url-epiphany-program)
- (apply 'start-process (concat "epiphany " url) nil
+ (apply #'start-process (concat "epiphany " url) nil
browse-url-epiphany-program
(append browse-url-epiphany-startup-arguments (list url))))))
@@ -1403,7 +1403,7 @@ When called non-interactively, optional second argument
NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
- (apply 'start-process (concat "gnome-moz-remote " url)
+ (apply #'start-process (concat "gnome-moz-remote " url)
nil
browse-url-gnome-moz-program
(append
@@ -1437,7 +1437,7 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process (format "conkeror %s" url)
+ (apply #'start-process (format "conkeror %s" url)
nil
browse-url-conkeror-program
(append
@@ -1487,7 +1487,7 @@ The `browse-url-gnudoit-program' program is used with
options given by
`browse-url-gnudoit-args'. Default to the URL around or before point."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
- (apply 'start-process (concat "gnudoit:" url) nil
+ (apply #'start-process (concat "gnudoit:" url) nil
browse-url-gnudoit-program
(append browse-url-gnudoit-args
(list (concat "(w3-fetch \"" url "\")")
@@ -1667,7 +1667,7 @@ don't offer a form of remote control."
(interactive (browse-url-interactive-arg "URL: "))
(if (not browse-url-generic-program)
(error "No browser defined (`browse-url-generic-program')"))
- (apply 'call-process browse-url-generic-program nil
+ (apply #'call-process browse-url-generic-program nil
0 nil
(append browse-url-generic-args (list url))))
@@ -1742,9 +1742,9 @@ from `browse-url-elinks-wrapper'."
(defvar browse-url-button-map
(let ((map (make-sparse-keymap)))
- (define-key map "\r" 'browse-url-button-open)
- (define-key map [mouse-2] 'browse-url-button-open)
- (define-key map "w" 'browse-url-button-copy)
+ (define-key map "\r" #'browse-url-button-open)
+ (define-key map [mouse-2] #'browse-url-button-open)
+ (define-key map "w" #'browse-url-button-copy)
map)
"The keymap used for browse-url buttons.")
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index aba3698..5938b81 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -76,7 +76,7 @@ You can specify here:
- dict.org: Only use dict.org
- User-defined: You can specify your own server here"
:group 'dictionary
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type '(choice (const :tag "Automatic" nil)
(const :tag "localhost" "localhost")
(const :tag "dict.org" "dict.org")
@@ -88,7 +88,7 @@ You can specify here:
"The port of the dictionary server.
This port is propably always 2628 so there should be no need to modify it."
:group 'dictionary
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'number
:version "28.1")
@@ -189,7 +189,7 @@ where the current word was found."
nil
"Connects via a HTTP proxy using the CONNECT command when not nil."
:group 'dictionary-proxy
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'boolean
:version "28.1")
@@ -197,7 +197,7 @@ where the current word was found."
"proxy"
"The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'string
:version "28.1")
@@ -205,7 +205,7 @@ where the current word was found."
3128
"The port of the proxy server, used only when `dictionary-use-http-proxy' is
set."
:group 'dictionary-proxy
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'number
:version "28.1")
@@ -331,19 +331,19 @@ is utf-8"
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
- (define-key map "q" 'dictionary-close)
- (define-key map "h" 'dictionary-help)
- (define-key map "s" 'dictionary-search)
- (define-key map "d" 'dictionary-lookup-definition)
- (define-key map "D" 'dictionary-select-dictionary)
- (define-key map "M" 'dictionary-select-strategy)
- (define-key map "m" 'dictionary-match-words)
- (define-key map "l" 'dictionary-previous)
- (define-key map "n" 'forward-button)
- (define-key map "p" 'backward-button)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map (read-kbd-macro "M-SPC") 'scroll-down-command)
+ (define-key map "q" #'dictionary-close)
+ (define-key map "h" #'dictionary-help)
+ (define-key map "s" #'dictionary-search)
+ (define-key map "d" #'dictionary-lookup-definition)
+ (define-key map "D" #'dictionary-select-dictionary)
+ (define-key map "M" #'dictionary-select-strategy)
+ (define-key map "m" #'dictionary-match-words)
+ (define-key map "l" #'dictionary-previous)
+ (define-key map "n" #'forward-button)
+ (define-key map "p" #'backward-button)
+ (define-key map " " #'scroll-up-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map (read-kbd-macro "M-SPC") #'scroll-down-command)
map)
"Keymap for the dictionary mode.")
@@ -413,7 +413,7 @@ This is a quick reference to this mode describing the
default key bindings:
(make-local-variable 'dictionary-default-dictionary)
(make-local-variable 'dictionary-default-strategy)
- (add-hook 'kill-buffer-hook 'dictionary-close t t)
+ (add-hook 'kill-buffer-hook #'dictionary-close t t)
(run-hooks 'dictionary-mode-hook))
;;;###autoload
@@ -535,7 +535,7 @@ The connection takes the proxy setting in customization
group
;; Dealing with closing the buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun dictionary-close (&rest ignored)
+(defun dictionary-close (&rest _ignored)
"Close the current dictionary buffer and its connection."
(interactive)
(if (eq major-mode 'dictionary-mode)
@@ -669,7 +669,7 @@ previous state."
(setq dictionary-positions (cons (point) (window-start))))
;; Restore the previous state
-(defun dictionary-restore-state (&rest ignored)
+(defun dictionary-restore-state (&rest _ignored)
"Restore the state just before the last operation."
(let ((position (pop dictionary-position-stack))
(data (pop dictionary-data-stack)))
@@ -829,7 +829,7 @@ The DICTIONARY is only used for decoding the bytes to
display the DESCRIPTION."
(defun dictionary-display-word-definition (reply word dictionary)
"Insert the definition in REPLY for the current WORD from DICTIONARY.
It will replace links which are found in the REPLY and replace
-them with buttons to perform a a new search."
+them with buttons to perform a new search."
(let ((start (point)))
(insert (dictionary-decode-charset reply dictionary))
(insert "\n\n")
@@ -872,7 +872,7 @@ The word is taken from the buffer, the DICTIONARY is given
as argument."
'help-echo (concat "Press Mouse-2 to lookup \""
word "\" in \"" dictionary "\"")))))
-(defun dictionary-select-dictionary (&rest ignored)
+(defun dictionary-select-dictionary (&rest _ignored)
"Save the current state and start a dictionary selection."
(interactive)
(dictionary-ensure-buffer)
@@ -880,7 +880,7 @@ The word is taken from the buffer, the DICTIONARY is given
as argument."
(dictionary-do-select-dictionary)
(dictionary-store-state 'dictionary-do-select-dictionary nil))
-(defun dictionary-do-select-dictionary (&rest ignored)
+(defun dictionary-do-select-dictionary (&rest _ignored)
"The workhorse for doing the dictionary selection."
(message "Looking up databases and descriptions")
@@ -916,7 +916,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(dictionary-display-dictionary-line "! \"The first matching dictionary\"")
(let* ((reply (dictionary-read-answer))
(list (dictionary-simple-split-string reply "\n+")))
- (mapc 'dictionary-display-dictionary-line list))
+ (mapc #'dictionary-display-dictionary-line list))
(dictionary-post-buffer))
(defun dictionary-display-dictionary-line (string)
@@ -984,7 +984,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(dictionary-store-state 'dictionary-display-more-info dictionary))))
-(defun dictionary-select-strategy (&rest ignored)
+(defun dictionary-select-strategy (&rest _ignored)
"Save the current state and start a strategy selection."
(interactive)
(dictionary-ensure-buffer)
@@ -1014,7 +1014,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(dictionary-display-strategy-line ". \"The servers default\"")
(let* ((reply (dictionary-read-answer))
(list (dictionary-simple-split-string reply "\n+")))
- (mapc 'dictionary-display-strategy-line list))
+ (mapc #'dictionary-display-strategy-line list))
(dictionary-post-buffer))
(defun dictionary-display-strategy-line (string)
@@ -1030,7 +1030,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
'help-echo (purecopy "Mouse-2 to select this matching
algorithm"))
(insert "\n")))))
-(defun dictionary-set-strategy (strategy &rest ignored)
+(defun dictionary-set-strategy (strategy &rest _ignored)
"Select this STRATEGY as new default."
(setq dictionary-default-strategy strategy)
(dictionary-restore-state)
@@ -1194,7 +1194,7 @@ allows editing it."
(describe-function 'dictionary-mode))
;;;###autoload
-(defun dictionary-match-words (&optional pattern &rest ignored)
+(defun dictionary-match-words (&optional pattern &rest _ignored)
"Search PATTERN in current default dictionary using default strategy."
(interactive)
;; can't use interactive because of mouse events
@@ -1270,7 +1270,7 @@ allows editing it."
(defun dictionary-read-definition (&ignore)
(let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
- (mapconcat 'identity (cdr list) "\n")))
+ (mapconcat #'identity (cdr list) "\n")))
;;; Tooltip support for GNU Emacs
(defvar global-dictionary-tooltip-mode
@@ -1322,8 +1322,8 @@ will be set to nil."
(interactive)
(tooltip-mode on)
(if on
- (add-hook 'tooltip-functions 'dictionary-display-tooltip)
- (remove-hook 'tooltip-functions 'dictionary-display-tooltip)))
+ (add-hook 'tooltip-functions #'dictionary-display-tooltip)
+ (remove-hook 'tooltip-functions #'dictionary-display-tooltip)))
;;;###autoload
(defun dictionary-tooltip-mode (&optional arg)
@@ -1364,9 +1364,8 @@ any buffer where (dictionary-tooltip-mode 1) has been
called."
(make-local-variable 'dictionary-tooltip-mouse-event)
(setq-default track-mouse on)
(dictionary-switch-tooltip-mode 1)
- (if on
- (global-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
- (global-set-key [mouse-movement] 'ignore))
+ (global-set-key [mouse-movement]
+ (if on #'dictionary-tooltip-track-mouse #'ignore))
on))
(provide 'dictionary)
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 92dcf73..ddbfb95 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -79,7 +79,7 @@ and is a commonly available debugging tool."
(push domain cmdline)
(if server (push (concat "@" server) cmdline)
(if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
- (apply 'call-process dig-program nil buf nil cmdline)
+ (apply #'call-process dig-program nil buf nil cmdline)
buf))
(defun dig-extract-rr (domain &optional type class)
@@ -120,7 +120,7 @@ Buffer should contain output generated by `dig-invoke'."
(defvar dig-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "g" nil)
- (define-key map "q" 'dig-exit)
+ (define-key map "q" #'dig-exit)
map))
(define-derived-mode dig-mode special-mode "Dig"
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 90776e3..1086bab 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -135,8 +135,8 @@ updated. Set this variable to t to disable the check.")
(if (stringp ended)
(if (null name)
ended
- (concat (mapconcat 'identity (nreverse name) ".") "." ended))
- (mapconcat 'identity (nreverse name) "."))))
+ (concat (mapconcat #'identity (nreverse name) ".") "." ended))
+ (mapconcat #'identity (nreverse name) "."))))
(defun dns-write (spec &optional tcp-p)
"Write a DNS packet according to SPEC.
@@ -283,7 +283,7 @@ If TCP-P, the first two bytes of the packet will be the
length field."
(let ((bytes nil))
(dotimes (_ 4)
(push (dns-read-bytes 1) bytes))
- (mapconcat 'number-to-string (nreverse bytes) ".")))
+ (mapconcat #'number-to-string (nreverse bytes) ".")))
((eq type 'AAAA)
(let (hextets)
(dotimes (_ 8)
@@ -386,7 +386,7 @@ If REVERSE, look up an IP address."
(when reverse
(setq name (concat
- (mapconcat 'identity (nreverse (split-string name "\\.")) ".")
+ (mapconcat #'identity (nreverse (split-string name "\\.")) ".")
".in-addr.arpa")
type 'PTR))
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 456d70e..1d7af7f 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -41,38 +41,38 @@
(defvar eudc-bob-generic-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "s" 'eudc-bob-save-object)
- (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
- (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
+ (define-key map "s" #'eudc-bob-save-object)
+ (define-key map "!" #'eudc-bob-pipe-object-to-external-program)
+ (define-key map [down-mouse-3] #'eudc-bob-popup-menu)
map)
"Keymap for multimedia objects.")
(defvar eudc-bob-image-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map eudc-bob-generic-keymap)
- (define-key map "t" 'eudc-bob-toggle-inline-display)
+ (define-key map "t" #'eudc-bob-toggle-inline-display)
map)
"Keymap for inline images.")
(defvar eudc-bob-sound-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map eudc-bob-generic-keymap)
- (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
- (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
+ (define-key map (kbd "RET") #'eudc-bob-play-sound-at-point)
+ (define-key map [down-mouse-2] #'eudc-bob-play-sound-at-mouse)
map)
"Keymap for inline sounds.")
(defvar eudc-bob-url-keymap
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'browse-url-at-point)
- (define-key map [down-mouse-2] 'browse-url-at-mouse)
+ (define-key map (kbd "RET") #'browse-url-at-point)
+ (define-key map [down-mouse-2] #'browse-url-at-mouse)
map)
"Keymap for inline urls.")
(defvar eudc-bob-mail-keymap
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'goto-address-at-point)
- (define-key map [down-mouse-2] 'goto-address-at-point)
+ (define-key map (kbd "RET") #'goto-address-at-point)
+ (define-key map [down-mouse-2] #'goto-address-at-point)
map)
"Keymap for inline e-mail addresses.")
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index bac75e6..66db781 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -1,4 +1,4 @@
-;;; eudc-export.el --- functions to export EUDC query results
+;;; eudc-export.el --- functions to export EUDC query results -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -35,6 +35,7 @@
;; NOERROR is so we can compile it.
(require 'bbdb nil t)
(require 'bbdb-com nil t)
+(require 'cl-lib)
(defun eudc-create-bbdb-record (record &optional silent)
"Create a BBDB record using the RECORD alist.
@@ -42,24 +43,22 @@ RECORD is an alist of (KEY . VALUE) where KEY is a
directory attribute name
symbol and VALUE is the corresponding value for the record.
If SILENT is non-nil then the created BBDB record is not displayed."
(require 'bbdb)
+ (declare-function bbdb-create-internal "bbdb-com" (&rest spec))
+ (declare-function bbdb-display-records "bbdb"
+ (records &optional layout append))
;; This function runs in a special context where lisp symbols corresponding
;; to field names in record are bound to the corresponding values
- (eval
- `(let* (,@(mapcar (lambda (c)
- (list (car c) (if (listp (cdr c))
- (list 'quote (cdr c))
- (cdr c))))
- record)
- bbdb-name
- bbdb-company
- bbdb-net
- bbdb-address
- bbdb-phones
- bbdb-notes
- spec
- bbdb-record
- value
- (conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
+ (cl-progv (mapcar #'car record) (mapcar #'cdr record)
+ (let* (bbdb-name
+ bbdb-company
+ bbdb-net
+ bbdb-address
+ bbdb-phones
+ bbdb-notes
+ spec
+ bbdb-record
+ value
+ (conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
;; BBDB standard fields
(setq bbdb-name (eudc-parse-spec (cdr (assq 'name conversion-alist))
record nil)
@@ -68,14 +67,14 @@ If SILENT is non-nil then the created BBDB record is not
displayed."
bbdb-notes (eudc-parse-spec (cdr (assq 'notes conversion-alist))
record nil))
(setq spec (cdr (assq 'address conversion-alist)))
(setq bbdb-address (delq nil (eudc-parse-spec (if (listp (car spec))
- spec
- (list spec))
- record t)))
+ spec
+ (list spec))
+ record t)))
(setq spec (cdr (assq 'phone conversion-alist)))
(setq bbdb-phones (delq nil (eudc-parse-spec (if (listp (car spec))
- spec
- (list spec))
- record t)))
+ spec
+ (list spec))
+ record t)))
;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
(mapcar (lambda (mapping)
@@ -85,19 +84,20 @@ If SILENT is non-nil then the created BBDB record is not
displayed."
(cons (car mapping) value)))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
- (setq bbdb-record (bbdb-create-internal
- bbdb-name
- ,@(when (eudc--using-bbdb-3-or-newer-p)
- '(nil
- nil))
- bbdb-company
- bbdb-net
- ,@(if (eudc--using-bbdb-3-or-newer-p)
- '(bbdb-phones
- bbdb-address)
- '(bbdb-address
- bbdb-phones))
- bbdb-notes))
+ (setq bbdb-record
+ (apply #'bbdb-create-internal
+ `(,bbdb-name
+ ,@(when (eudc--using-bbdb-3-or-newer-p)
+ '(nil
+ nil))
+ ,bbdb-company
+ ,bbdb-net
+ ,@(if (eudc--using-bbdb-3-or-newer-p)
+ (list bbdb-phones
+ bbdb-address)
+ (list bbdb-address
+ bbdb-phones))
+ ,bbdb-notes)))
(or silent
(bbdb-display-records (list bbdb-record))))))
@@ -111,7 +111,7 @@ If RECURSE is non-nil then SPEC may be a list of atomic
specs."
(symbolp (car spec))
(fboundp (car spec))))
(condition-case nil
- (eval spec)
+ (eval spec t)
(void-variable nil)))
((and recurse
(listp spec))
@@ -194,9 +194,9 @@ LOCATION is used as the phone location for BBDB."
(signal (car err) (cdr err)))))
(if (= 3 (length phone-list))
(setq phone-list (append phone-list '(nil))))
- (apply 'vector location phone-list)))
+ (apply #'vector location phone-list)))
((listp phone)
- (vector location (mapconcat 'identity phone ", ")))
+ (vector location (mapconcat #'identity phone ", ")))
(t
(error "Invalid phone specification"))))
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index e4b7e8a..a737a99 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -1,4 +1,4 @@
-;;; eudc-hotlist.el --- hotlist management for EUDC
+;;; eudc-hotlist.el --- hotlist management for EUDC -*- lexical-binding: t;
-*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -37,12 +37,12 @@
(defvar eudc-hotlist-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'eudc-hotlist-add-server)
- (define-key map "d" 'eudc-hotlist-delete-server)
- (define-key map "s" 'eudc-hotlist-select-server)
- (define-key map "t" 'eudc-hotlist-transpose-servers)
- (define-key map "q" 'eudc-hotlist-quit-edit)
- (define-key map "x" 'kill-current-buffer)
+ (define-key map "a" #'eudc-hotlist-add-server)
+ (define-key map "d" #'eudc-hotlist-delete-server)
+ (define-key map "s" #'eudc-hotlist-select-server)
+ (define-key map "t" #'eudc-hotlist-transpose-servers)
+ (define-key map "q" #'eudc-hotlist-quit-edit)
+ (define-key map "x" #'kill-current-buffer)
map))
(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers"
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 4f04804..c112d27 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -65,12 +65,12 @@
(defvar eudc-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map widget-keymap)
- (define-key map "q" 'kill-current-buffer)
- (define-key map "x" 'kill-current-buffer)
- (define-key map "f" 'eudc-query-form)
- (define-key map "b" 'eudc-try-bbdb-insert)
- (define-key map "n" 'eudc-move-to-next-record)
- (define-key map "p" 'eudc-move-to-previous-record)
+ (define-key map "q" #'kill-current-buffer)
+ (define-key map "x" #'kill-current-buffer)
+ (define-key map "f" #'eudc-query-form)
+ (define-key map "b" #'eudc-try-bbdb-insert)
+ (define-key map "n" #'eudc-move-to-next-record)
+ (define-key map "p" #'eudc-move-to-previous-record)
map))
(defvar mode-popup-menu)
@@ -407,7 +407,7 @@ if any, is called to print the value in cdr of FIELD."
(val (cdr field)))
(if match
(progn
- (eval (list (cdr match) val))
+ (funcall (cdr match) val)
(insert "\n"))
(mapc
(lambda (val-elem)
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index e11458b..e241a1c 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -1,4 +1,4 @@
-;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
+;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -34,6 +34,7 @@
;; Make it loadable on systems without bbdb.
(require 'bbdb nil t)
(require 'bbdb-com nil t)
+(require 'seq)
;;{{{ Internal cooking
@@ -87,33 +88,30 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
(require 'bbdb)
(catch 'unmatch
- (progn
- (dolist (condition eudc-bbdb-current-query)
- (let ((attr (car condition))
- (val (cdr condition))
- (case-fold-search t)
- bbdb-val)
- (or (and (memq attr '(firstname lastname aka company phones
- addresses net))
- (progn
- (setq bbdb-val
- (eval (list (intern (concat "bbdb-record-"
- (symbol-name
- (eudc-bbdb-field
- attr))))
- 'record)))
- (if (listp bbdb-val)
- (if eudc-bbdb-enable-substring-matches
- (eval `(or ,@(mapcar (lambda (subval)
- (string-match val subval))
- bbdb-val)))
- (member (downcase val)
- (mapcar 'downcase bbdb-val)))
+ (dolist (condition eudc-bbdb-current-query)
+ (let ((attr (car condition))
+ (val (cdr condition))
+ (case-fold-search t))
+ (or (and (memq attr '(firstname lastname aka company phones
+ addresses net))
+ (let ((bbdb-val
+ (funcall (intern (concat "bbdb-record-"
+ (symbol-name
+ (eudc-bbdb-field
+ attr))))
+ record)))
+ (if (listp bbdb-val)
(if eudc-bbdb-enable-substring-matches
- (string-match val bbdb-val)
- (string-equal (downcase val) (downcase bbdb-val))))))
- (throw 'unmatch nil))))
- record)))
+ (seq-some (lambda (subval)
+ (string-match val subval))
+ bbdb-val)
+ (member (downcase val)
+ (mapcar #'downcase bbdb-val)))
+ (if eudc-bbdb-enable-substring-matches
+ (string-match val bbdb-val)
+ (string-equal (downcase val) (downcase bbdb-val))))))
+ (throw 'unmatch nil))))
+ record))
;; External.
(declare-function bbdb-phone-location "ext:bbdb" t) ; via bbdb-defstruct
@@ -182,40 +180,34 @@ The record is filtered according to
`eudc-bbdb-current-return-attributes'."
(require 'bbdb)
(let ((attrs (or eudc-bbdb-current-return-attributes
'(firstname lastname aka company phones addresses net
notes)))
- attr
- eudc-rec
- val)
- (while (prog1
- (setq attr (car attrs))
- (setq attrs (cdr attrs)))
- (cond
- ((eq attr 'phones)
- (setq val (eudc-bbdb-extract-phones record)))
- ((eq attr 'addresses)
- (setq val (eudc-bbdb-extract-addresses record)))
- ((eq attr 'notes)
- (if (eudc--using-bbdb-3-or-newer-p)
- (setq val (bbdb-record-xfield record 'notes))
- (setq val (bbdb-record-notes record))))
- ((memq attr '(firstname lastname aka company net))
- (setq val (eval
- (list (intern
- (concat "bbdb-record-"
- (symbol-name (eudc-bbdb-field attr))))
- 'record))))
- (t
- (error "Unknown BBDB attribute")))
- (cond
- ((or (not val) (equal val ""))) ; do nothing
- ((memq attr '(phones addresses))
- (setq eudc-rec (append val eudc-rec)))
- ((and (listp val)
- (= 1 (length val)))
- (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
- ((> (length val) 0)
- (setq eudc-rec (cons (cons attr val) eudc-rec)))
- (t
- (error "Unexpected attribute value"))))
+ eudc-rec)
+ (dolist (attr attrs)
+ (let ((val
+ (pcase attr
+ ('phones (eudc-bbdb-extract-phones record))
+ ('addresses (eudc-bbdb-extract-addresses record))
+ ('notes
+ (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-record-xfield record 'notes)
+ (bbdb-record-notes record)))
+ ((or 'firstname 'lastname 'aka 'company 'net)
+ (funcall (intern
+ (concat "bbdb-record-"
+ (symbol-name (eudc-bbdb-field attr))))
+ record))
+ (_
+ (error "Unknown BBDB attribute")))))
+ (cond
+ ((or (not val) (equal val ""))) ; do nothing
+ ((memq attr '(phones addresses))
+ (setq eudc-rec (append val eudc-rec)))
+ ((and (listp val)
+ (= 1 (length val)))
+ (push (cons attr (car val)) eudc-rec))
+ ((> (length val) 0)
+ (push (cons attr val) eudc-rec))
+ (t
+ (error "Unexpected attribute value")))))
(nreverse eudc-rec)))
@@ -240,21 +232,20 @@ RETURN-ATTRS is a list of attributes to return,
defaulting to
(while (and records (> (length query-attrs) 0))
(setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
(if (car query-attrs)
- (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
+ ;; BEWARE: `bbdb-search' is a macro!
+ (setq records (eval `(bbdb-search records ,@bbdb-attrs) t)))
(setq query-attrs (cdr query-attrs)))
(mapc (lambda (record)
(setq filtered (eudc-filter-duplicate-attributes record))
;; If there were duplicate attributes reverse the order of the
;; record so the unique attributes appear first
(if (> (length filtered) 1)
- (setq filtered (mapcar (lambda (rec)
- (reverse rec))
- filtered)))
+ (setq filtered (mapcar #'reverse filtered)))
(setq result (append result filtered)))
(delq nil
- (mapcar 'eudc-bbdb-format-record-as-result
+ (mapcar #'eudc-bbdb-format-record-as-result
(delq nil
- (mapcar 'eudc-bbdb-filter-non-matching-record
+ (mapcar #'eudc-bbdb-filter-non-matching-record
records)))))
result))
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 4623079..0aff276 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,4 +1,4 @@
-;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
+;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -38,10 +38,10 @@
;;{{{ Internal cooking
-(eval-and-compile
+(defalias 'eudc-ldap-get-host-parameter
(if (fboundp 'ldap-get-host-parameter)
- (fset 'eudc-ldap-get-host-parameter 'ldap-get-host-parameter)
- (defun eudc-ldap-get-host-parameter (host parameter)
+ #'ldap-get-host-parameter
+ (lambda (host parameter)
"Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
(plist-get (cdr (assoc host ldap-host-parameters-alist))
parameter))))
@@ -84,7 +84,7 @@
record))
(defun eudc-filter-$ (string)
- (mapconcat 'identity (split-string string "\\$") "\n"))
+ (mapconcat #'identity (split-string string "\\$") "\n"))
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
"Clean up RECORD to make it suitable for EUDC.
@@ -104,7 +104,7 @@ multiple addresses."
(value (cdr field)))
(when (and clean-up-addresses
(memq name '(postaladdress registeredaddress)))
- (setq value (mapcar 'eudc-filter-$ value)))
+ (setq value (mapcar #'eudc-filter-$ value)))
(if (eq name 'mail)
(setq mail-addresses (append mail-addresses value))
(push (cons name (if (cdr value)
@@ -126,9 +126,9 @@ RETURN-ATTRS is a list of attributes to return, defaulting
to
(let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
eudc-server
(if (listp return-attrs)
- (mapcar 'symbol-name return-attrs))))
+ (mapcar #'symbol-name return-attrs))))
final-result)
- (setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
+ (setq result (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
result))
(if (and eudc-strict-return-matches
return-attrs
@@ -154,7 +154,7 @@ attribute names are returned. Default to `person'."
(let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
- (mapcar 'eudc-ldap-cleanup-record-filtering-addresses
+ (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
(ldap-search
(eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index eb7032a..732881f 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -1,4 +1,4 @@
-;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
+;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend -*-
lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
index b07016c..18c8958 100644
--- a/lisp/net/eudcb-macos-contacts.el
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -1,4 +1,4 @@
-;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
+;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend -*-
lexical-binding: t; -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
@@ -74,7 +74,7 @@ end tell" str))
"`osascript' executable not found. "
"Is this is a macOS 10.0 or later system?"))))
-(defun eudc-macos-contacts-query-internal (query &optional return-attrs)
+(defun eudc-macos-contacts-query-internal (query &optional _return-attrs)
"Query macOS Contacts with QUERY.
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
macOS Contacts attribute names.
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index ff58cbb..9c7bcdc 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -1,4 +1,4 @@
-;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
+;;; gnutls.el --- Support SSL/TLS connections through GnuTLS -*-
lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -59,7 +59,6 @@ general, Emacs network security is handled by the Network
Security Manager (NSM), and the default value of nil delegates
the job of checking the connection security to the NSM.
See Info node `(emacs) Network Security'."
- :group 'gnutls
:type '(choice (const nil)
string))
@@ -91,7 +90,6 @@ checks are performed at the gnutls level. Instead the checks
are
performed via `open-network-stream' at a higher level by the
Network Security Manager. See Info node `(emacs) Network
Security'."
- :group 'gnutls
:version "24.4"
:type '(choice
(const t)
@@ -118,7 +116,6 @@ Security'."
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
- :group 'gnutls
:type '(choice (function :tag "Function to produce list of bundle filenames")
(repeat (file :tag "Bundle filename"))))
@@ -139,7 +136,6 @@ network security is handled at a higher level via
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
(integer :tag "Number of bits" 2048))
- :group 'gnutls
:version "27.1")
(defcustom gnutls-crlfiles
@@ -150,7 +146,6 @@ node `(emacs) Network Security'."
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
- :group 'gnutls
:type '(choice (function :tag "Function to produce list of CRL filenames")
(repeat (file :tag "CRL filename")))
:version "27.1")
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index d192630..af12f69 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -1,4 +1,4 @@
-;;; goto-addr.el --- click to browse URL or to send to e-mail address
+;;; goto-addr.el --- click to browse URL or to send to e-mail address -*-
lexical-binding: t; -*-
;; Copyright (C) 1995, 2000-2021 Free Software Foundation, Inc.
@@ -73,19 +73,16 @@
(defcustom goto-address-fontify-p t
"Non-nil means URLs and e-mail addresses in buffer are fontified.
But only if `goto-address-highlight-p' is also non-nil."
- :type 'boolean
- :group 'goto-address)
+ :type 'boolean)
(defcustom goto-address-highlight-p t
"Non-nil means URLs and e-mail addresses in buffer are highlighted."
- :type 'boolean
- :group 'goto-address)
+ :type 'boolean)
(defcustom goto-address-fontify-maximum-size 30000
"Maximum size of file in which to fontify and/or highlight URLs.
A value of t means there is no limit--fontify regardless of the size."
- :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
- :group 'goto-address)
+ :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t)))
(defvar goto-address-mail-regexp
;; Actually pretty much any char could appear in the username part. -stef
@@ -122,30 +119,26 @@ will have no effect.")
(defvar goto-address-highlight-keymap
(let ((m (make-sparse-keymap)))
- (define-key m (kbd "<mouse-2>") 'goto-address-at-point)
- (define-key m (kbd "C-c RET") 'goto-address-at-point)
+ (define-key m (kbd "<mouse-2>") #'goto-address-at-point)
+ (define-key m (kbd "C-c RET") #'goto-address-at-point)
m)
"Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
(defcustom goto-address-url-face 'link
"Face to use for URLs."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defcustom goto-address-url-mouse-face 'highlight
"Face to use for URLs when the mouse is on them."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defcustom goto-address-mail-face 'italic
"Face to use for e-mail addresses."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defcustom goto-address-mail-mouse-face 'secondary-selection
"Face to use for e-mail addresses when the mouse is on them."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defun goto-address-unfontify (start end)
"Remove `goto-address' fontification from the given region."
@@ -287,7 +280,6 @@ Also fontifies the buffer appropriately (see
`goto-address-fontify-p' and
;;;###autoload
(define-globalized-minor-mode global-goto-address-mode
goto-address-mode goto-addr-mode--turn-on
- :group 'goto-address
:version "28.1")
;;;###autoload
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index d5aad3a..3a561a0 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -1,4 +1,4 @@
-;;; net-utils.el --- network functions
+;;; net-utils.el --- network functions -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -67,17 +67,14 @@
"tracert"
"traceroute")
"Program to trace network hops to a destination."
- :group 'net-utils
:type 'string)
(defcustom traceroute-program-options nil
"Options for the traceroute program."
- :group 'net-utils
:type '(repeat string))
(defcustom ping-program "ping"
"Program to send network test packets to a host."
- :group 'net-utils
:type 'string)
;; On GNU/Linux and Irix, the system's ping program seems to send packets
@@ -87,7 +84,6 @@
(list "-c" "4"))
"Options for the ping program.
These options can be used to limit how many ICMP packets are emitted."
- :group 'net-utils
:type '(repeat string))
(defcustom ifconfig-program
@@ -98,7 +94,6 @@ These options can be used to limit how many ICMP packets are
emitted."
(t "ip"))
"Program to print network configuration information."
:version "25.1" ; add ip
- :group 'net-utils
:type 'string)
(defcustom ifconfig-program-options
@@ -108,7 +103,6 @@ These options can be used to limit how many ICMP packets
are emitted."
"Options for the ifconfig program."
:version "25.1"
:set-after '(ifconfig-program)
- :group 'net-utils
:type '(repeat string))
(defcustom iwconfig-program
@@ -116,7 +110,6 @@ These options can be used to limit how many ICMP packets
are emitted."
((net-utils--executable-find-sbin "iw") "iw")
(t "iw"))
"Program to print wireless network configuration information."
- :group 'net-utils
:type 'string
:version "26.1")
@@ -124,7 +117,6 @@ These options can be used to limit how many ICMP packets
are emitted."
(cond ((string-match-p "iw\\'" iwconfig-program) (list "dev"))
(t nil))
"Options for the iwconfig program."
- :group 'net-utils
:type '(repeat string)
:version "26.1")
@@ -133,25 +125,21 @@ These options can be used to limit how many ICMP packets
are emitted."
((net-utils--executable-find-sbin "ss"))
(t "ss"))
"Program to print network statistics."
- :group 'net-utils
:type 'string
:version "26.1")
(defcustom netstat-program-options
(list "-a")
"Options for the netstat program."
- :group 'net-utils
:type '(repeat string))
(defcustom arp-program (or (net-utils--executable-find-sbin "arp") "arp")
"Program to print IP to address translation tables."
- :group 'net-utils
:type 'string)
(defcustom arp-program-options
(list "-a")
"Options for the arp program."
- :group 'net-utils
:type '(repeat string))
(defcustom route-program
@@ -162,7 +150,6 @@ These options can be used to limit how many ICMP packets
are emitted."
((net-utils--executable-find-sbin "ip"))
(t "ip"))
"Program to print routing tables."
- :group 'net-utils
:type 'string
:version "26.1")
@@ -171,18 +158,15 @@ These options can be used to limit how many ICMP packets
are emitted."
((string-match-p "netstat\\'" route-program) (list "-r"))
(t (list "route")))
"Options for the route program."
- :group 'net-utils
:type '(repeat string)
:version "26.1")
(defcustom nslookup-program "nslookup"
"Program to interactively query DNS information."
- :group 'net-utils
:type 'string)
(defcustom nslookup-program-options nil
"Options for the nslookup program."
- :group 'net-utils
:type '(repeat string))
(defcustom nslookup-prompt-regexp "^> "
@@ -190,28 +174,23 @@ These options can be used to limit how many ICMP packets
are emitted."
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
- :group 'net-utils
:type 'regexp)
(defcustom dig-program "dig"
"Program to query DNS information."
- :group 'net-utils
:type 'string)
(defcustom dig-program-options nil
"Options for the dig program."
- :group 'net-utils
:type '(repeat string)
:version "26.1")
(defcustom ftp-program "ftp"
"Program to run to do FTP transfers."
- :group 'net-utils
:type 'string)
(defcustom ftp-program-options nil
"Options for the ftp program."
- :group 'net-utils
:type '(repeat string))
(defcustom ftp-prompt-regexp "^ftp>"
@@ -219,17 +198,14 @@ This variable is only used if the variable
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
- :group 'net-utils
:type 'regexp)
(defcustom smbclient-program "smbclient"
"Smbclient program."
- :group 'net-utils
:type 'string)
(defcustom smbclient-program-options nil
"Options for the smbclient program."
- :group 'net-utils
:type '(repeat string))
(defcustom smbclient-prompt-regexp "^smb: >"
@@ -237,17 +213,14 @@ This variable is only used if the variable
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
- :group 'net-utils
:type 'regexp)
(defcustom dns-lookup-program "host"
"Program to interactively query DNS information."
- :group 'net-utils
:type 'string)
(defcustom dns-lookup-program-options nil
"Options for the dns-lookup program."
- :group 'net-utils
:type '(repeat string))
;; Internal variables
@@ -265,7 +238,7 @@ This variable is only used if the variable
1 'font-lock-keyword-face)
;; Dotted quads
(list
- (mapconcat 'identity
+ (mapconcat #'identity
(make-list 4 "[0-9]+")
"\\.")
0 'font-lock-variable-name-face)
@@ -273,7 +246,7 @@ This variable is only used if the variable
(list
(let ((host-expression "[-A-Za-z0-9]+"))
(concat
- (mapconcat 'identity
+ (mapconcat #'identity
(make-list 2 host-expression)
"\\.")
"\\(\\." host-expression "\\)*"))
@@ -288,7 +261,7 @@ This variable is only used if the variable
(list
;; Dotted quads
(list
- (mapconcat 'identity (make-list 4 "[0-9]+") "\\.")
+ (mapconcat #'identity (make-list 4 "[0-9]+") "\\.")
0 'font-lock-variable-name-face)
;; Simple rfc4291 addresses
(list (concat
@@ -300,7 +273,7 @@ This variable is only used if the variable
(list
(let ((host-expression "[-A-Za-z0-9]+"))
(concat
- (mapconcat 'identity (make-list 2 host-expression) "\\.")
+ (mapconcat #'identity (make-list 2 host-expression) "\\.")
"\\(\\." host-expression "\\)*"))
0 'font-lock-variable-name-face))
"Expressions to font-lock for general network utilities.")
@@ -371,8 +344,8 @@ This variable is only used if the variable
(erase-buffer)
(insert header "\n")
(set-process-filter
- (apply 'start-process name buf program args)
- 'net-utils-remove-ctrl-m-filter)
+ (apply #'start-process name buf program args)
+ #'net-utils-remove-ctrl-m-filter)
(display-buffer buf)
buf))
@@ -405,12 +378,12 @@ This variable is only used if the variable
`(net-utils-run-simple ,(current-buffer)
,program-name ,args nodisplay))
(set-process-filter
- (apply 'start-process program-name
- (current-buffer) program-name args)
- 'net-utils-remove-ctrl-m-filter)
+ (apply #'start-process program-name
+ (current-buffer) program-name args)
+ #'net-utils-remove-ctrl-m-filter)
(unless nodisplay (display-buffer (current-buffer)))))
-(defun net-utils--revert-function (&optional ignore-auto noconfirm)
+(defun net-utils--revert-function (&optional _ignore-auto _noconfirm)
(message "Reverting `%s'..." (buffer-name))
(apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
(let ((proc (get-buffer-process (current-buffer))))
@@ -430,7 +403,7 @@ This variable is only used if the variable
ifconfig-program
ifconfig-program-options))
-(defalias 'ipconfig 'ifconfig)
+(defalias 'ipconfig #'ifconfig)
;;;###autoload
(defun iwconfig ()
@@ -532,7 +505,7 @@ in Lisp code."
(net-utils-run-program
"Nslookup"
(concat "** "
- (mapconcat 'identity
+ (mapconcat #'identity
(list "Nslookup" host nslookup-program)
" ** "))
nslookup-program
@@ -618,7 +591,7 @@ This command uses `nslookup-program' to look up DNS
records."
(defvar nslookup-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\t" #'completion-at-point)
map))
;; Using a derived mode gives us keymaps, hooks, etc.
@@ -646,9 +619,9 @@ This command uses `dns-lookup-program' for looking up the
DNS information."
(net-utils-run-program
(concat "DNS Lookup [" host "]")
(concat "** "
- (mapconcat 'identity
- (list "DNS Lookup" host dns-lookup-program)
- " ** "))
+ (mapconcat #'identity
+ (list "DNS Lookup" host dns-lookup-program)
+ " ** "))
dns-lookup-program
options)))
@@ -669,13 +642,14 @@ This command uses `dig-program' for looking up the DNS
information."
(net-utils-run-program
"Dig"
(concat "** "
- (mapconcat 'identity
+ (mapconcat #'identity
(list "Dig" host dig-program)
" ** "))
dig-program
options)))
(autoload 'comint-exec "comint")
+(declare-function comint-watch-for-password-prompt "comint" (string))
;; This is a lot less than ange-ftp, but much simpler.
;;;###autoload
@@ -697,7 +671,7 @@ This command uses `dig-program' for looking up the DNS
information."
(defvar ftp-mode-map
(let ((map (make-sparse-keymap)))
;; Occasionally useful
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\t" #'completion-at-point)
map))
(define-derived-mode ftp-mode comint-mode "FTP"
@@ -710,9 +684,9 @@ This command uses `dig-program' for looking up the DNS
information."
;; password prompts will probably immediately follow the initial
;; connection), but it's better than getting prompted twice for the
;; same password.
- (unless (memq 'comint-watch-for-password-prompt
+ (unless (memq #'comint-watch-for-password-prompt
(default-value 'comint-output-filter-functions))
- (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
+ (add-hook 'comint-output-filter-functions
#'comint-watch-for-password-prompt
nil t)))
(defun smbclient (host service)
@@ -759,9 +733,9 @@ This command uses `smbclient-program' to connect to HOST."
;; password prompts will probably immediately follow the initial
;; connection), but it's better than getting prompted twice for the
;; same password.
- (unless (memq 'comint-watch-for-password-prompt
+ (unless (memq #'comint-watch-for-password-prompt
(default-value 'comint-output-filter-functions))
- (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
+ (add-hook 'comint-output-filter-functions
#'comint-watch-for-password-prompt
nil t)))
@@ -810,7 +784,7 @@ This list is not complete.")
(error "Could not open connection to %s" host))
(erase-buffer)
(set-marker (process-mark tcp-connection) (point-min))
- (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
+ (set-process-filter tcp-connection #'net-utils-remove-ctrl-m-filter)
(and initial-string
(process-send-string tcp-connection
(concat initial-string "\r\n")))
@@ -825,7 +799,6 @@ This list is not complete.")
If a host name passed to `finger' matches one of these regular
expressions, it is assumed to be a host that doesn't accept
queries of the form USER@HOST, and wants a query containing USER only."
- :group 'net-utils
:type '(repeat regexp)
:version "21.1")
@@ -852,7 +825,7 @@ and `network-connection-service-alist', which see."
(let* ((user-and-host (concat user "@" host))
(process-name (concat "Finger [" user-and-host "]"))
(regexps finger-X.500-host-regexps)
- found)
+ ) ;; found
(and regexps
(while (not (string-match (car regexps) host))
(setq regexps (cdr regexps)))
@@ -866,7 +839,6 @@ and `network-connection-service-alist', which see."
(defcustom whois-server-name "rs.internic.net"
"Default host name for the whois service."
- :group 'net-utils
:type 'string)
(defcustom whois-server-list
@@ -880,7 +852,6 @@ and `network-connection-service-alist', which see."
("whois.nic.gov")
("whois.ripe.net"))
"A list of whois servers that can be queried."
- :group 'net-utils
:type '(repeat (list string)))
;; FIXME: modern whois clients include a much better tld <-> whois server
@@ -903,14 +874,12 @@ and `network-connection-service-alist', which see."
("whois.nic.gov" . "gov")
("whois.nic.mil" . "mil"))
"Alist to map top level domains to whois servers."
- :group 'net-utils
:type '(repeat (cons string string)))
(defcustom whois-guess-server t
"If non-nil then whois will try to deduce the appropriate whois
server from the query. If the query doesn't look like a domain or hostname
then the server named by `whois-server-name' is used."
- :group 'net-utils
:type 'boolean)
(defun whois-get-tld (host)
@@ -951,7 +920,6 @@ The port is deduced from
`network-connection-service-alist'."
(defcustom whois-reverse-lookup-server "whois.arin.net"
"Server which provides inverse DNS mapping."
- :group 'net-utils
:type 'string)
;;;###autoload
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index b45cefc..1983688 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -248,8 +248,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(list key cert)))))))
;;;###autoload
-(defalias 'open-protocol-stream 'open-network-stream)
-(define-obsolete-function-alias 'open-protocol-stream 'open-network-stream
+(define-obsolete-function-alias 'open-protocol-stream #'open-network-stream
"26.1")
(defun network-stream-open-plain (name buffer host service parameters)
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index 418c1e2..c548865 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -163,7 +163,7 @@ These were mostly extracted from the Radio Community Server
You may add other entries in `newsticker-url-list'."
:type `(set ,@(mapcar #'newsticker--splicer
newsticker--raw-url-list-defaults))
- :set 'newsticker--set-customvar-retrieval
+ :set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-url-list nil
@@ -217,7 +217,7 @@ which apply for this feed only, overriding the value of
(choice :tag "Wget Arguments"
(const :tag "Default arguments" nil)
(repeat :tag "Special arguments" string))))
- :set 'newsticker--set-customvar-retrieval
+ :set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-retrieval-method
@@ -260,7 +260,7 @@ make it less than 1800 seconds (30 minutes)!"
(const :tag "Daily" 86400)
(const :tag "Weekly" 604800)
(integer :tag "Interval"))
- :set 'newsticker--set-customvar-retrieval
+ :set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-desc-comp-max
@@ -549,7 +549,7 @@ name/timer pair to `newsticker--retrieval-timer-list'."
(if (<= interval 0)
(setq interval nil))
(setq timer (run-at-time start-time interval
- 'newsticker-get-news feed-name))
+ #'newsticker-get-news feed-name))
(if interval
(add-to-list 'newsticker--retrieval-timer-list
(cons feed-name timer))))))
@@ -727,10 +727,10 @@ See `newsticker-get-news'."
(error "Another wget-process is running for %s" feed-name))
;; start wget
(let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process feed-name buffername
+ (proc (apply #'start-process feed-name buffername
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--sentinel)
+ (set-process-sentinel proc #'newsticker--sentinel)
(process-put proc 'nt-feed-name feed-name)
(setq newsticker--process-ids (cons (process-id proc)
newsticker--process-ids))
@@ -1131,9 +1131,9 @@ Restore an xml-string from a an xml NODE that was
returned by xml-parse..."
(children (cddr node)))
(concat "<" qname
(when att-list " ")
- (mapconcat 'newsticker--unxml-attribute att-list " ")
+ (mapconcat #'newsticker--unxml-attribute att-list " ")
">"
- (mapconcat 'newsticker--unxml children "") "</" qname ">")))
+ (mapconcat #'newsticker--unxml children "") "</" qname ">")))
(defun newsticker--unxml-attribute (attribute)
"Actually restore xml-string of an ATTRIBUTE of an xml node."
@@ -1580,7 +1580,7 @@ Remove the pre-formatted from `newsticker--cache'."
"Forget all cached pre-formatted data.
Remove the pre-formatted from `newsticker--cache'."
(mapc (lambda (feed)
- (mapc 'newsticker--do-forget-preformatted
+ (mapc #'newsticker--do-forget-preformatted
(cdr feed)))
newsticker--cache)
(when (fboundp 'newsticker--buffer-set-uptodate)
@@ -1593,7 +1593,7 @@ This function calls `message' with arguments STRING and
ARGS, if
(and newsticker-debug
;;(not (active-minibuffer-window))
;;(not (current-message))
- (apply 'message string args)))
+ (apply #'message string args)))
(defun newsticker--decode-iso8601-date (string)
"Return ISO8601-encoded STRING in format like `encode-time'.
@@ -1751,10 +1751,10 @@ Save image as FILENAME in DIRECTORY, download it from
URL."
feed-name))
;; start wget
(let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process proc-name buffername
+ (proc (apply #'start-process proc-name buffername
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--image-sentinel)
+ (set-process-sentinel proc #'newsticker--image-sentinel)
(process-put proc 'nt-directory directory)
(process-put proc 'nt-feed-name feed-name)
(process-put proc 'nt-filename filename)))))
@@ -2149,7 +2149,7 @@ FEED is a symbol!"
"Save cache data for all feeds."
(unless (file-directory-p newsticker-dir)
(make-directory newsticker-dir t))
- (mapc 'newsticker--cache-save-feed newsticker--cache)
+ (mapc #'newsticker--cache-save-feed newsticker--cache)
nil)
(defun newsticker--cache-save-feed (feed)
@@ -2223,7 +2223,7 @@ If AGES is nil, the total number of items is returned."
(defun newsticker--stat-num-items-total (&optional age)
"Return total number of items in all feeds which have the given AGE.
If AGE is nil, the total number of items is returned."
- (apply '+
+ (apply #'+
(mapcar (lambda (feed)
(if age
(newsticker--stat-num-items (intern (car feed)) age)
@@ -2395,7 +2395,7 @@ the item."
(make-directory temp-dir t))
(cd temp-dir)
(message "Getting image %s" url)
- (apply 'start-process "wget-image"
+ (apply #'start-process "wget-image"
" *newsticker-wget-download-images*"
newsticker-wget-name
(list url))
@@ -2417,7 +2417,7 @@ This function is suited for adding it to
`newsticker-new-item-functions'."
(make-directory temp-dir t))
(cd temp-dir)
(message "Getting enclosure %s" url)
- (apply 'start-process "wget-enclosure"
+ (apply #'start-process "wget-enclosure"
" *newsticker-wget-download-enclosures*"
newsticker-wget-name
(list url))
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index 21d47b8..705bff6 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -1,4 +1,4 @@
-;;; newst-plainview.el --- Single buffer frontend for newsticker.
+;;; newst-plainview.el --- Single buffer frontend for newsticker. -*-
lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -90,7 +90,7 @@ The following sort methods are available:
(const :tag "Keep original order" sort-by-original-order)
(const :tag "Sort by time" sort-by-time)
(const :tag "Sort by title" sort-by-title))
- :set 'newsticker--set-customvar-sorting
+ :set #'newsticker--set-customvar-sorting
:group 'newsticker-plainview)
(defcustom newsticker-heading-format
@@ -107,7 +107,7 @@ The following printf-like specifiers can be used:
%s The statistical data of the feed. See `newsticker-statistics-format'.
%t The title of the feed, i.e. its name."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-item-format
@@ -122,7 +122,7 @@ The following printf-like specifiers can be used:
the title of the feed is used.
%t The title of the item."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-desc-format
@@ -133,7 +133,7 @@ The following printf-like specifiers can be used:
%d The date the item was (first) retrieved. See
`newsticker-date-format'."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-statistics-format
@@ -146,7 +146,7 @@ The following printf-like specifiers can be used:
%o The number of old items in the feed.
%O The number of obsolete items in the feed."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
@@ -195,7 +195,7 @@ If set to t old items will be completely folded and only new
items will show up in the *newsticker* buffer. Otherwise old as
well as new items will be visible."
:type 'boolean
- :set 'newsticker--set-customvar-buffer
+ :set #'newsticker--set-customvar-buffer
:group 'newsticker-plainview)
(defcustom newsticker-show-descriptions-of-new-items
@@ -204,14 +204,14 @@ well as new items will be visible."
If set to t old items will be folded and new items will be
unfolded. Otherwise old as well as new items will be folded."
:type 'boolean
- :set 'newsticker--set-customvar-buffer
+ :set #'newsticker--set-customvar-buffer
:group 'newsticker-plainview)
(defcustom newsticker-show-all-news-elements
nil
"Show all news elements."
:type 'boolean
- ;;:set 'newsticker--set-customvar
+ ;;:set #'newsticker--set-customvar
:group 'newsticker-plainview)
;; ======================================================================
@@ -386,51 +386,45 @@ images."
(defvar newsticker-mode-map
(let ((map (make-keymap)))
- (define-key map "sO" 'newsticker-show-old-items)
- (define-key map "hO" 'newsticker-hide-old-items)
- (define-key map "sa" 'newsticker-show-all-desc)
- (define-key map "ha" 'newsticker-hide-all-desc)
- (define-key map "sf" 'newsticker-show-feed-desc)
- (define-key map "hf" 'newsticker-hide-feed-desc)
- (define-key map "so" 'newsticker-show-old-item-desc)
- (define-key map "ho" 'newsticker-hide-old-item-desc)
- (define-key map "sn" 'newsticker-show-new-item-desc)
- (define-key map "hn" 'newsticker-hide-new-item-desc)
- (define-key map "se" 'newsticker-show-entry)
- (define-key map "he" 'newsticker-hide-entry)
- (define-key map "sx" 'newsticker-show-extra)
- (define-key map "hx" 'newsticker-hide-extra)
-
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map " " 'scroll-up-command)
- (define-key map "q" 'newsticker-close-buffer)
- (define-key map "p" 'newsticker-previous-item)
- (define-key map "P" 'newsticker-previous-new-item)
- (define-key map "F" 'newsticker-previous-feed)
- (define-key map "\t" 'newsticker-next-item)
- (define-key map "n" 'newsticker-next-item)
- (define-key map "N" 'newsticker-next-new-item)
- (define-key map "f" 'newsticker-next-feed)
- (define-key map "M" 'newsticker-mark-all-items-as-read)
- (define-key map "m"
- 'newsticker-mark-all-items-at-point-as-read-and-redraw)
- (define-key map "o"
- 'newsticker-mark-item-at-point-as-read)
- (define-key map "O"
- 'newsticker-mark-all-items-at-point-as-read)
- (define-key map "G" 'newsticker-get-all-news)
- (define-key map "g" 'newsticker-get-news-at-point)
- (define-key map "u" 'newsticker-buffer-update)
- (define-key map "U" 'newsticker-buffer-force-update)
- (define-key map "a" 'newsticker-add-url)
-
- (define-key map "i"
- 'newsticker-mark-item-at-point-as-immortal)
-
- (define-key map "xf"
- 'newsticker-toggle-auto-narrow-to-feed)
- (define-key map "xi"
- 'newsticker-toggle-auto-narrow-to-item)
+ (define-key map "sO" #'newsticker-show-old-items)
+ (define-key map "hO" #'newsticker-hide-old-items)
+ (define-key map "sa" #'newsticker-show-all-desc)
+ (define-key map "ha" #'newsticker-hide-all-desc)
+ (define-key map "sf" #'newsticker-show-feed-desc)
+ (define-key map "hf" #'newsticker-hide-feed-desc)
+ (define-key map "so" #'newsticker-show-old-item-desc)
+ (define-key map "ho" #'newsticker-hide-old-item-desc)
+ (define-key map "sn" #'newsticker-show-new-item-desc)
+ (define-key map "hn" #'newsticker-hide-new-item-desc)
+ (define-key map "se" #'newsticker-show-entry)
+ (define-key map "he" #'newsticker-hide-entry)
+ (define-key map "sx" #'newsticker-show-extra)
+ (define-key map "hx" #'newsticker-hide-extra)
+
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map " " #'scroll-up-command)
+ (define-key map "q" #'newsticker-close-buffer)
+ (define-key map "p" #'newsticker-previous-item)
+ (define-key map "P" #'newsticker-previous-new-item)
+ (define-key map "F" #'newsticker-previous-feed)
+ (define-key map "\t" #'newsticker-next-item)
+ (define-key map "n" #'newsticker-next-item)
+ (define-key map "N" #'newsticker-next-new-item)
+ (define-key map "f" #'newsticker-next-feed)
+ (define-key map "M" #'newsticker-mark-all-items-as-read)
+ (define-key map "m"
#'newsticker-mark-all-items-at-point-as-read-and-redraw)
+ (define-key map "o" #'newsticker-mark-item-at-point-as-read)
+ (define-key map "O" #'newsticker-mark-all-items-at-point-as-read)
+ (define-key map "G" #'newsticker-get-all-news)
+ (define-key map "g" #'newsticker-get-news-at-point)
+ (define-key map "u" #'newsticker-buffer-update)
+ (define-key map "U" #'newsticker-buffer-force-update)
+ (define-key map "a" #'newsticker-add-url)
+
+ (define-key map "i" #'newsticker-mark-item-at-point-as-immortal)
+
+ (define-key map "xf" #'newsticker-toggle-auto-narrow-to-feed)
+ (define-key map "xi" #'newsticker-toggle-auto-narrow-to-item)
;; Bind menu to mouse.
(define-key map [down-mouse-3] newsticker-menu)
@@ -479,11 +473,11 @@ images."
;; maps for the clickable portions
(defvar newsticker--url-keymap
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'newsticker-mouse-browse-url)
- (define-key map [mouse-2] 'newsticker-mouse-browse-url)
- (define-key map "\n" 'newsticker-browse-url)
- (define-key map "\C-m" 'newsticker-browse-url)
- (define-key map [(control return)] 'newsticker-handle-url)
+ (define-key map [mouse-1] #'newsticker-mouse-browse-url)
+ (define-key map [mouse-2] #'newsticker-mouse-browse-url)
+ (define-key map "\n" #'newsticker-browse-url)
+ (define-key map "\C-m" #'newsticker-browse-url)
+ (define-key map [(control return)] #'newsticker-handle-url)
map)
"Key map for click-able headings in the newsticker buffer.")
@@ -980,7 +974,7 @@ not get changed."
(let* (pos1 pos2
(inhibit-read-only t)
inv-prop org-inv-prop
- is-invisible)
+ ) ;; is-invisible
(newsticker--buffer-beginning-of-item)
(newsticker--buffer-goto '(desc))
(setq pos1 (max (point-min) (1- (point))))
@@ -1009,7 +1003,7 @@ not get changed."
(let* (pos1 pos2
(inhibit-read-only t)
inv-prop org-inv-prop
- is-invisible)
+ ) ;; is-invisible
(newsticker--buffer-beginning-of-item)
(newsticker--buffer-goto '(desc))
(setq pos1 (max (point-min) (1- (point))))
@@ -1147,7 +1141,7 @@ If VALUE is nil, auto-narrowing is turned off, otherwise
it is turned on."
(setq index-alist (list feed-list)))
index-alist)))
-(defun newsticker--imenu-goto (name pos &rest args)
+(defun newsticker--imenu-goto (_name pos &rest _args)
"Go to item NAME at position POS and show item.
ARGS are ignored."
(goto-char pos)
@@ -1236,6 +1230,9 @@ item-retrieval time is added as well."
;; insert the description
(newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
+(defvar w3m-fill-column)
+(defvar w3-maximum-line-length)
+
(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
"Actually insert contents of news item, format it, render it and all that.
ITEM is a news item, TYPE tells which part of the item shall be inserted,
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index b188bd4..40e3044 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -1,4 +1,4 @@
-;;; newst-reader.el --- Generic RSS reader functions.
+;;; newst-reader.el --- Generic RSS reader functions. -*- lexical-binding: t;
-*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -94,7 +94,7 @@ done."
(const :tag "Right" right)
(const :tag "Center" center)
(const :tag "Full" full))
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-use-full-width
@@ -103,7 +103,7 @@ done."
If non-nil newsticker sets `fill-column' so that the whole
window is used when filling. See also `newsticker-justification'."
:type 'boolean
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-html-renderer
@@ -122,7 +122,7 @@ htmlr if this option is set."
(const :tag "w3" w3-region)
(const :tag "w3m" w3m-region)
(const :tag "htmlr" newsticker-htmlr-render))
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-date-format
@@ -130,7 +130,7 @@ htmlr if this option is set."
"Format for the date part in item and feed lines.
See `format-time-string' for a list of valid specifiers."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defgroup newsticker-faces nil
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 275c91a..2f76470 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -1,4 +1,4 @@
-;; newst-ticker.el --- mode line ticker for newsticker.
+;; newst-ticker.el --- mode line ticker for newsticker. -*- lexical-binding:
t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -83,7 +83,7 @@ smooth display (see `newsticker-scroll-smoothly') a value of
0.3 seems
reasonable. For non-smooth display a value of 10 is a good starting
point."
:type 'number
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-scroll-smoothly
@@ -104,7 +104,7 @@ at all. If you change `newsticker-scroll-smoothly' you
should also change
If t the echo area will not show immortal items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-hide-old-items-in-echo-area
@@ -113,7 +113,7 @@ If t the echo area will not show immortal items. See also
If t the echo area will show only new items, i.e. only items which have
been added between the last two retrievals."
:type 'boolean
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-hide-obsolete-items-in-echo-area
@@ -122,7 +122,7 @@ been added between the last two retrievals."
If t the echo area will not show obsolete items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defun newsticker--display-tick ()
@@ -205,7 +205,7 @@ running already."
(setq newsticker--ticker-timer
(run-at-time newsticker-ticker-interval
newsticker-ticker-interval
- 'newsticker--display-tick))))
+ #'newsticker--display-tick))))
(defun newsticker-stop-ticker ()
"Stop newsticker's ticker (but not the news retrieval)."
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 2e207be..d778cc1 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -52,86 +52,73 @@
(defface newsticker-treeview-face
'((((class color) (background dark)) :foreground "white")
(((class color) (background light)) :foreground "black"))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-new-face
'((t :inherit newsticker-treeview-face :weight bold))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-old-face
'((t :inherit newsticker-treeview-face))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-immortal-face
'((default :inherit newsticker-treeview-face :slant italic)
(((class color) (background dark)) :foreground "orange")
(((class color) (background light)) :foreground "blue"))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-obsolete-face
'((t :inherit newsticker-treeview-face :strike-through t))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-selection-face
'((((class color) (background dark)) :background "#4444aa")
(((class color) (background light)) :background "#bbbbff"))
- "Face for newsticker selection."
- :group 'newsticker-treeview)
+ "Face for newsticker selection.")
(defcustom newsticker-treeview-date-format
"%d.%m.%y, %H:%M"
"Format for the date column in the treeview list buffer.
See `format-time-string' for a list of valid specifiers."
:version "25.1"
- :type 'string
- :group 'newsticker-treeview)
+ :type 'string)
(defcustom newsticker-treeview-own-frame
nil
"Decides whether newsticker treeview creates and uses its own frame."
- :type 'boolean
- :group 'newsticker-treeview)
+ :type 'boolean)
(defcustom newsticker-treeview-treewindow-width
30
"Width of tree window in treeview layout.
See also `newsticker-treeview-listwindow-height'."
- :type 'integer
- :group 'newsticker-treeview)
+ :type 'integer)
(defcustom newsticker-treeview-listwindow-height
10
"Height of list window in treeview layout.
See also `newsticker-treeview-treewindow-width'."
- :type 'integer
- :group 'newsticker-treeview)
+ :type 'integer)
(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
t
"Decides whether to automatically mark displayed items as old.
If t an item is marked as old as soon as it is displayed. This
applies to newsticker only."
- :type 'boolean
- :group 'newsticker-treeview)
+ :type 'boolean)
(defcustom newsticker-treeview-use-feed-name-from-url-list-in-treeview
t
"Use the feed names from 'newsticker-url-list' for display in treeview."
:version "28.1"
- :type 'boolean
- :group 'newsticker-treeview)
+ :type 'boolean)
(defcustom newsticker-treeview-use-feed-name-from-url-list-in-itemview
t
"Use feed names from 'newsticker-url-list' in itemview."
:version "28.1"
- :type 'boolean
- :group 'newsticker-treeview)
+ :type 'boolean)
(defvar newsticker-groups
'("Feeds")
@@ -166,14 +153,16 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\"
\"feed 2\")
(defvar newsticker--treeview-feed-tree nil)
(defvar newsticker--treeview-vfeed-tree nil)
+(declare-function newsticker-handle-url "newst-plainview" ())
+
;; maps for the clickable portions
(defvar newsticker--treeview-url-keymap
(let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
- (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
- (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
- (define-key map "\n" 'newsticker-treeview-browse-url)
- (define-key map "\C-m" 'newsticker-treeview-browse-url)
- (define-key map [(control return)] 'newsticker-handle-url)
+ (define-key map [mouse-1] #'newsticker-treeview-mouse-browse-url)
+ (define-key map [mouse-2] #'newsticker-treeview-mouse-browse-url)
+ (define-key map "\n" #'newsticker-treeview-browse-url)
+ (define-key map "\C-m" #'newsticker-treeview-browse-url)
+ (define-key map [(control return)] #'newsticker-handle-url)
map)
"Key map for click-able headings in the newsticker treeview buffers.")
@@ -342,9 +331,9 @@ If string SHOW-FEED is non-nil it is shown in the item
string."
(replace-match " "))
(let ((map (make-sparse-keymap)))
(dolist (key'([mouse-1] [mouse-3]))
- (define-key map key 'newsticker-treeview-tree-click))
- (define-key map "\n" 'newsticker-treeview-show-item)
- (define-key map "\C-m" 'newsticker-treeview-show-item)
+ (define-key map key #'newsticker-treeview-tree-click))
+ (define-key map "\n" #'newsticker-treeview-show-item)
+ (define-key map "\C-m" #'newsticker-treeview-show-item)
(add-text-properties pos1 (point-max)
(list :nt-item item
:nt-feed feed
@@ -626,9 +615,9 @@ If CLEAR-BUFFER is non-nil the list buffer is completely
erased."
(defvar newsticker-treeview-list-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1]
- 'newsticker--treeview-list-sort-by-column)
+ #'newsticker--treeview-list-sort-by-column)
(define-key map [header-line mouse-2]
- 'newsticker--treeview-list-sort-by-column)
+ #'newsticker--treeview-list-sort-by-column)
map)
"Local keymap for newsticker treeview list window sort buttons.")
@@ -960,9 +949,9 @@ arguments NT-ID, FEED, VFEED and TOOLTIP are added as
properties."
(if (and num-new (> num-new 0))
(setq face 'newsticker-treeview-new-face))
(dolist (key '([mouse-1] [mouse-3]))
- (define-key map key 'newsticker-treeview-tree-click))
- (define-key map "\n" 'newsticker-treeview-tree-do-click)
- (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
+ (define-key map key #'newsticker-treeview-tree-click))
+ (define-key map "\n" #'newsticker-treeview-tree-do-click)
+ (define-key map "\C-m" #'newsticker-treeview-tree-do-click)
(propertize tag 'face face 'keymap map
:nt-id nt-id
:nt-feed feed
@@ -2029,37 +2018,37 @@ Return t if groups have changed, nil otherwise."
(defvar newsticker-treeview-mode-map
(let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
- (define-key map " " 'newsticker-treeview-next-page)
- (define-key map "a" 'newsticker-add-url)
- (define-key map "b" 'newsticker-treeview-browse-url-item)
- (define-key map "c" 'newsticker-treeview-customize-current-feed)
- (define-key map "F" 'newsticker-treeview-prev-feed)
- (define-key map "f" 'newsticker-treeview-next-feed)
- (define-key map "g" 'newsticker-treeview-get-news)
- (define-key map "G" 'newsticker-get-all-news)
- (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
- (define-key map "j" 'newsticker-treeview-jump)
- (define-key map "n" 'newsticker-treeview-next-item)
- (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
- (define-key map "O" 'newsticker-treeview-mark-list-items-old)
- (define-key map "o" 'newsticker-treeview-mark-item-old)
- (define-key map "p" 'newsticker-treeview-prev-item)
- (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
- (define-key map "q" 'newsticker-treeview-quit)
- (define-key map "S" 'newsticker-treeview-save-item)
- (define-key map "s" 'newsticker-treeview-save)
- (define-key map "u" 'newsticker-treeview-update)
- (define-key map "v" 'newsticker-treeview-browse-url)
- ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
- ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
- (define-key map "\M-m" 'newsticker-group-move-feed)
- (define-key map "\M-a" 'newsticker-group-add-group)
- (define-key map "\M-d" 'newsticker-group-delete-group)
- (define-key map "\M-r" 'newsticker-group-rename-group)
- (define-key map [M-down] 'newsticker-group-shift-feed-down)
- (define-key map [M-up] 'newsticker-group-shift-feed-up)
- (define-key map [M-S-down] 'newsticker-group-shift-group-down)
- (define-key map [M-S-up] 'newsticker-group-shift-group-up)
+ (define-key map " " #'newsticker-treeview-next-page)
+ (define-key map "a" #'newsticker-add-url)
+ (define-key map "b" #'newsticker-treeview-browse-url-item)
+ (define-key map "c" #'newsticker-treeview-customize-current-feed)
+ (define-key map "F" #'newsticker-treeview-prev-feed)
+ (define-key map "f" #'newsticker-treeview-next-feed)
+ (define-key map "g" #'newsticker-treeview-get-news)
+ (define-key map "G" #'newsticker-get-all-news)
+ (define-key map "i" #'newsticker-treeview-toggle-item-immortal)
+ (define-key map "j" #'newsticker-treeview-jump)
+ (define-key map "n" #'newsticker-treeview-next-item)
+ (define-key map "N" #'newsticker-treeview-next-new-or-immortal-item)
+ (define-key map "O" #'newsticker-treeview-mark-list-items-old)
+ (define-key map "o" #'newsticker-treeview-mark-item-old)
+ (define-key map "p" #'newsticker-treeview-prev-item)
+ (define-key map "P" #'newsticker-treeview-prev-new-or-immortal-item)
+ (define-key map "q" #'newsticker-treeview-quit)
+ (define-key map "S" #'newsticker-treeview-save-item)
+ (define-key map "s" #'newsticker-treeview-save)
+ (define-key map "u" #'newsticker-treeview-update)
+ (define-key map "v" #'newsticker-treeview-browse-url)
+ ;;(define-key map "\n" #'newsticker-treeview-scroll-item)
+ ;;(define-key map "\C-m" #'newsticker-treeview-scroll-item)
+ (define-key map "\M-m" #'newsticker-group-move-feed)
+ (define-key map "\M-a" #'newsticker-group-add-group)
+ (define-key map "\M-d" #'newsticker-group-delete-group)
+ (define-key map "\M-r" #'newsticker-group-rename-group)
+ (define-key map [M-down] #'newsticker-group-shift-feed-down)
+ (define-key map [M-up] #'newsticker-group-shift-feed-up)
+ (define-key map [M-S-down] #'newsticker-group-shift-group-down)
+ (define-key map [M-S-up] #'newsticker-group-shift-group-up)
map)
"Mode map for newsticker treeview.")
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index 1cdefc08..42a7e79 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -37,7 +37,7 @@ For instance, \"fśf.org\" => \"xn--ff-2sa.org\"."
;; add a check first to avoid doing unnecessary work.
(if (string-match "\\`[[:ascii:]]+\\'" domain)
domain
- (mapconcat 'puny-encode-string (split-string domain "[.]") ".")))
+ (mapconcat #'puny-encode-string (split-string domain "[.]") ".")))
(defun puny-encode-string (string)
"Encode STRING according to the IDNA/punycode algorithm.
@@ -57,7 +57,7 @@ For instance, \"bücher\" => \"xn--bcher-kva\"."
(defun puny-decode-domain (domain)
"Decode DOMAIN according to the IDNA/punycode algorithm.
For instance, \"xn--ff-2sa.org\" => \"fśf.org\"."
- (mapconcat 'puny-decode-string (split-string domain "[.]") "."))
+ (mapconcat #'puny-decode-string (split-string domain "[.]") "."))
(defun puny-decode-string (string)
"Decode an IDNA/punycode-encoded string.
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index ab1f43f..2574c8c 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,4 +1,4 @@
-;;; quickurl.el --- insert a URL based on text at point in buffer
+;;; quickurl.el --- insert a URL based on text at point in buffer -*-
lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -97,23 +97,19 @@
(locate-user-emacs-file "quickurls" ".quickurls")
"File that contains the URL list."
:version "24.4" ; added locate-user-emacs-file
- :type 'file
- :group 'quickurl)
+ :type 'file)
(defcustom quickurl-format-function #'quickurl-format-url
"Function to format the URL before insertion into the current buffer."
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defcustom quickurl-sort-function #'quickurl-sort-urls
"Function to sort the URL list."
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defcustom quickurl-grab-lookup-function #'current-word
"Function to grab the thing to lookup."
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defun quickurl--assoc-function (key alist)
"Default function for `quickurl-assoc-function'."
@@ -122,31 +118,26 @@
(defcustom quickurl-assoc-function #'quickurl--assoc-function
"Function to use for alist lookup into `quickurl-urls'."
:version "26.1" ; was the obsolete assoc-ignore-case
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defcustom quickurl-completion-ignore-case t
"Should `quickurl-ask' ignore case when doing the input lookup?"
- :type 'boolean
- :group 'quickurl)
+ :type 'boolean)
(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
"Text to write to `quickurl-url-file' before writing the URL list."
- :type 'string
- :group 'quickurl)
+ :type 'string)
(defcustom quickurl-postfix ""
"Text to write to `quickurl-url-file' after writing the URL list.
See the constant `quickurl-reread-hook-postfix' for some example text that
could be used here."
- :type 'string
- :group 'quickurl)
+ :type 'string)
(defcustom quickurl-list-mode-hook nil
"Hooks for `quickurl-list-mode'."
- :type 'hook
- :group 'quickurl)
+ :type 'hook)
;; Constants.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index c80cd49..938fadf 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -293,7 +293,7 @@ The following replacements are made:
Setting this alone will not affect the prompt;
use either M-x customize or also call `rcirc-update-prompt'."
:type 'string
- :set 'rcirc-set-changed
+ :set #'rcirc-set-changed
:initialize 'custom-initialize-default)
(defcustom rcirc-keywords nil
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index ad27167..94db318 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -643,7 +643,7 @@ starting with a colon. Example:
The object labels of the found items are returned as list."
(mapcar
(lambda (item-path) (secrets-get-item-property item-path "Label"))
- (apply 'secrets-search-item-paths collection attributes)))
+ (apply #'secrets-search-item-paths collection attributes)))
(defun secrets-create-item (collection item password &rest attributes)
"Create a new item in COLLECTION with label ITEM and password PASSWORD.
@@ -780,9 +780,9 @@ ITEM can also be an object path, which is used if contained
in COLLECTION."
(defvar secrets-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap special-mode-map
widget-keymap))
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "z" 'kill-current-buffer)
+ (define-key map "n" #'next-line)
+ (define-key map "p" #'previous-line)
+ (define-key map "z" #'kill-current-buffer)
map)
"Keymap used in `secrets-mode' buffers.")
@@ -859,7 +859,7 @@ to their attributes."
;; padding is needed to format attribute names.
(padding
(apply
- 'max
+ #'max
(cons
(1+ (length "password"))
(mapcar
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index ac1f701..eb78a25 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -36,14 +36,12 @@
(defcustom shr-color-visible-luminance-min 40
"Minimum luminance distance between two colors to be considered visible.
Must be between 0 and 100."
- :group 'shr-color
:type 'number)
(defcustom shr-color-visible-distance-min 5
"Minimum color distance between two colors to be considered visible.
This value is used to compare result for `ciede2000'. It's an
absolute value without any unit."
- :group 'shr-color
:type 'integer)
(defconst shr-color-html-colors-alist
@@ -332,8 +330,8 @@ color will be adapted to be visible on BG."
(if (or (null fg-norm)
(null bg-norm))
(list bg fg)
- (let* ((fg-lab (apply 'color-srgb-to-lab fg-norm))
- (bg-lab (apply 'color-srgb-to-lab bg-norm))
+ (let* ((fg-lab (apply #'color-srgb-to-lab fg-norm))
+ (bg-lab (apply #'color-srgb-to-lab bg-norm))
;; Compute color distance using CIE DE 2000
(fg-bg-distance (color-cie-de2000 fg-lab bg-lab))
;; Compute luminance distance (subtract L component)
@@ -351,12 +349,12 @@ color will be adapted to be visible on BG."
(list
(if fixed-background
bg
- (apply 'format "#%02x%02x%02x"
+ (apply #'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
- (apply 'color-lab-to-srgb bg-lab))))
- (apply 'format "#%02x%02x%02x"
+ (apply #'color-lab-to-srgb bg-lab))))
+ (apply #'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
- (apply 'color-lab-to-srgb fg-lab))))))))))
+ (apply #'color-lab-to-srgb fg-lab))))))))))
(provide 'shr-color)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 0e89999..c122a19 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -220,20 +220,20 @@ and other things:
(defvar shr-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'shr-show-alt-text)
- (define-key map "i" 'shr-browse-image)
- (define-key map "z" 'shr-zoom-image)
- (define-key map [?\t] 'shr-next-link)
- (define-key map [?\M-\t] 'shr-previous-link)
+ (define-key map "a" #'shr-show-alt-text)
+ (define-key map "i" #'shr-browse-image)
+ (define-key map "z" #'shr-zoom-image)
+ (define-key map [?\t] #'shr-next-link)
+ (define-key map [?\M-\t] #'shr-previous-link)
(define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'shr-browse-url)
- (define-key map [C-down-mouse-1] 'shr-mouse-browse-url-new-window)
- (define-key map "I" 'shr-insert-image)
- (define-key map "w" 'shr-maybe-probe-and-copy-url)
- (define-key map "u" 'shr-maybe-probe-and-copy-url)
- (define-key map "v" 'shr-browse-url)
- (define-key map "O" 'shr-save-contents)
- (define-key map "\r" 'shr-browse-url)
+ (define-key map [mouse-2] #'shr-browse-url)
+ (define-key map [C-down-mouse-1] #'shr-mouse-browse-url-new-window)
+ (define-key map "I" #'shr-insert-image)
+ (define-key map "w" #'shr-maybe-probe-and-copy-url)
+ (define-key map "u" #'shr-maybe-probe-and-copy-url)
+ (define-key map "v" #'shr-browse-url)
+ (define-key map "O" #'shr-save-contents)
+ (define-key map "\r" #'shr-browse-url)
map))
(defvar shr-image-map
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index 7bc1d16..966f0f0 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -139,9 +139,9 @@
(defvar sieve-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-l" 'sieve-upload)
- (define-key map "\C-c\C-c" 'sieve-upload-and-kill)
- (define-key map "\C-c\C-m" 'sieve-manage)
+ (define-key map "\C-c\C-l" #'sieve-upload)
+ (define-key map "\C-c\C-c" #'sieve-upload-and-kill)
+ (define-key map "\C-c\C-m" #'sieve-manage)
map)
"Key map used in sieve mode.")
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 3cc5569..821ef4a 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -10,6 +10,7 @@
;; Package: soap-client
;; Homepage: https://github.com/alex-hhh/emacs-soap-client
;; Package-Requires: ((cl-lib "0.6.1"))
+;;FIXME: Put in `Package-Requires:' the Emacs version we expect.
;; This file is part of GNU Emacs.
@@ -771,6 +772,8 @@ This is a specialization of `soap-decode-type' for
(Array (soap-decode-array node))))))
(defalias 'soap-type-of
+ ;; FIXME: Once we drop support for Emacs<25, use generic functions
+ ;; via `cl-defmethod' instead of our own ad-hoc version of it.
(if (eq 'soap-xs-basic-type (type-of (make-soap-xs-basic-type)))
;; `type-of' in Emacs ≥ 26 already does what we need.
#'type-of
@@ -1263,7 +1266,7 @@ See also `soap-wsdl-resolve-references'."
(soap-l2wk (xml-node-name node)))
(setf (soap-xs-simple-type-base type)
- (mapcar 'soap-l2fq
+ (mapcar #'soap-l2fq
(split-string
(or (xml-get-attribute-or-nil node 'memberTypes) ""))))
@@ -1343,7 +1346,7 @@ See also `soap-wsdl-resolve-references'."
(soap-validate-xs-basic-type value base))))
(error (push (cadr error-object) messages))))
(when messages
- (error (mapconcat 'identity (nreverse messages) "; and: "))))
+ (error (mapconcat #'identity (nreverse messages) "; and: "))))
(cl-labels ((fail-with-message (format value)
(push (format format value) messages)
(throw 'invalid nil)))
@@ -2345,8 +2348,8 @@ See also `soap-resolve-references' and
(when (= (length (soap-operation-parameter-order operation)) 0)
(setf (soap-operation-parameter-order operation)
- (mapcar 'car (soap-message-parts
- (cdr (soap-operation-input operation))))))
+ (mapcar #'car (soap-message-parts
+ (cdr (soap-operation-input operation))))))
(setf (soap-operation-parameter-order operation)
(mapcar (lambda (p)
@@ -2391,13 +2394,13 @@ See also `soap-wsdl-resolve-references'."
;; Install resolvers for our types
(progn
(put (soap-type-of (make-soap-message)) 'soap-resolve-references
- 'soap-resolve-references-for-message)
+ #'soap-resolve-references-for-message)
(put (soap-type-of (make-soap-operation)) 'soap-resolve-references
- 'soap-resolve-references-for-operation)
+ #'soap-resolve-references-for-operation)
(put (soap-type-of (make-soap-binding)) 'soap-resolve-references
- 'soap-resolve-references-for-binding)
+ #'soap-resolve-references-for-binding)
(put (soap-type-of (make-soap-port)) 'soap-resolve-references
- 'soap-resolve-references-for-port))
+ #'soap-resolve-references-for-port))
(defun soap-wsdl-resolve-references (wsdl)
"Resolve all references inside the WSDL structure.
@@ -2511,7 +2514,7 @@ Build on WSDL if it is provided."
(soap-wsdl-resolve-references (soap-parse-wsdl xml wsdl))
wsdl))
-(defalias 'soap-load-wsdl-from-url 'soap-load-wsdl)
+(defalias 'soap-load-wsdl-from-url #'soap-load-wsdl)
(defun soap-parse-wsdl-phase-validate-node (node)
"Assert that NODE is valid."
@@ -2884,7 +2887,7 @@ decode function to perform the actual decoding."
(if (fboundp 'define-error)
(define-error 'soap-error "SOAP error")
- ;; Support older Emacs versions that do not have define-error, so
+ ;; Support Emacs<24.4 that do not have define-error, so
;; that soap-client can remain unchanged in GNU ELPA.
(put 'soap-error
'error-conditions
@@ -3123,8 +3126,7 @@ http://schemas.xmlsoap.org/soap/encoding/\"\n";))
(defcustom soap-debug nil
"When t, enable some debugging facilities."
- :type 'boolean
- :group 'soap-client)
+ :type 'boolean)
(defun soap-find-port (wsdl service)
"Return the WSDL port having SERVICE name.
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 9d4e440..6f9ce6a 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -109,7 +109,7 @@ soap-xs-attribute objects."
This is a specialization of `soap-sample-value' for
`soap-xs-simple-type' objects."
(append
- (mapcar 'soap-sample-value-for-xs-attribute
+ (mapcar #'soap-sample-value-for-xs-attribute
(soap-xs-type-attributes type))
(cond
((soap-xs-simple-type-enumeration type)
@@ -143,7 +143,7 @@ This is a specialization of `soap-sample-value' for
This is a specialization of `soap-sample-value' for
`soap-xs-complex-type' objects."
(append
- (mapcar 'soap-sample-value-for-xs-attribute
+ (mapcar #'soap-sample-value-for-xs-attribute
(soap-xs-type-attributes type))
(cl-case (soap-xs-complex-type-indicator type)
(array
@@ -176,31 +176,31 @@ This is a specialization of `soap-sample-value' for
;; Install soap-sample-value methods for our types
(put (soap-type-of (make-soap-xs-basic-type))
'soap-sample-value
- 'soap-sample-value-for-xs-basic-type)
+ #'soap-sample-value-for-xs-basic-type)
(put (soap-type-of (make-soap-xs-element))
'soap-sample-value
- 'soap-sample-value-for-xs-element)
+ #'soap-sample-value-for-xs-element)
(put (soap-type-of (make-soap-xs-attribute))
'soap-sample-value
- 'soap-sample-value-for-xs-attribute)
+ #'soap-sample-value-for-xs-attribute)
(put (soap-type-of (make-soap-xs-attribute))
'soap-sample-value
- 'soap-sample-value-for-xs-attribute-group)
+ #'soap-sample-value-for-xs-attribute-group)
(put (soap-type-of (make-soap-xs-simple-type))
'soap-sample-value
- 'soap-sample-value-for-xs-simple-type)
+ #'soap-sample-value-for-xs-simple-type)
(put (soap-type-of (make-soap-xs-complex-type))
'soap-sample-value
- 'soap-sample-value-for-xs-complex-type)
+ #'soap-sample-value-for-xs-complex-type)
(put (soap-type-of (make-soap-message))
'soap-sample-value
- 'soap-sample-value-for-message))
+ #'soap-sample-value-for-message))
@@ -437,7 +437,7 @@ TYPE is a `soap-xs-complex-type'."
(funcall (list 'soap-invoke '*WSDL* "SomeService"
(soap-element-name operation))))
(let ((sample-invocation
- (append funcall (mapcar 'cdr sample-message-value))))
+ (append funcall (mapcar #'cdr sample-message-value))))
(pp sample-invocation (current-buffer)))))
(defun soap-inspect-port-type (port-type)
@@ -460,7 +460,7 @@ TYPE is a `soap-xs-complex-type'."
collect o))
op-name-width)
- (setq operations (sort operations 'string<))
+ (setq operations (sort operations #'string<))
(setq op-name-width (cl-loop for o in operations maximizing (length o)))
@@ -504,39 +504,39 @@ TYPE is a `soap-xs-complex-type'."
;; Install the soap-inspect methods for our types
(put (soap-type-of (make-soap-xs-basic-type)) 'soap-inspect
- 'soap-inspect-xs-basic-type)
+ #'soap-inspect-xs-basic-type)
(put (soap-type-of (make-soap-xs-element)) 'soap-inspect
- 'soap-inspect-xs-element)
+ #'soap-inspect-xs-element)
(put (soap-type-of (make-soap-xs-simple-type)) 'soap-inspect
- 'soap-inspect-xs-simple-type)
+ #'soap-inspect-xs-simple-type)
(put (soap-type-of (make-soap-xs-complex-type)) 'soap-inspect
- 'soap-inspect-xs-complex-type)
+ #'soap-inspect-xs-complex-type)
(put (soap-type-of (make-soap-xs-attribute)) 'soap-inspect
- 'soap-inspect-xs-attribute)
+ #'soap-inspect-xs-attribute)
(put (soap-type-of (make-soap-xs-attribute-group)) 'soap-inspect
- 'soap-inspect-xs-attribute-group)
+ #'soap-inspect-xs-attribute-group)
(put (soap-type-of (make-soap-message)) 'soap-inspect
- 'soap-inspect-message)
+ #'soap-inspect-message)
(put (soap-type-of (make-soap-operation)) 'soap-inspect
- 'soap-inspect-operation)
+ #'soap-inspect-operation)
(put (soap-type-of (make-soap-port-type)) 'soap-inspect
- 'soap-inspect-port-type)
+ #'soap-inspect-port-type)
(put (soap-type-of (make-soap-binding)) 'soap-inspect
- 'soap-inspect-binding)
+ #'soap-inspect-binding)
(put (soap-type-of (make-soap-port)) 'soap-inspect
- 'soap-inspect-port)
+ #'soap-inspect-port)
(put (soap-type-of (soap-make-wsdl "origin")) 'soap-inspect
- 'soap-inspect-wsdl))
+ #'soap-inspect-wsdl))
(provide 'soap-inspect)
;;; soap-inspect.el ends here
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index 44f535f..bb65eca 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,4 +1,4 @@
-;;; telnet.el --- run a telnet session from within an Emacs buffer
+;;; telnet.el --- run a telnet session from within an Emacs buffer -*-
lexical-binding: t; -*-
;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -63,11 +63,11 @@ LOGIN-NAME, which is optional, says what to log in as on
that machine.")
(defvar telnet-new-line "\r")
(defvar telnet-mode-map
(let ((map (nconc (make-sparse-keymap) comint-mode-map)))
- (define-key map "\C-m" 'telnet-send-input)
- ;; (define-key map "\C-j" 'telnet-send-input)
- (define-key map "\C-c\C-q" 'send-process-next-char)
- (define-key map "\C-c\C-c" 'telnet-interrupt-subjob)
- (define-key map "\C-c\C-z" 'telnet-c-z)
+ (define-key map "\C-m" #'telnet-send-input)
+ ;; (define-key map "\C-j" #'telnet-send-input)
+ (define-key map "\C-c\C-q" #'send-process-next-char)
+ (define-key map "\C-c\C-c" #'telnet-interrupt-subjob)
+ (define-key map "\C-c\C-z" #'telnet-c-z)
map))
(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
@@ -152,7 +152,7 @@ rejecting one login and prompting again for a username and
password.")
(t (telnet-check-software-type-initialize string)
(telnet-filter proc string)
(cond ((> telnet-count telnet-maximum-count)
- (set-process-filter proc 'telnet-filter))
+ (set-process-filter proc #'telnet-filter))
(t (setq telnet-count (1+ telnet-count)))))))))
;; Identical to comint-simple-send, except that it sends telnet-new-line
@@ -227,9 +227,9 @@ Normally input is edited in Emacs and sent a line at a
time."
(if (and buffer (get-buffer-process buffer))
(switch-to-buffer (concat "*" name "*"))
(switch-to-buffer
- (apply 'make-comint name telnet-program nil telnet-options))
+ (apply #'make-comint name telnet-program nil telnet-options))
(setq process (get-buffer-process (current-buffer)))
- (set-process-filter process 'telnet-initial-filter)
+ (set-process-filter process #'telnet-initial-filter)
;; Don't send the `open' cmd till telnet is ready for it.
(accept-process-output process)
(erase-buffer)
@@ -263,7 +263,7 @@ Normally input is edited in Emacs and sent a line at a
time."
(require 'shell)
(let ((name (concat "rsh-" host )))
(switch-to-buffer (make-comint name remote-shell-program nil host))
- (set-process-filter (get-process name) 'telnet-initial-filter)
+ (set-process-filter (get-process name) #'telnet-initial-filter)
(telnet-mode)
(setq-local telnet-connect-command (list 'rsh host))
(setq telnet-count -16)))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 2b0a4d9..2fcb7b1 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -162,16 +162,20 @@ Return DEFAULT if not set."
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
file property value remote-file-name-inhibit-cache cache-used cached-at)
+ ;; For analysis purposes, count the number of getting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (numberp (bound-and-true-p var))
- (progn
- (add-hook 'tramp-cache-unload-hook
- (lambda () (makunbound var)))
- 0))))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
(set var (1+ val))))
value))
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (dolist (var (all-completions "tramp-cache-get-count-" obarray))
+ (unintern var obarray))))
+
;;;###tramp-autoload
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
@@ -186,16 +190,20 @@ Return VALUE."
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
(tramp-message key 8 "%s %s %s" file property value)
+ ;; For analysis purposes, count the number of setting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (numberp (bound-and-true-p var))
- (progn
- (add-hook 'tramp-cache-unload-hook
- (lambda () (makunbound var)))
- 0))))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
(set var (1+ val))))
value))
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (dolist (var (all-completions "tramp-cache-set-count-" obarray))
+ (unintern var obarray))))
+
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 2aacf26..1e48f8d 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -250,7 +250,7 @@ function returns nil"
(host (or (file-remote-p string 'host) ""))
item result)
(while (setq item (pop tdra))
- (when (string-match-p (or (eval (car item)) "") string)
+ (when (string-match-p (or (eval (car item) t) "") string)
(setq tdra nil
result
(format-spec
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 27461e6..b67de1b 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -70,7 +70,7 @@
It is the default value of `temporary-file-directory'."
;; We must return a local directory. If it is remote, we could run
;; into an infloop.
- (eval (car (get 'temporary-file-directory 'standard-value))))
+ (eval (car (get 'temporary-file-directory 'standard-value)) t))
(defsubst tramp-compat-make-temp-name ()
"Generate a local temporary file name (compat function)."
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
new file mode 100644
index 0000000..ec1db86
--- /dev/null
+++ b/lisp/net/tramp-fuse.el
@@ -0,0 +1,205 @@
+;;; tramp-fuse.el --- Tramp access functions for FUSE mounts -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; 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:
+
+;; These are helper functions for FUSE file systems.
+
+;;; Code:
+
+(require 'tramp)
+
+;; File name primitives.
+
+(defun tramp-fuse-handle-delete-directory
+ (directory &optional recursive trash)
+ "Like `delete-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (tramp-flush-directory-properties v localname)
+ (delete-directory (tramp-fuse-local-file-name directory) recursive trash)))
+
+(defun tramp-fuse-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (delete-file (tramp-fuse-local-file-name filename) trash)
+ (tramp-flush-file-properties v localname)))
+
+(defun tramp-fuse-handle-directory-files
+ (directory &optional full match nosort count)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (with-parsed-tramp-file-name directory nil
+ (let ((result
+ (tramp-compat-directory-files
+ (tramp-fuse-local-file-name directory) full match nosort count)))
+ ;; Massage the result.
+ (when full
+ (let ((local (concat "^" (regexp-quote (tramp-fuse-mount-point v))))
+ (remote (directory-file-name
+ (funcall
+ (if (tramp-compat-file-name-quoted-p directory)
+ #'tramp-compat-file-name-quote #'identity)
+ (file-remote-p directory)))))
+ (setq result
+ (mapcar
+ (lambda (x) (replace-regexp-in-string local remote x))
+ result))))
+ ;; Some storage systems do not return "." and "..".
+ (dolist (item '(".." "."))
+ (when (and (string-match-p (or match (regexp-quote item)) item)
+ (not
+ (member (if full (setq item (concat directory item)) item)
+ result)))
+ (setq result (cons item result))))
+ ;; Return result.
+ (if nosort result (sort result #'string<))))))
+
+(defun tramp-fuse-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (file-attributes (tramp-fuse-local-file-name filename) id-format))))
+
+(defun tramp-fuse-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (file-executable-p (tramp-fuse-local-file-name filename)))))
+
+(defun tramp-fuse-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (delete-dups
+ (append
+ (file-name-all-completions
+ filename (tramp-fuse-local-file-name directory))
+ ;; Some storage systems do not return "." and "..".
+ (let (result)
+ (dolist (item '(".." ".") result)
+ (when (string-prefix-p filename item)
+ (catch 'match
+ (dolist (elt completion-regexp-list)
+ (unless (string-match-p elt item) (throw 'match nil)))
+ (setq result (cons (concat item "/") result))))))))))
+
+(defun tramp-fuse-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (file-readable-p (tramp-fuse-local-file-name filename)))))
+
+;; This function isn't used.
+(defun tramp-fuse-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (insert-directory
+ (tramp-fuse-local-file-name filename) switches wildcard full-directory-p)
+ (goto-char (point-min))
+ (while (search-forward (tramp-fuse-local-file-name filename) nil 'noerror)
+ (replace-match filename)))
+
+(defun tramp-fuse-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name dir) nil
+ (make-directory (tramp-fuse-local-file-name dir) parents)
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole file cache.
+ (tramp-flush-file-properties v localname)
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))))
+
+
+;; File name helper functions.
+
+(defun tramp-fuse-mount-spec (vec)
+ "Return local mount spec of VEC."
+ (if-let ((host (tramp-file-name-host vec))
+ (user (tramp-file-name-user vec)))
+ (format "%s@%s:/" user host)
+ (format "%s:/" host)))
+
+(defun tramp-fuse-mount-point (vec)
+ "Return local mount point of VEC."
+ (or (tramp-get-connection-property vec "mount-point" nil)
+ (expand-file-name
+ (concat
+ tramp-temp-name-prefix
+ (tramp-file-name-method vec) "."
+ (when (tramp-file-name-user vec)
+ (concat (tramp-file-name-user-domain vec) "@"))
+ (tramp-file-name-host-port vec))
+ (tramp-compat-temporary-file-directory))))
+
+(defun tramp-fuse-mounted-p (vec)
+ "Check, whether fuse volume determined by VEC is mounted."
+ (when (tramp-get-connection-process vec)
+ ;; We cannot use `with-connection-property', because we don't want
+ ;; to cache a nil result.
+ (or (tramp-get-connection-property
+ (tramp-get-connection-process vec) "mounted" nil)
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (fuse (concat "fuse." (tramp-file-name-method vec)))
+ (mount (shell-command-to-string (format "mount -t %s" fuse))))
+ (tramp-message vec 6 "%s %s" "mount -t" fuse)
+ (tramp-message vec 6 "\n%s" mount)
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "mounted"
+ (when (string-match
+ (format
+ "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec)))
+ mount)
+ (match-string 1 mount)))))))
+
+(defun tramp-fuse-local-file-name (filename)
+ "Return local mount name of FILENAME."
+ (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ ;; As long as we call `tramp-*-maybe-open-connection' here,
+ ;; we cache the result.
+ (with-tramp-file-property v localname "local-file-name"
+ (funcall
+ (intern
+ (format "tramp-%s-maybe-open-connection" (tramp-file-name-method v)))
+ v)
+ (let ((quoted (tramp-compat-file-name-quoted-p localname))
+ (localname (tramp-compat-file-name-unquote localname)))
+ (funcall
+ (if quoted #'tramp-compat-file-name-quote #'identity)
+ (expand-file-name
+ (if (file-name-absolute-p localname)
+ (substring localname 1) localname)
+ (tramp-fuse-mount-point v)))))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-fuse 'force)))
+
+(provide 'tramp-fuse)
+
+;;; tramp-fuse.el ends here
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 64b5b48..5adc4ce 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -231,7 +231,7 @@ NAME must be equal to `tramp-current-connection'."
(delete (info-lookup->mode-cache 'symbol 'tramp-info-lookup-mode)
(info-lookup->topic-cache 'symbol)))))
- (dolist (mode (mapcar 'car (info-lookup->topic-value 'symbol)))
+ (dolist (mode (mapcar #'car (info-lookup->topic-value 'symbol)))
;; Add `tramp-info-lookup-mode' to `other-modes' for either
;; `emacs-lisp-mode' itself, or to modes which use
;; `emacs-lisp-mode' as `other-modes'. Reset `info-lookup-cache'.
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index a7f4c9b..e6f9fe5 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -35,8 +35,8 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
(require 'tramp)
+(require 'tramp-fuse)
;;;###tramp-autoload
(defconst tramp-rclone-method "rclone"
@@ -77,11 +77,11 @@
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
(copy-file . tramp-rclone-handle-copy-file)
- (delete-directory . tramp-rclone-handle-delete-directory)
- (delete-file . tramp-rclone-handle-delete-file)
+ (delete-directory . tramp-fuse-handle-delete-directory)
+ (delete-file . tramp-fuse-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-rclone-handle-directory-files)
+ (directory-files . tramp-fuse-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . ignore)
@@ -90,15 +90,15 @@
(expand-file-name . tramp-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . ignore)
- (file-attributes . tramp-rclone-handle-file-attributes)
+ (file-attributes . tramp-fuse-handle-file-attributes)
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-rclone-handle-file-executable-p)
+ (file-executable-p . tramp-fuse-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-rclone-handle-file-name-all-completions)
+ (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
(file-name-completion . tramp-handle-file-name-completion)
@@ -110,7 +110,7 @@
(file-notify-rm-watch . ignore)
(file-notify-valid-p . ignore)
(file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-rclone-handle-file-readable-p)
+ (file-readable-p . tramp-fuse-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
@@ -124,7 +124,7 @@
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-rclone-handle-make-directory)
+ (make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
@@ -277,86 +277,6 @@ file names."
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
-(defun tramp-rclone-handle-delete-directory
- (directory &optional recursive trash)
- "Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (tramp-flush-directory-properties v localname)
- (delete-directory (tramp-rclone-local-file-name directory) recursive
trash)))
-
-(defun tramp-rclone-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (delete-file (tramp-rclone-local-file-name filename) trash)
- (tramp-flush-file-properties v localname)))
-
-(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort count)
- "Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (with-parsed-tramp-file-name directory nil
- (let ((result
- (tramp-compat-directory-files
- (tramp-rclone-local-file-name directory) full match nosort
count)))
- ;; Massage the result.
- (when full
- (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
- (remote (funcall (if (tramp-compat-file-name-quoted-p directory)
- #'tramp-compat-file-name-quote #'identity)
- (file-remote-p directory))))
- (setq result
- (mapcar
- (lambda (x) (replace-regexp-in-string local remote x))
- result))))
- ;; Some storage systems do not return "." and "..".
- (dolist (item '(".." "."))
- (when (and (string-match-p (or match (regexp-quote item)) item)
- (not
- (member (if full (setq item (concat directory item)) item)
- result)))
- (setq result (cons item result))))
- ;; Return result.
- (if nosort result (sort result #'string<))))))
-
-(defun tramp-rclone-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (file-attributes (tramp-rclone-local-file-name filename) id-format))))
-
-(defun tramp-rclone-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-executable-p"
- (file-executable-p (tramp-rclone-local-file-name filename)))))
-
-(defun tramp-rclone-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (delete-dups
- (append
- (file-name-all-completions
- filename (tramp-rclone-local-file-name directory))
- ;; Some storage systems do not return "." and "..".
- (let (result)
- (dolist (item '(".." ".") result)
- (when (string-prefix-p filename item)
- (catch 'match
- (dolist (elt completion-regexp-list)
- (unless (string-match-p elt item) (throw 'match nil)))
- (setq result (cons (concat item "/") result))))))))))
-
-(defun tramp-rclone-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-readable-p"
- (file-readable-p (tramp-rclone-local-file-name filename)))))
-
(defun tramp-rclone-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
@@ -384,36 +304,6 @@ file names."
(when (and total free)
(list total free (- total free))))))))
-(defun tramp-rclone-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (insert-directory
- (tramp-rclone-local-file-name filename) switches wildcard full-directory-p)
- (goto-char (point-min))
- (while (search-forward (tramp-rclone-local-file-name filename) nil 'noerror)
- (replace-match filename)))
-
-(defun tramp-rclone-handle-insert-file-contents
- (filename &optional visit beg end replace)
- "Like `insert-file-contents' for Tramp files."
- (let ((result
- (insert-file-contents
- (tramp-rclone-local-file-name filename) visit beg end replace)))
- (prog1
- (list (expand-file-name filename) (cadr result))
- (when visit (setq buffer-file-name filename)))))
-
-(defun tramp-rclone-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name dir) nil
- (make-directory (tramp-rclone-local-file-name dir) parents)
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole file cache.
- (tramp-flush-file-properties v localname)
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))))
-
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
@@ -431,50 +321,6 @@ file names."
;; File name conversions.
-(defun tramp-rclone-mount-point (vec)
- "Return local mount point of VEC."
- (expand-file-name
- (concat
- tramp-temp-name-prefix (tramp-file-name-method vec)
- "." (tramp-file-name-host vec))
- (tramp-compat-temporary-file-directory)))
-
-(defun tramp-rclone-mounted-p (vec)
- "Check, whether storage system determined by VEC is mounted."
- (when (tramp-get-connection-process vec)
- ;; We cannot use `with-connection-property', because we don't want
- ;; to cache a nil result.
- (or (tramp-get-connection-property
- (tramp-get-connection-process vec) "mounted" nil)
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (mount (shell-command-to-string "mount -t fuse.rclone")))
- (tramp-message vec 6 "%s" "mount -t fuse.rclone")
- (tramp-message vec 6 "\n%s" mount)
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "mounted"
- (when (string-match
- (format
- "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec)))
- mount)
- (match-string 1 mount)))))))
-
-(defun tramp-rclone-local-file-name (filename)
- "Return local mount name of FILENAME."
- (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- ;; As long as we call `tramp-rclone-maybe-open-connection' here,
- ;; we cache the result.
- (with-tramp-file-property v localname "local-file-name"
- (tramp-rclone-maybe-open-connection v)
- (let ((quoted (tramp-compat-file-name-quoted-p localname))
- (localname (tramp-compat-file-name-unquote localname)))
- (funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
- (expand-file-name
- (if (file-name-absolute-p localname)
- (substring localname 1) localname)
- (tramp-rclone-mount-point v)))))))
-
(defun tramp-rclone-remote-file-name (filename)
"Return FILENAME as used in the `rclone' command."
(setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
@@ -487,7 +333,7 @@ file names."
;; TODO: This shall be handled by `expand-file-name'.
(setq localname
(replace-regexp-in-string "^\\." "" (or localname "")))
- (format "%s%s" (tramp-rclone-mounted-p v) localname)))
+ (format "%s%s" (tramp-fuse-mounted-p v) localname)))
;; It is a local file name.
filename))
@@ -517,20 +363,18 @@ connection if a previous connection has died for some
reason."
(tramp-set-connection-local-variables vec)))
;; Create directory.
- (unless (file-directory-p (tramp-rclone-mount-point vec))
- (make-directory (tramp-rclone-mount-point vec) 'parents))
+ (unless (file-directory-p (tramp-fuse-mount-point vec))
+ (make-directory (tramp-fuse-mount-point vec) 'parents))
;; Mount. This command does not return, so we use 0 as
;; DESTINATION of `tramp-call-process'.
- (unless (tramp-rclone-mounted-p vec)
+ (unless (tramp-fuse-mounted-p vec)
(apply
#'tramp-call-process
vec tramp-rclone-program nil 0 nil
- (delq nil
- `("mount" ,(concat host ":/")
- ,(tramp-rclone-mount-point vec)
- ;; This could be nil.
- ,@(tramp-get-method-parameter vec 'tramp-mount-args))))
+ "mount" (tramp-fuse-mount-spec vec)
+ (tramp-fuse-mount-point vec)
+ (tramp-get-method-parameter vec 'tramp-mount-args))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 5730199..14abf55 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2370,53 +2370,29 @@ The method used must be an out-of-band method."
(setq listener (number-to-string (+ 50000 (random 10000))))))
;; Compose copy command.
- (setq host (or host "")
- user (or user "")
- port (or port "")
- spec (format-spec-make
- ?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" ""))
- options (format-spec (tramp-ssh-controlmaster-options v) spec)
- spec (format-spec-make
- ?h host ?u user ?p port ?r listener ?c options
- ?k (if keep-date " " "")
+ (setq options
+ (format-spec
+ (tramp-ssh-controlmaster-options v)
+ (format-spec-make
+ ?t (tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" "")))
+ spec (list
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?r listener ?c options ?k (if keep-date " " "")
?n (concat "2>" (tramp-get-remote-null-device v)))
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
v 'tramp-copy-keep-date)
-
copy-args
- (delete
- ;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement
- ;; for the whole keep-date sublist.
- " "
- (dolist
- (x (tramp-get-method-parameter v 'tramp-copy-args) copy-args)
- (setq copy-args
- (append
- copy-args
- (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
- (if (member "" y) '(" ") y))))))
-
- copy-env
- (delq
- nil
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (string-join x " ")))
- (tramp-get-method-parameter v 'tramp-copy-env)))
-
+ ;; " " has either been a replacement of "%k" (when
+ ;; 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))
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
remote-copy-program
- (tramp-get-method-parameter v 'tramp-remote-copy-program))
-
- (dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args))
- (setq remote-copy-args
- (append
- remote-copy-args
- (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
- (if (member "" y) '(" ") y)))))
+ (tramp-get-method-parameter v 'tramp-remote-copy-program)
+ remote-copy-args
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
;; Check for local copy program.
(unless (executable-find copy-program)
@@ -2462,10 +2438,11 @@ The method used must be an out-of-band method."
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
- (while copy-env
+ (when copy-env
(tramp-message
- orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
- (setenv (pop copy-env) (pop copy-env)))
+ orig-vec 6 "%s=\"%s\""
+ (car copy-env) (string-join (cdr copy-env) " "))
+ (setenv (car copy-env) (string-join (cdr copy-env) " ")))
(setq
copy-args
(append
@@ -4918,7 +4895,7 @@ If there is just some editing, retry it after 5 seconds."
(progn
(tramp-message
vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
- (run-at-time 5 nil 'tramp-timeout-session vec))
+ (run-at-time 5 nil #'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
(tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
@@ -5049,19 +5026,17 @@ connection if a previous connection has died for some
reason."
(l-domain (tramp-file-name-domain hop))
(l-host (tramp-file-name-host hop))
(l-port (tramp-file-name-port hop))
- (login-program
- (tramp-get-method-parameter hop 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter hop 'tramp-login-args))
(remote-shell
(tramp-get-method-parameter hop 'tramp-remote-shell))
(extra-args (tramp-get-sh-extra-args remote-shell))
(async-args
- (tramp-get-method-parameter hop 'tramp-async-args))
+ (tramp-compat-flatten-tree
+ (tramp-get-method-parameter hop 'tramp-async-args)))
(connection-timeout
(tramp-get-method-parameter
hop 'tramp-connection-timeout))
- (command login-program)
+ (command
+ (tramp-get-method-parameter hop 'tramp-login-program))
;; We don't create the temporary file. In
;; fact, it is just a prefix for the
;; ControlPath option of ssh; the real
@@ -5075,11 +5050,7 @@ connection if a previous connection has died for some
reason."
(with-tramp-connection-property
(tramp-get-process vec) "temp-file"
(tramp-compat-make-temp-name)))
- spec r-shell)
-
- ;; Add arguments for asynchronous processes.
- (when (and process-name async-args)
- (setq login-args (append async-args login-args)))
+ r-shell)
;; Check, whether there is a restricted shell.
(dolist (elt tramp-restricted-shell-hosts-alist)
@@ -5104,31 +5075,28 @@ connection if a previous connection has died for some
reason."
;; Replace `login-args' place holders.
(setq
- l-host (or l-host "")
- l-user (or l-user "")
- l-port (or l-port "")
- spec (format-spec-make ?t tmpfile)
- options (format-spec options spec)
- spec (format-spec-make
- ?h l-host ?u l-user ?p l-port ?c options
- ?l (concat remote-shell " " extra-args " -i"))
command
- (concat
- ;; We do not want to see the trailing local
- ;; prompt in `start-file-process'.
- (unless r-shell "exec ")
- command " "
- (mapconcat
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (string-join x " ")))
- login-args " ")
- ;; 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".
- (when r-shell " && exit || exit")))
+ (mapconcat
+ #'identity
+ (append
+ ;; We do not want to see the trailing local
+ ;; prompt in `start-file-process'.
+ (unless r-shell '("exec"))
+ `(,command)
+ ;; Add arguments for asynchronous processes.
+ (when process-name async-args)
+ (tramp-expand-args
+ hop 'tramp-login-args
+ ?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".
+ (when r-shell '("&&" "exit" "||" "exit")))
+ " "))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
@@ -5149,7 +5117,7 @@ connection if a previous connection has died for some
reason."
(when (tramp-get-connection-property p "session-timeout" nil)
(run-at-time
(tramp-get-connection-property p "session-timeout" nil) nil
- 'tramp-timeout-session vec))
+ #'tramp-timeout-session vec))
;; Make initial shell settings.
(tramp-open-connection-setup-interactive-shell p vec)
@@ -5469,7 +5437,7 @@ Nonexistent directories are removed from spec."
(progn
(tramp-message
vec 3
- "`getconf PATH' not successful, using default value \"%s\"."
+ "`getconf PATH' not successful, using default value
\"%s\"."
"/bin:/usr/bin")
"/bin:/usr/bin"))))
(own-remote-path
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
new file mode 100644
index 0000000..ce9412c
--- /dev/null
+++ b/lisp/net/tramp-sshfs.el
@@ -0,0 +1,367 @@
+;;; tramp-sshfs.el --- Tramp access functions via sshfs -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; 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:
+
+;; sshfs is a program to mount a virtual file system, based on an sftp
+;; connection. Tramp uses its mount utility to access files and
+;; directories there.
+
+;; A remote file under sshfs control has the form
+;; "/sshfs:user@host#port:/path/to/file". User name and port number
+;; are optional.
+
+;;; Code:
+
+(require 'tramp)
+(require 'tramp-fuse)
+
+;;;###tramp-autoload
+(defconst tramp-sshfs-method "sshfs"
+ "Tramp method for sshfs mounts.")
+
+;;;###tramp-autoload
+(defcustom tramp-sshfs-program "sshfs"
+ "The sshfs mount command."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-sshfs-method
+ (tramp-mount-args (("-C") ("-p" "%p")
+ ("-o" "idmap=user,reconnect")))
+ ;; These are for remote processes.
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-q")("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("%h") ("%l")))
+ (tramp-direct-async t)
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+
+ (add-to-list 'tramp-connection-properties
+ `(,(format "/%s:" tramp-sshfs-method) "direct-async-process" t))
+
+ (tramp-set-completion-function
+ tramp-sshfs-method tramp-completion-function-alist-ssh))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-sshfs-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-sshfs-handle-copy-file)
+ (delete-directory . tramp-fuse-handle-delete-directory)
+ (delete-file . tramp-fuse-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-fuse-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-sshfs-handle-exec-path)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-fuse-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-fuse-handle-file-executable-p)
+ (file-exists-p . tramp-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (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-handle-file-newer-than-file-p)
+ (file-notify-add-watch . ignore)
+ (file-notify-rm-watch . ignore)
+ (file-notify-valid-p . ignore)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-fuse-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-sshfs-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-writable-p . tramp-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-sshfs-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-fuse-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-handle-make-process)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . tramp-sshfs-handle-process-file)
+ (rename-file . tramp-sshfs-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-sshfs-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-sshfs-handle-write-region))
+"Alist of handler functions for Tramp SSHFS method.
+Operations not mentioned here will be handled by the default Emacs
primitives.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-sshfs-file-name-p (filename)
+ "Check if it's a FILENAME for sshfs."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-sshfs-method)))
+
+;;;###tramp-autoload
+(defun tramp-sshfs-file-name-handler (operation &rest args)
+ "Invoke the sshfs handler for OPERATION and ARGS.
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
+ (if-let ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-sshfs-file-name-p #'tramp-sshfs-file-name-handler))
+
+
+;; File name primitives.
+
+(defun tramp-sshfs-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ (if (file-directory-p filename)
+ (copy-directory filename newname keep-date t)
+ (copy-file
+ (if (tramp-sshfs-file-name-p filename)
+ (tramp-fuse-local-file-name filename) filename)
+ (if (tramp-sshfs-file-name-p newname)
+ (tramp-fuse-local-file-name newname) newname)
+ ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (when (tramp-sshfs-file-name-p newname)
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname)))))
+
+(defun tramp-sshfs-handle-exec-path ()
+ "Like `exec-path' for Tramp files."
+ (append
+ (with-parsed-tramp-file-name default-directory nil
+ (with-tramp-connection-property (tramp-get-process v) "remote-path"
+ (with-temp-buffer
+ (process-file "getconf" nil t nil "PATH")
+ (split-string
+ (progn
+ ;; Read the expression.
+ (goto-char (point-min))
+ (buffer-substring (point) (point-at-eol)))
+ ":" 'omit))))
+ ;; The equivalent to `exec-directory'.
+ `(,(tramp-file-local-name (expand-file-name default-directory)))))
+
+(defun tramp-sshfs-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ ;;`file-system-info' exists since Emacs 27.1.
+ (tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name
filename)))
+
+(defun tramp-sshfs-handle-insert-file-contents
+ (filename &optional visit beg end replace)
+ "Like `insert-file-contents' for Tramp files."
+ (let ((result
+ (insert-file-contents
+ (tramp-fuse-local-file-name filename) visit beg end replace)))
+ (when visit (setq buffer-file-name filename))
+ (cons (expand-file-name filename) (cdr result))))
+
+(defun tramp-sshfs-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let ((command
+ (format
+ "cd %s && exec %s"
+ localname
+ (mapconcat #'tramp-shell-quote-argument (cons program args) " "))))
+ (unwind-protect
+ (apply
+ #'tramp-call-process
+ v (tramp-get-method-parameter v 'tramp-login-program)
+ infile destination display
+ (tramp-expand-args
+ v 'tramp-login-args
+ ?h (or (tramp-file-name-host v) "")
+ ?u (or (tramp-file-name-user v) "")
+ ?p (or (tramp-file-name-port v) "")
+ ?l command))
+
+ (unless process-file-side-effects
+ (tramp-flush-directory-properties v ""))))))
+
+(defun tramp-sshfs-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ (rename-file
+ (if (tramp-sshfs-file-name-p filename)
+ (tramp-fuse-local-file-name filename) filename)
+ (if (tramp-sshfs-file-name-p newname)
+ (tramp-fuse-local-file-name newname) newname)
+ ok-if-already-exists)
+ (when (tramp-sshfs-file-name-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)))
+ (when (tramp-sshfs-file-name-p newname)
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))
+
+(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (set-file-modes (tramp-fuse-local-file-name filename) mode flag))))
+
+(defun tramp-sshfs-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ (write-region
+ start end (tramp-fuse-local-file-name filename) append 'nomessage
lockname)
+ (tramp-flush-file-properties v localname)
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook)))
+
+
+;; File name conversions.
+
+(defun tramp-sshfs-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
+ ;; We need a process bound to the connection buffer. Therefore, we
+ ;; create a dummy process. Maybe there is a better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Create directory.
+ (unless (file-directory-p (tramp-fuse-mount-point vec))
+ (make-directory (tramp-fuse-mount-point vec) 'parents))
+
+ (unless
+ (or (tramp-fuse-mounted-p vec)
+ (with-temp-buffer
+ (zerop
+ (apply
+ #'tramp-call-process
+ vec tramp-sshfs-program nil t nil
+ (tramp-fuse-mount-spec vec)
+ (tramp-fuse-mount-point vec)
+ (tramp-expand-args
+ vec 'tramp-mount-args
+ ?p (or (tramp-file-name-port vec) "")))))
+ (tramp-error
+ vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))))
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t)))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-sshfs 'force)))
+
+(provide 'tramp-sshfs)
+
+;;; tramp-sshfs.el ends here
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index e181365..66737e6 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -791,22 +791,16 @@ in case of error, t otherwise."
(tramp-sudoedit-maybe-open-connection vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(erase-buffer)
- (let* ((login (tramp-get-method-parameter vec 'tramp-sudo-login))
- (host (or (tramp-file-name-host vec) ""))
- (user (or (tramp-file-name-user vec) ""))
- (spec (format-spec-make ?h host ?u user))
- (args (append
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) x))
- login))
- (tramp-compat-flatten-tree (delq nil args))))
- (delete-exited-processes t)
+ (let* ((delete-exited-processes t)
(process-connection-type tramp-process-connection-type)
(p (apply #'start-process
- (tramp-get-connection-name vec) (current-buffer) args))
+ (tramp-get-connection-name vec) (current-buffer)
+ (append
+ (tramp-expand-args
+ vec 'tramp-sudo-login
+ ?h (or (tramp-file-name-host vec) "")
+ ?u (or (tramp-file-name-user vec) ""))
+ (tramp-compat-flatten-tree args))))
;; We suppress the messages `Waiting for prompts from remote shell'.
(tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
;; We do not want to save the password.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 14d5f8c..da779d3 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -386,6 +386,8 @@ Also see `tramp-default-method-alist'."
:type 'string)
(defcustom tramp-default-method-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default method to use for specific host/user pairs.
This is an alist of items (HOST USER METHOD). The first matching item
specifies the method to use for a file name which does not specify a
@@ -413,6 +415,8 @@ This variable is regarded as obsolete, and will be removed
soon."
:type '(choice (const nil) string))
(defcustom tramp-default-user-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default user to use for specific method/host pairs.
This is an alist of items (METHOD HOST USER). The first matching item
specifies the user to use for a file name which does not specify a
@@ -432,6 +436,8 @@ Useful for su and sudo methods mostly."
:type 'string)
(defcustom tramp-default-host-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default host to use for specific method/user pairs.
This is an alist of items (METHOD USER HOST). The first matching item
specifies the host to use for a file name which does not specify a
@@ -447,6 +453,8 @@ empty string for the method name."
(choice :tag " Host name" string (const nil)))))
(defcustom tramp-default-proxies-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Route to be followed for specific host/user pairs.
This is an alist of items (HOST USER PROXY). The first matching
item specifies the proxy to be passed for a file name located on
@@ -1710,6 +1718,10 @@ version, the function does nothing."
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
+ ;; FIXME: Make it a function instead of an ELisp expression, so you
+ ;; can evaluate it with `funcall' rather than `eval'!
+ ;; Also, in `font-lock-defaults' you can specify a function name for
+ ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
'(list
(concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
'(1 font-lock-warning-face t t)
@@ -1738,8 +1750,11 @@ The outline level is equal to the verbosity of the Tramp
message."
(outline-mode))
(setq-local outline-level 'tramp-debug-outline-level)
(setq-local font-lock-keywords
- `(t (eval ,tramp-debug-font-lock-keywords)
- ,(eval tramp-debug-font-lock-keywords)))
+ ;; FIXME: This `(t FOO . BAR)' representation in
+ ;; `font-lock-keywords' is supposed to be an
+ ;; internal implementation "detail". Don't abuse it here!
+ `(t (eval ,tramp-debug-font-lock-keywords t)
+ ,(eval tramp-debug-font-lock-keywords t)))
;; Do not edit the debug buffer.
(use-local-map special-mode-map))
(current-buffer)))
@@ -3691,15 +3706,15 @@ User is always nil."
(setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
- proxy (eval (nth 2 item)))
+ proxy (eval (nth 2 item) t))
(when (and
;; Host.
(string-match-p
- (or (eval (nth 0 item)) "")
+ (or (eval (nth 0 item) t) "")
(or (tramp-file-name-host-port (car target-alist)) ""))
;; User.
(string-match-p
- (or (eval (nth 1 item)) "")
+ (or (eval (nth 1 item) t) "")
(or (tramp-file-name-user-domain (car target-alist)) "")))
(if (null proxy)
;; No more hops needed.
@@ -3750,6 +3765,22 @@ User is always nil."
;; Result.
target-alist))
+(defun tramp-expand-args (vec parameter &rest spec-list)
+ "Expand login arguments as given by PARAMETER in `tramp-methods'.
+PARAMETER is a symbol like `tramp-login-args', denoting a list of
+list of strings from `tramp-methods', containing %-sequences for
+substitution. SPEC-LIST is a list of char/value pairs used for
+`format-spec-make'."
+ (let ((args (tramp-get-method-parameter vec parameter))
+ (spec (apply 'format-spec-make spec-list)))
+ ;; Expand format spec.
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) x))
+ args))))
+
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory))
@@ -3831,14 +3862,11 @@ It does not support `:stderr'."
(append `("cd" ,localname "&&" "(" "env") env `(,command ")"))))
;; Check for `tramp-sh-file-name-handler', because something
- ;; is different between tramp-adb.el and tramp-sh.el.
+ ;; is different between tramp-sh.el, and tramp-adb.el or
+ ;; tramp-sshfs.el.
(let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
(login-program
(tramp-get-method-parameter v 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter v 'tramp-login-args))
- (async-args
- (tramp-get-method-parameter v 'tramp-async-args))
;; We don't create the temporary file. In fact, it
;; is just a prefix for the ControlPath option of
;; ssh; the real temporary file has another name, and
@@ -3856,29 +3884,23 @@ It does not support `:stderr'."
(when sh-file-name-handler-p
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
- spec p)
+ login-args p)
- ;; Replace `login-args' place holders.
+ ;; Replace `login-args' place holders. Split
+ ;; ControlMaster options.
(setq
- spec (format-spec-make ?t tmpfile)
- options (format-spec (or options "") spec)
- spec (format-spec-make
- ?h (or host "") ?u (or user "") ?p (or port "")
- ?c options ?l "")
- ;; Add arguments for asynchronous processes.
- login-args (append async-args login-args)
- ;; Expand format spec.
login-args
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) x))
- login-args))
- ;; Split ControlMaster options.
- login-args
- (tramp-compat-flatten-tree
- (mapcar (lambda (x) (split-string x " ")) login-args))
+ (append
+ (tramp-compat-flatten-tree
+ (tramp-get-method-parameter v 'tramp-async-args))
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x) (split-string x " "))
+ (tramp-expand-args
+ v 'tramp-login-args
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?c (format-spec (or options "") (format-spec-make ?t tmpfile))
+ ?l ""))))
p (make-process
:name name :buffer buffer
:command (append `(,login-program) login-args command)
@@ -5447,11 +5469,6 @@ BODY is the backend specific code."
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;;
-;; * I was wondering if it would be possible to use tramp even if I'm
-;; actually using sshfs. But when I launch a command I would like
-;; to get it executed on the remote machine where the files really
-;; are. (Andrea Crotti)
-;;
;; * Run emerge on two remote files. Bug is described here:
;; <https://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850)
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 1fa625c..4baa657 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -252,7 +252,7 @@ Please submit bug reports and other feedback to the author,
Neil W. Van Dyke
(cond ((not expr) "")
((stringp expr) expr)
((vectorp expr) (webjump-builtin expr name))
- ((listp expr) (eval expr))
+ ((listp expr) (eval expr t))
((symbolp expr)
(if (fboundp expr)
(funcall expr name)
diff --git a/lisp/obsolete/inversion.el b/lisp/obsolete/inversion.el
index f192d88..192186e 100644
--- a/lisp/obsolete/inversion.el
+++ b/lisp/obsolete/inversion.el
@@ -1,4 +1,4 @@
-;;; inversion.el --- When you need something in version XX.XX
+;;; inversion.el --- When you need something in version XX.XX -*-
lexical-binding: t; -*-
;;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
@@ -223,7 +223,7 @@ not an indication of new features or bug fixes."
)))
(defun inversion-check-version (version incompatible-version
- minimum &rest reserved)
+ minimum &rest _reserved)
"Check that a given version meets the minimum requirement.
VERSION, INCOMPATIBLE-VERSION and MINIMUM are of similar format to
return entries of `inversion-decode-version', or a classic version
@@ -330,7 +330,7 @@ Return nil if everything is ok. Return an error string
otherwise."
(t "Inversion version check failed."))))
(defun inversion-require (package version &optional file directory
- &rest reserved)
+ &rest _reserved)
"Declare that you need PACKAGE with at least VERSION.
PACKAGE might be found in FILE. (See `require'.)
Throws an error if VERSION is incompatible with what is installed.
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index a7fd6cc..7ffee76 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -313,7 +313,7 @@ Possible values:
`otherwindow' Show new buffer in another window (same frame)
`display' Display buffer in another window without switching to it
`otherframe' Show new buffer in another frame
-`maybe-frame' If a buffer is visible in another frame, prompt to ask if you
+`maybe-frame' If a buffer is visible in another frame, prompt to ask if
you want to see the buffer in the same window of the current
frame or in the other frame.
`always-frame' If a buffer is visible in another frame, raise that
@@ -1158,18 +1158,6 @@ Copied from `icomplete-exhibit' with two changes:
(insert (iswitchb-completions
contents))))))
-(defvar most-len)
-(defvar most-is-exact)
-
-(defun iswitchb-output-completion (com)
- (if (= (length com) most-len)
- ;; Most is one exact match,
- ;; note that and leave out
- ;; for later indication:
- (ignore
- (setq most-is-exact t))
- (substring com most-len)))
-
(defun iswitchb-completions (name)
"Return the string that is displayed after the user's text.
Modified from `icomplete-completions'."
@@ -1260,16 +1248,11 @@ Modified from `icomplete-completions'."
(nreverse res))
(list "...")
(nthcdr (- (length comps)
- (/ iswitchb-max-to-show 2)) comps))))
+ (/ iswitchb-max-to-show 2))
+ comps))))
(let* (
- ;;(most (try-completion name candidates predicate))
- (most nil)
- (most-len (length most))
- most-is-exact
(alternatives
- (mapconcat (if most #'iswitchb-output-completion
- #'identity)
- comps iswitchb-delim)))
+ (mapconcat #'identity comps iswitchb-delim)))
(concat
@@ -1283,17 +1266,9 @@ Modified from `icomplete-completions'."
close-bracket-determined))
;; end of partial matches...
- ;; think this bit can be ignored.
- (and (> most-len (length name))
- (concat open-bracket-determined
- (substring most (length name))
- close-bracket-determined))
-
;; list all alternatives
open-bracket-prospects
- (if most-is-exact
- (concat iswitchb-delim alternatives)
- alternatives)
+ alternatives
close-bracket-prospects))))))
(defun iswitchb-minibuffer-setup ()
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 337d83c..fef76ba 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -275,21 +275,11 @@ that it is for swish++, not Namazu."
;; Swish-E.
;; URL: http://swish-e.org/
-;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and
+;; Variables `nnir-swish-e-index-files', `nnir-swish-e-program' and
;; `nnir-swish-e-additional-switches'
-(make-obsolete-variable 'nnir-swish-e-index-file
- 'nnir-swish-e-index-files "Emacs 23.1")
-(defcustom nnir-swish-e-index-file
- (expand-file-name "~/Mail/index.swish-e")
- "Index file for swish-e.
-This could be a server parameter.
-It is never consulted once `nnir-swish-e-index-files', which should be
-used instead, has been customized."
- :type '(file))
-
(defcustom nnir-swish-e-index-files
- (list nnir-swish-e-index-file)
+ (list (expand-file-name "~/Mail/index.swish-e"))
"List of index files for swish-e.
This could be a server parameter."
:type '(repeat (file)))
diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el
index 0ca4863..926248d 100644
--- a/lisp/obsolete/starttls.el
+++ b/lisp/obsolete/starttls.el
@@ -288,7 +288,7 @@ GnuTLS requires a port number."
starttls-program))))
(define-obsolete-function-alias 'starttls-any-program-available
- #'starttls-available-p "2011-08-02")
+ #'starttls-available-p "24.1")
(provide 'starttls)
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index fbdd905..47397e6 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -220,7 +220,7 @@ If error in compilation, attempt to mark the error in
lilypond org file."
FILE-NAME is full path to lilypond (.ly) file."
(message "Compiling LilyPond...")
(let ((arg-1 org-babel-lilypond-ly-command) ;program
- (arg-2 nil) ;infile
+ ;; (arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
(arg-5 (if org-babel-lilypond-gen-png "--png" "")) ;&rest...
@@ -231,10 +231,10 @@ FILE-NAME is full path to lilypond (.ly) file."
(arg-10 (concat "--output=" (file-name-sans-extension file-name)))
(arg-11 file-name))
(if test
- `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
+ `(,arg-1 ,nil ,arg-3 ,arg-4 ,arg-5 ,arg-6 ;; arg-2
,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
(call-process
- arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
+ arg-1 nil arg-3 arg-4 arg-5 arg-6 ;; arg-2
arg-7 arg-8 arg-9 arg-10 arg-11))))
(defun org-babel-lilypond-check-for-compile-error (file-name &optional test)
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 71051bc..2d51447 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -198,11 +198,11 @@ If `org-store-link' was called with a prefix arg the
meaning of
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
- newsgroup xarchive) ;those are always nil for gcc
+ ) ;; newsgroup xarchive ;those are always nil for gcc
(unless gcc (error "Can not create link: No Gcc header found"))
(org-link-store-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
- (let ((link (org-gnus-article-link gcc newsgroup id xarchive))
+ (let ((link (org-gnus-article-link gcc nil id nil)) ;;newsgroup
xarchive
(description (org-link-email-description)))
(org-link-add-props :link link :description description)
link)))))))
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 994e30f..38e2dd6 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -591,7 +591,7 @@ handle this as a special case.
When the function does handle the link, it must return a non-nil value.
If it decides that it is not responsible for this link, it must return
-nil to indicate that that Org can continue with other options like
+nil to indicate that Org can continue with other options like
exact and fuzzy text search.")
@@ -1467,7 +1467,7 @@ non-nil."
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
- (let (link cpltxt desc description search custom-id agenda-link)
+ (let (link cpltxt desc search custom-id agenda-link) ;; description
(cond
;; Store a link using an external link type, if any function is
;; available. If more than one can generate a link from current
@@ -1598,7 +1598,7 @@ non-nil."
'org-create-file-search-functions))
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
"::" search))
- (setq cpltxt (or description link)))
+ (setq cpltxt (or link))) ;; description
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p
'org-mode))
(org-with-limited-levels
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 2844b0e..251ad97 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -2239,7 +2239,7 @@ have priority."
((>= month 7) 3)
((>= month 4) 2)
(t 1)))
- m1 h1 d1 month1 y1 shiftedy shiftedm shiftedq)
+ h1 d1 month1 y1 shiftedy shiftedm shiftedq) ;; m1
(cond
((string-match "\\`[0-9]+\\'" skey)
(setq y (string-to-number skey) month 1 d 1 key 'year))
@@ -2342,7 +2342,7 @@ have priority."
(`interactive (org-read-date nil t nil "Range end? "))
(`untilnow (current-time))
(_ (encode-time 0
- (or m1 m)
+ m ;; (or m1 m)
(or h1 h)
(or d1 d)
(or month1 month)
@@ -2389,7 +2389,7 @@ the currently selected interval size."
(user-error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1))
- block shift ins y mw d date wp m)
+ block shift ins y mw d date wp) ;; m
(cond
((equal s "yesterday") (setq s "today-1"))
((equal s "lastweek") (setq s "thisweek-1"))
@@ -2414,7 +2414,7 @@ the currently selected interval size."
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
- (encode-time 0 0 0 (+ d n) m y))))
+ (encode-time 0 0 0 (+ d n) nil y)))) ;; m
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index caf9de9..103baeb 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -284,6 +284,8 @@ Assume `epg-context' is set."
nil)))
(_ nil)))
+(defvar org--matcher-tags-todo-only)
+
;;;###autoload
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 74043f8..726c1ca 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -535,7 +535,7 @@ The location for a browser's bookmark should look like this:
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
- (let ((result nil)
+ (let (;; (result nil)
(f (org-protocol-sanitize-uri
(plist-get (org-protocol-parse-parameters fname nil '(:url))
:url))))
@@ -586,7 +586,7 @@ The location for a browser's bookmark should look like this:
(if (file-exists-p the-file)
(message "%s: permission denied!" the-file)
(message "%s: no such file or directory." the-file))))))
- result)))
+ nil))) ;; FIXME: Really?
;;; Core functions:
diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el
index 36b8614..c121b8e 100644
--- a/lisp/org/org-tempo.el
+++ b/lisp/org/org-tempo.el
@@ -65,7 +65,7 @@ just like `org-structure-template-alist'. The tempo snippet
\"<KEY\" will be expanded using the KEYWORD value. For example
\"<L\" at the beginning of a line is expanded to \"#+latex:\".
-Do not use \"I\" as a KEY, as it it reserved for expanding
+Do not use \"I\" as a KEY, as it is reserved for expanding
\"#+include\"."
:group 'org-tempo
:type '(repeat (cons (string :tag "Key")
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 41898dc..cebe173 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -20318,7 +20318,7 @@ unless optional argument NO-INHERITANCE is non-nil."
(defun org-point-at-end-of-empty-headline ()
"If point is at the end of an empty headline, return t, else nil.
-If the heading only contains a TODO keyword, it is still still considered
+If the heading only contains a TODO keyword, it is still considered
empty."
(let ((case-fold-search nil))
(and (looking-at "[ \t]*$")
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 2d550d9..a076d15 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -2111,7 +2111,8 @@ SHORT-CAPTION are strings."
(caption (let ((c (org-export-get-caption element-or-parent)))
(and c (org-export-data c info))))
;; FIXME: We don't use short-caption for now
- (short-caption nil))
+ ;; (short-caption nil)
+ )
(when (or label caption)
(let* ((default-category
(cl-case (org-element-type element)
@@ -2159,7 +2160,7 @@ SHORT-CAPTION are strings."
"<text:sequence text:ref-name=\"%s\"
text:name=\"%s\" text:formula=\"ooow:%s+1\"
style:num-format=\"1\">%s</text:sequence>"
label counter counter seqno))
(?c . ,(or caption "")))))
- short-caption))
+ nil)) ;; short-caption
;; Case 2: Handle Label reference.
(reference
(let* ((fmt (cddr (assoc-string label-style org-odt-label-styles
t)))
@@ -2362,14 +2363,14 @@ used as a communication channel."
;; If yes, note down its contents. It will go in to frame
;; description. This quite useful for debugging.
(desc (and replaces (org-element-property :value replaces)))
- width height)
+ ) ;; width height
(cond
((eq embed-as 'character)
- (org-odt--render-image/formula "InlineFormula" href width height
+ (org-odt--render-image/formula "InlineFormula" href nil nil ;; width
height
nil nil title desc))
(t
(let* ((equation (org-odt--render-image/formula
- "CaptionedDisplayFormula" href width height
+ "CaptionedDisplayFormula" href nil nil ;; width height
captions nil title desc))
(label
(let* ((org-odt-category-map-alist
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 050a809..36ecf01 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -2706,9 +2706,9 @@ a list of footnote definitions or in the widened buffer."
(and (or (eq (org-element-type f) 'footnote-definition)
(eq (org-element-property :type f) 'inline))
(org-element-property :label f)))))
- seen)
+ ) ;; seen
(dolist (l (funcall list-labels tree))
- (cond ((member l seen))
+ (cond ;; ((member l seen))
((member l known-definitions) (push l defined))
(t (push l undefined)))))
;; Complete MISSING-DEFINITIONS by finding the definition of every
diff --git a/lisp/outline.el b/lisp/outline.el
index 640c0e0..b4d37b2 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -186,7 +186,7 @@ in the file it applies to.")
(define-key map (kbd "TAB") tab-binding)
(define-key map (kbd "<backtab>") #'outline-cycle-buffer))
map)
- "Keymap used by `outline-mode-map' and `outline-cycle-minor-mode'.")
+ "Keymap used by `outline-mode-map' and `outline-minor-mode-cycle'.")
(defvar outline-mode-map
(let ((map (make-sparse-keymap)))
@@ -199,18 +199,18 @@ in the file it applies to.")
'(
;; Highlight headings according to the level.
(eval . (list (concat "^\\(?:" outline-regexp "\\).+")
- 0 '(if outline-minor-mode-cycle
- (if outline-minor-mode-highlight
- (list 'face (outline-font-lock-face)
- 'keymap outline-mode-cycle-map)
- (list 'face nil
- 'keymap outline-mode-cycle-map))
+ 0 '(if outline-minor-mode
+ (if outline-minor-mode-cycle
+ (if outline-minor-mode-highlight
+ (list 'face (outline-font-lock-face)
+ 'keymap outline-mode-cycle-map)
+ (list 'face nil
+ 'keymap outline-mode-cycle-map)))
(outline-font-lock-face))
- nil
- (if (or outline-minor-mode-cycle
- outline-minor-mode-highlight)
- 'append
- t))))
+ (when (and outline-minor-mode
+ (eq outline-minor-mode-highlight 'override))
+ 'append)
+ t)))
"Additional expressions to highlight in Outline mode.")
(defface outline-1
@@ -324,18 +324,28 @@ After that, changing the prefix key requires manipulating
keymaps."
(define-key outline-minor-mode-map val outline-mode-prefix-map)
(set-default sym val)))
-(defvar outline-minor-mode-cycle nil
+(defcustom outline-minor-mode-cycle nil
"Enable cycling of headings in `outline-minor-mode'.
+When enabled, it puts a keymap with cycling keys on heading lines.
When point is on a heading line, then typing `TAB' cycles between `hide all',
`headings only' and `show all' (`outline-cycle'). Typing `S-TAB' on
a heading line cycles the whole buffer (`outline-cycle-buffer').
-Typing these keys anywhere outside heading lines uses their default bindings.")
+Typing these keys anywhere outside heading lines uses their default bindings."
+ :type 'boolean
+ :version "28.1")
;;;###autoload(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp)
-(defvar outline-minor-mode-highlight nil
+(defcustom outline-minor-mode-highlight nil
"Highlight headings in `outline-minor-mode' using font-lock keywords.
Non-nil value works well only when outline font-lock keywords
-don't conflict with the major mode's font-lock keywords.")
+don't conflict with the major mode's font-lock keywords.
+When t, it puts outline faces only if there are no major mode's faces
+on headings. When `override', it tries to append outline faces
+to major mode's faces."
+ :type '(choice (const :tag "No highlighting" nil)
+ (const :tag "Append to major mode faces" override)
+ (const :tag "Highlight separately from major mode faces" t))
+ :version "28.1")
;;;###autoload(put 'outline-minor-mode-highlight 'safe-local-variable
'booleanp)
(defun outline-minor-mode-highlight-buffer ()
@@ -347,7 +357,9 @@ don't conflict with the major mode's font-lock keywords.")
(let ((overlay (make-overlay (match-beginning 0)
(match-end 0))))
(overlay-put overlay 'outline-overlay t)
- (when outline-minor-mode-highlight
+ (when (or (eq outline-minor-mode-highlight 'override)
+ (and (eq outline-minor-mode-highlight t)
+ (not (get-text-property (point) 'face))))
(overlay-put overlay 'face (outline-font-lock-face)))
(when outline-minor-mode-cycle
(overlay-put overlay 'keymap outline-mode-cycle-map)))
@@ -386,32 +398,6 @@ See the command `outline-mode' for more information on
this mode."
;; When turning off outline mode, get rid of any outline hiding.
(outline-show-all)))
-;;;###autoload
-(define-minor-mode outline-cycle-minor-mode
- "Toggle Outline-Cycle minor mode.
-Set the buffer-local variable `outline-minor-mode-cycle' to t
-and enable `outline-minor-mode'."
- nil nil nil
- (if outline-cycle-minor-mode
- (progn
- (setq-local outline-minor-mode-cycle t)
- (outline-minor-mode +1))
- (outline-minor-mode -1)
- (kill-local-variable 'outline-minor-mode-cycle)))
-
-;;;###autoload
-(define-minor-mode outline-cycle-highlight-minor-mode
- "Toggle Outline-Cycle-Highlight minor mode.
-Set the buffer-local variable `outline-minor-mode-highlight' to t
-and enable `outline-cycle-minor-mode'."
- nil nil nil
- (if outline-cycle-highlight-minor-mode
- (progn
- (setq-local outline-minor-mode-highlight t)
- (outline-cycle-minor-mode +1))
- (outline-cycle-minor-mode -1)
- (kill-local-variable 'outline-minor-mode-highlight)))
-
(defvar-local outline-heading-alist ()
"Alist associating a heading for every possible level.
Each entry is of the form (HEADING . LEVEL).
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index bef99f2..472788d 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -987,13 +987,11 @@ Intended as the value of `indent-line-function'."
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))))
-;; This doesn't work too well in Emacs 21.2. See 22.1 development
-;; code.
(defun cfengine-fill-paragraph (&optional justify)
"Fill `paragraphs' in Cfengine code."
(interactive "P")
(or (if (fboundp 'fill-comment-paragraph)
- (fill-comment-paragraph justify) ; post Emacs 21.3
+ (fill-comment-paragraph justify)
;; else do nothing in a comment
(nth 4 (parse-partial-sexp (save-excursion
(beginning-of-defun)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 6b22228..734797b 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -907,22 +907,12 @@ In regular expressions (including character classes):
(defun cperl-make-indent (column &optional minimum keep)
- "Makes indent of the current line the requested amount.
-Unless KEEP, removes the old indentation. Works around a bug in ancient
-versions of Emacs."
- (let ((prop (get-text-property (point) 'syntax-type)))
- (or keep
- (delete-horizontal-space))
- (indent-to column minimum)
- ;; In old versions (e.g., 19.33) `indent-to' would not inherit properties
- (and prop
- (> (current-column) 0)
- (save-excursion
- (beginning-of-line)
- (or (get-text-property (point) 'syntax-type)
- (and (looking-at "\\=[ \t]")
- (put-text-property (point) (match-end 0)
- 'syntax-type prop)))))))
+ "Indent from point with tabs and spaces until COLUMN is reached.
+MINIMUM is like in `indent-to', which see.
+Unless KEEP, removes the old indentation."
+ (or keep
+ (delete-horizontal-space))
+ (indent-to column minimum))
;; Probably it is too late to set these guys already, but it can help later:
@@ -6711,9 +6701,9 @@ One may build such TAGS files from CPerl mode menu."
(or (nthcdr 2 elt)
;; Only in one file
(setcdr elt (cdr (nth 1 elt))))))
- to l1 l2 l3)
+ to) ;; l1 l2 l3
;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
- (setq cperl-hierarchy (list l1 l2 l3))
+ (setq cperl-hierarchy (list () () ())) ;; (list l1 l2 l3)
(or tags-table-list
(call-interactively 'visit-tags-table))
(mapc
@@ -6759,7 +6749,7 @@ One may build such TAGS files from CPerl mode menu."
"\\)\\(::\\)?"))
(packages (cdr (nth 1 to)))
(methods (cdr (nth 2 to)))
- l1 head cons1 cons2 ord writeto recurse
+ head cons1 cons2 ord writeto recurse ;; l1
root-packages root-functions
(move-deeper
(lambda (elt)
@@ -6779,7 +6769,7 @@ One may build such TAGS files from CPerl mode menu."
(setq root-functions (cons elt root-functions)))
(t
(setq root-packages (cons elt root-packages)))))))
- (setcdr to l1) ; Init to dynamic space
+ (setcdr to nil) ;; l1 ; Init to dynamic space
(setq writeto to)
(setq ord 1)
(mapc move-deeper packages)
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 40bdaad..cafdb3b 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -3184,8 +3184,8 @@ MEMBER-NAME is the name of the member found."
(let* ((start (point))
(name (progn (skip-chars-forward "a-zA-Z0-9_")
(buffer-substring start (point))))
- class)
- (list class name))))
+ ) ;; class
+ (list nil name)))) ;; class
(defun ebrowse-tags-choose-class (_tree header name initial-class-name)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index abe563b..18da439 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -106,7 +106,7 @@
;;
;; - Write a new function that will determine the current project
;; based on the directory and add it to `project-find-functions'
-;; (which see) using `add-hook'. It is a good idea to depend on the
+;; (which see) using `add-hook'. It is a good idea to depend on the
;; directory only, and not on the current major mode, for example.
;; Because the usual expectation is that all files in the directory
;; belong to the same project (even if some/most of them are ignored).
@@ -775,7 +775,7 @@ pattern to search for."
xrefs))
(defun project--read-regexp ()
- (let ((sym (thing-at-point 'symbol)))
+ (let ((sym (thing-at-point 'symbol t)))
(read-regexp "Find regexp" (and sym (regexp-quote sym)))))
;;;###autoload
@@ -924,7 +924,7 @@ if one already exists."
"-eshell*"))
(eshell-buffer (get-buffer eshell-buffer-name)))
(if (and eshell-buffer (not current-prefix-arg))
- (pop-to-buffer eshell-buffer)
+ (pop-to-buffer-same-window eshell-buffer)
(eshell t))))
;;;###autoload
@@ -1255,7 +1255,6 @@ It's also possible to enter an arbitrary directory not in
the list."
;;; Project switching
-;;;###autoload
(defcustom project-switch-commands
'((project-find-file "Find file")
(project-find-regexp "Find regexp")
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 18fdd96..c066d9d 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -97,10 +97,6 @@ This is typically the filename.")
"Return the line number corresponding to the location."
nil)
-(cl-defgeneric xref-location-column (_location)
- "Return the exact column corresponding to the location."
- nil)
-
(cl-defgeneric xref-match-length (_item)
"Return the length of the match."
nil)
@@ -130,7 +126,7 @@ in its full absolute form."
(defclass xref-file-location (xref-location)
((file :type string :initarg :file)
(line :type fixnum :initarg :line :reader xref-location-line)
- (column :type fixnum :initarg :column :reader xref-location-column))
+ (column :type fixnum :initarg :column :reader xref-file-location-column))
:documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")
@@ -415,6 +411,12 @@ elements is negated: these commands will NOT prompt."
"Functions called after returning to a pre-jump location."
:type 'hook)
+(defcustom xref-after-update-hook nil
+ "Functions called after the xref buffer is updated."
+ :type 'hook
+ :version "28.1"
+ :package-version '(xref . "1.0.4"))
+
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
"Ring of markers to implement the marker stack.")
@@ -713,10 +715,7 @@ references displayed in the current *xref* buffer."
(push pair all-pairs)
;; Perform sanity check first.
(xref--goto-location loc)
- (if (xref--outdated-p item
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))
+ (if (xref--outdated-p item)
(message "Search result out of date, skipping")
(cond
((null file-buf)
@@ -733,18 +732,38 @@ references displayed in the current *xref* buffer."
(move-marker (car pair) nil)
(move-marker (cdr pair) nil)))))))
-(defun xref--outdated-p (item line-text)
- ;; FIXME: The check should probably be a generic function instead of
- ;; the assumption that all matches contain the full line as summary.
- (let ((summary (xref-item-summary item))
- (strip (lambda (s) (if (string-match "\r\\'" s)
- (substring-no-properties s 0 -1)
- s))))
+(defun xref--outdated-p (item)
+ "Check that the match location at current position is up-to-date.
+ITEMS is an xref item which "
+ ;; FIXME: The check should most likely be a generic function instead
+ ;; of the assumption that all matches' summaries relate to the
+ ;; buffer text in a particular way.
+ (let* ((summary (xref-item-summary item))
+ ;; Sometimes buffer contents include ^M, and sometimes Grep
+ ;; output includes it, and they don't always match.
+ (strip (lambda (s) (if (string-match "\r\\'" s)
+ (substring-no-properties s 0 -1)
+ s)))
+ (stripped-summary (funcall strip summary))
+ (lendpos (line-end-position))
+ (check (lambda ()
+ (let ((comparison-end
+ (+ (point) (length stripped-summary))))
+ (and (>= lendpos comparison-end)
+ (equal stripped-summary
+ (buffer-substring-no-properties
+ (point) comparison-end)))))))
(not
- ;; Sometimes buffer contents include ^M, and sometimes Grep
- ;; output includes it, and they don't always match.
- (equal (funcall strip line-text)
- (funcall strip summary)))))
+ (or
+ ;; Either summary contains match text and after
+ ;; (2nd+ match on the line)...
+ (funcall check)
+ ;; ...or it starts at bol, includes the match and after.
+ (and (< (point) (+ (line-beginning-position)
+ (length stripped-summary)))
+ (save-excursion
+ (forward-line 0)
+ (funcall check)))))))
;; FIXME: Write a nicer UI.
(defun xref--query-replace-1 (from to iter)
@@ -886,30 +905,24 @@ GROUP is a string for decoration purposes and XREF is an
(length (and line (format "%d" line)))))
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
- with prev-line-key = nil
+ with prev-group = nil
+ with prev-line = nil
do
(xref--insert-propertized '(face xref-file-header xref-group t)
group "\n")
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
- (new-summary summary)
- (line-key (list (xref-location-group location)
line))
(prefix
- (if line
- (propertize (format line-format line)
- 'face 'xref-line-number)
- " ")))
+ (cond
+ ((not line) " ")
+ ((equal line prev-line) "")
+ (t (propertize (format line-format line)
+ 'face 'xref-line-number)))))
;; Render multiple matches on the same line, together.
- (when (and line (equal prev-line-key line-key))
- (when-let ((column (xref-location-column location)))
- (delete-region
- (save-excursion
- (forward-line -1)
- (move-to-column (+ (length prefix) column))
- (point))
- (point))
- (setq new-summary (substring summary column)
prefix "")))
+ (when (and (equal prev-group group)
+ (not (equal prev-line line)))
+ (insert "\n"))
(xref--insert-propertized
(list 'xref-item xref
'mouse-face 'highlight
@@ -917,9 +930,11 @@ GROUP is a string for decoration purposes and XREF is an
'help-echo
(concat "mouse-2: display in another window, "
"RET or mouse-1: follow reference"))
- prefix new-summary)
- (setq prev-line-key line-key)))
- (insert "\n"))))
+ prefix summary)
+ (setq prev-line line
+ prev-group group))))
+ (insert "\n"))
+ (run-hooks 'xref-after-update-hook))
(defun xref--analyze (xrefs)
"Find common filenames in XREFS.
@@ -1678,20 +1693,30 @@ Such as the current syntax table and the applied syntax
properties."
syntax-needed)))))
(defun xref--collect-matches-1 (regexp file line line-beg line-end
syntax-needed)
- (let (matches)
+ (let (match-pairs matches)
(when syntax-needed
(syntax-propertize line-end))
- ;; FIXME: This results in several lines with the same
- ;; summary. Solve with composite pattern?
(while (and
;; REGEXP might match an empty string. Or line.
- (or (null matches)
+ (or (null match-pairs)
(> (point) line-beg))
(re-search-forward regexp line-end t))
- (let* ((beg-column (- (match-beginning 0) line-beg))
- (end-column (- (match-end 0) line-beg))
+ (push (cons (match-beginning 0)
+ (match-end 0))
+ match-pairs))
+ (setq match-pairs (nreverse match-pairs))
+ (while match-pairs
+ (let* ((beg-end (pop match-pairs))
+ (beg-column (- (car beg-end) line-beg))
+ (end-column (- (cdr beg-end) line-beg))
(loc (xref-make-file-location file line beg-column))
- (summary (buffer-substring line-beg line-end)))
+ (summary (buffer-substring (if matches (car beg-end) line-beg)
+ (if match-pairs
+ (caar match-pairs)
+ line-end))))
+ (when matches
+ (cl-decf beg-column (- (car beg-end) line-beg))
+ (cl-decf end-column (- (car beg-end) line-beg)))
(add-face-text-property beg-column end-column 'xref-match
t summary)
(push (xref-make-match summary loc (- end-column beg-column))
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 38283a5..c9d3939 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; This library provides a minor mode to display a ruler in the header
-;; line. It works from Emacs 21 onwards.
+;; line.
;;
;; You can use the mouse to change the `fill-column' `comment-column',
;; `goal-column', `window-margins' and `tab-stop-list' settings:
diff --git a/lisp/ses.el b/lisp/ses.el
index d6090f3..a11c754 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -332,9 +332,9 @@ column or default printer and then modify its output.")
next-line-add-newlines transient-mark-mode)
"Buffer-local variables used by SES."))
-(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t))
-(ses--metaprogramming
- `(progn ,@(mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars)))
+(defmacro ses--\,@ (exp) (declare (debug t)) (macroexp-progn (eval exp t)))
+(ses--\,@
+ (mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars))
(defun ses-set-localvars ()
"Set buffer-local and initialize some SES variables."
@@ -840,31 +840,31 @@ and ARGS and reset `ses-start-time' to the current time."
"Install VAL as the contents for field FIELD (named by a quoted symbol) of
cell (ROW,COL). This is undoable. The cell's data will be updated through
`post-command-hook'."
- `(let ((row ,row)
- (col ,col)
- (val ,val))
- (let* ((cell (ses-get-cell row col))
+ (macroexp-let2 nil row row
+ (macroexp-let2 nil col col
+ (macroexp-let2 nil val val
+ `(let* ((cell (ses-get-cell ,row ,col))
(change
,(let ((field (progn (cl-assert (eq (car field) 'quote))
(cadr field))))
(if (eq field 'value)
- '(ses-set-with-undo (ses-cell-symbol cell) val)
+ `(ses-set-with-undo (ses-cell-symbol cell) ,val)
;; (let* ((slots (get 'ses-cell 'cl-struct-slots))
;; (slot (or (assq field slots)
;; (error "Unknown field %S" field)))
;; (idx (- (length slots)
;; (length (memq slot slots)))))
- ;; `(ses-aset-with-undo cell ,idx val))
+ ;; `(ses-aset-with-undo cell ,idx ,val))
(let ((getter (intern-soft (format "ses-cell--%s" field))))
`(ses-setter-with-undo
(eval-when-compile
(cons #',getter
(lambda (newval cell)
(setf (,getter cell) newval))))
- val cell))))))
+ ,val cell))))))
(if change
- (add-to-list 'ses--deferred-write (cons row col))))
- nil)) ; Make coverage-tester happy.
+ (add-to-list 'ses--deferred-write (cons ,row ,col)))
+ nil))))) ; Make coverage-tester happy.
(defun ses-cell-set-formula (row col formula)
"Store a new formula for (ROW . COL) and enqueue the cell for
diff --git a/lisp/simple.el b/lisp/simple.el
index f805009..98fccf4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2824,8 +2824,35 @@ the minibuffer contents."
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
-A redo record for undo-in-region maps to t.
-A redo record for ordinary undo maps to the following (earlier) undo.")
+A redo record for an undo in region maps to 'undo-in-region.
+A redo record for ordinary undo maps to the following (earlier) undo.
+A redo record that undoes to the beginning of the undo list maps to t.
+In the rare case where there are (erroneously) consecutive nil's in
+`buffer-undo-list', `undo' maps the previous valid undo record to
+'empty, if the previous record is a redo record, `undo' doesn't change
+its mapping.
+
+To be clear, a redo record is just an undo record, the only difference
+is that it is created by an undo command (instead of an ordinary buffer
+edit). Since a record used to undo ordinary change is called undo
+record, a record used to undo an undo is called redo record.
+
+`undo' uses this table to make sure the previous command is `undo'.
+`undo-redo' uses this table to set the correct `pending-undo-list'.
+
+When you undo, `pending-undo-list' shrinks and `buffer-undo-list'
+grows, and Emacs maps the tip of `buffer-undo-list' to the tip of
+`pending-undo-list' in this table.
+
+For example, consider this undo list where each node represents an
+undo record: if we undo from 4, `pending-undo-list' will be at 3,
+`buffer-undo-list' at 5, and 5 will map to 3.
+
+ |
+ 3 5
+ | /
+ |/
+ 4")
(defvar undo-in-region nil
"Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
@@ -2872,7 +2899,9 @@ as an argument limits undo to changes within the current
region."
;; the next command should not be a "consecutive undo".
;; So set `this-command' to something other than `undo'.
(setq this-command 'undo-start)
-
+ ;; Here we decide whether to break the undo chain. If the
+ ;; previous command is `undo', we don't call `undo-start', i.e.,
+ ;; don't break the undo chain.
(unless (and (eq last-command 'undo)
(or (eq pending-undo-list t)
;; If something (a timer or filter?) changed the buffer
@@ -2901,7 +2930,7 @@ as an argument limits undo to changes within the current
region."
;; undo-redo-undo-redo-... so skip to the very last equiv.
(while (let ((next (gethash equiv undo-equiv-table)))
(if next (setq equiv next))))
- (setq pending-undo-list equiv)))
+ (setq pending-undo-list (if (consp equiv) equiv t))))
(undo-more
(if (numberp arg)
(prefix-numeric-value arg)
@@ -2917,11 +2946,17 @@ as an argument limits undo to changes within the
current region."
(while (eq (car list) nil)
(setq list (cdr list)))
(puthash list
- ;; Prevent identity mapping. This can happen if
- ;; consecutive nils are erroneously in undo list.
- (if (or undo-in-region (eq list pending-undo-list))
- t
- pending-undo-list)
+ (cond
+ (undo-in-region 'undo-in-region)
+ ;; Prevent identity mapping. This can happen if
+ ;; consecutive nils are erroneously in undo list. It
+ ;; has to map to _something_ so that the next `undo'
+ ;; command recognizes that the previous command is
+ ;; `undo' and doesn't break the undo chain.
+ ((eq list pending-undo-list)
+ (or (gethash list undo-equiv-table)
+ 'empty))
+ (t pending-undo-list))
undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
@@ -3234,7 +3269,7 @@ list can be applied to the current buffer."
undo-elt)
(while ulist
(when undo-no-redo
- (while (gethash ulist undo-equiv-table)
+ (while (consp (gethash ulist undo-equiv-table))
(setq ulist (gethash ulist undo-equiv-table))))
(setq undo-elt (car ulist))
(cond
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 8a50fbe..c363fb2 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -290,7 +290,8 @@ i.e. we are handling the iterator of a subskeleton, returns
empty string if
user didn't modify input.
While reading, the value of `minibuffer-help-form' is variable `help' if that
is non-nil or a default string."
- (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help))
+ (with-suppressed-warnings ((lexical help)) (defvar help)) ;FIXME: Prefix!
+ (let ((minibuffer-help-form (or (bound-and-true-p help)
(if recursive "\
As long as you provide input you will insert another subskeleton.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 4a78562..6c4c8eb 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -289,22 +289,6 @@ A nil value means don't show the file in the list."
:group 'speedbar
:type 'boolean)
-;;; EVENTUALLY REMOVE THESE
-
-;; When I moved to a repeating timer, I had the horrible misfortune
-;; of losing the ability for adaptive speed choice. This update
-;; speed currently causes long delays when it should have been turned off.
-(defvar speedbar-update-speed dframe-update-speed)
-(make-obsolete-variable 'speedbar-update-speed
- 'dframe-update-speed
- "speedbar 1.0pre3 (Emacs 23.1)")
-
-(defvar speedbar-navigating-speed dframe-update-speed)
-(make-obsolete-variable 'speedbar-navigating-speed
- 'dframe-update-speed
- "speedbar 1.0pre3 (Emacs 23.1)")
-;;; END REMOVE THESE
-
(defcustom speedbar-frame-parameters '((minibuffer . nil)
(width . 20)
(border-width . 0)
@@ -3260,7 +3244,7 @@ subdirectory chosen will be at INDENT level."
;; in case.
(let ((speedbar-smart-directory-expand-flag nil))
(speedbar-update-contents))
- (speedbar-set-timer speedbar-navigating-speed)
+ (speedbar-set-timer dframe-update-speed)
(setq speedbar-last-selected-file nil)
(speedbar-stealthy-updates))
@@ -3323,7 +3307,7 @@ INDENT is the current indentation level and is unused."
;; update contents will change directory without
;; having to touch the attached frame.
(speedbar-update-contents)
- (speedbar-set-timer speedbar-navigating-speed))
+ (speedbar-set-timer dframe-update-speed))
(defun speedbar-tag-file (text token indent)
"The cursor is on a selected line. Expand the tags in the specified file.
diff --git a/lisp/subr.el b/lisp/subr.el
index f1c2562..14335f4 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -892,7 +892,9 @@ Example:
(defun remove (elt seq)
"Return a copy of SEQ with all occurrences of ELT removed.
-SEQ must be a list, vector, or string. The comparison is done with `equal'."
+SEQ must be a list, vector, or string. The comparison is done with `equal'.
+Contrary to `delete', this does not use side-effects, and the argument
+SEQ is not modified."
(declare (side-effect-free t))
(if (nlistp seq)
;; If SEQ isn't a list, there's no need to copy SEQ because
@@ -4789,7 +4791,7 @@ Unless optional argument INPLACE is non-nil, return a new
string."
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
(declare (pure t) (side-effect-free t))
(when (equal fromstring "")
- (signal 'wrong-length-argument fromstring))
+ (signal 'wrong-length-argument '(0)))
(let ((start 0)
(result nil)
pos)
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 917b5e4..29465aa 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -648,6 +648,7 @@ on the tab bar instead."
(defun tab-bar--tab (&optional frame)
(let* ((tab (assq 'current-tab (frame-parameter frame 'tabs)))
(tab-explicit-name (alist-get 'explicit-name tab))
+ (tab-group (alist-get 'group tab))
(bl (seq-filter #'buffer-live-p (frame-parameter frame
'buffer-list)))
(bbl (seq-filter #'buffer-live-p (frame-parameter frame
'buried-buffer-list))))
`(tab
@@ -655,6 +656,7 @@ on the tab bar instead."
(alist-get 'name tab)
(funcall tab-bar-tab-name-function)))
(explicit-name . ,tab-explicit-name)
+ ,@(if tab-group `((group . ,tab-group)))
(time . ,(float-time))
(ws . ,(window-state-get
(frame-root-window (or frame (selected-frame))) 'writable))
@@ -670,12 +672,18 @@ on the tab bar instead."
;; necessary when switching tabs, otherwise the destination tab
;; inherits the current tab's `explicit-name' parameter.
(let* ((tab (or tab (assq 'current-tab (frame-parameter frame 'tabs))))
- (tab-explicit-name (alist-get 'explicit-name tab)))
+ (tab-explicit-name (alist-get 'explicit-name tab))
+ (tab-group (alist-get 'group tab)))
`(current-tab
(name . ,(if tab-explicit-name
(alist-get 'name tab)
(funcall tab-bar-tab-name-function)))
- (explicit-name . ,tab-explicit-name))))
+ (explicit-name . ,tab-explicit-name)
+ ,@(if tab-group `((group . ,tab-group))))))
+
+(defun tab-bar--current-tab-find (&optional tabs frame)
+ (seq-find (lambda (tab) (eq (car tab) 'current-tab))
+ (or tabs (funcall tab-bar-tabs-function frame))))
(defun tab-bar--current-tab-index (&optional tabs frame)
(seq-position (or tabs (funcall tab-bar-tabs-function frame))
@@ -766,7 +774,7 @@ ARG counts from 1."
tab-bar-history-forward)))
(ws
- (window-state-put ws (frame-root-window (selected-frame)) 'safe)))
+ (window-state-put ws nil 'safe)))
(setq tab-bar-history-omit t)
@@ -1144,22 +1152,24 @@ for the last tab on a frame is determined by
"Close all tabs on the selected frame, except the selected one."
(interactive)
(let* ((tabs (funcall tab-bar-tabs-function))
- (current-index (tab-bar--current-tab-index tabs)))
- (when current-index
- (dotimes (index (length tabs))
- (unless (or (eq index current-index)
+ (current-tab (tab-bar--current-tab-find tabs))
+ (index 0))
+ (when current-tab
+ (dolist (tab tabs)
+ (unless (or (eq tab current-tab)
(run-hook-with-args-until-success
- 'tab-bar-tab-prevent-close-functions
- (nth index tabs)
+ 'tab-bar-tab-prevent-close-functions tab
;; `last-tab-p' logically can't ever be true
;; if we make it this far
nil))
(push `((frame . ,(selected-frame))
(index . ,index)
- (tab . ,(nth index tabs)))
+ (tab . ,tab))
tab-bar-closed-tabs)
- (run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index
tabs) nil)))
- (set-frame-parameter nil 'tabs (list (nth current-index tabs)))
+ (run-hook-with-args 'tab-bar-tab-pre-close-functions tab nil)
+ (setq tabs (delq tab tabs)))
+ (setq index (1+ index)))
+ (set-frame-parameter nil 'tabs tabs)
;; Recalculate tab-bar-lines and update frames
(tab-bar--update-tab-bar-lines)
@@ -1240,6 +1250,64 @@ function `tab-bar-tab-name-function'."
(tab-bar-rename-tab new-name (1+ (tab-bar--tab-index-by-name tab-name))))
+;;; Tab groups
+
+(defun tab-bar-change-tab-group (group-name &optional arg)
+ "Add the tab specified by its absolute position ARG to GROUP-NAME.
+If no ARG is specified, then set the GROUP-NAME for the current tab.
+ARG counts from 1.
+If GROUP-NAME is the empty string, then remove the tab from any group."
+ (interactive
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (tab-index (or current-prefix-arg (1+ (tab-bar--current-tab-index
tabs))))
+ (group-name (alist-get 'group (nth (1- tab-index) tabs))))
+ (list (completing-read
+ "Group name for tab (leave blank to remove group): "
+ (delete-dups (delq nil (cons group-name
+ (mapcar (lambda (tab)
+ (alist-get 'group tab))
+ (funcall
tab-bar-tabs-function))))))
+ current-prefix-arg)))
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (tab-index (if arg
+ (1- (max 0 (min arg (length tabs))))
+ (tab-bar--current-tab-index tabs)))
+ (tab (nth tab-index tabs))
+ (group (assq 'group tab))
+ (group-new-name (and (> (length group-name) 0) group-name)))
+ (if group
+ (setcdr group group-new-name)
+ (nconc tab `((group . ,group-new-name))))
+
+ (force-mode-line-update)
+ (unless tab-bar-mode
+ (message "Set tab group to '%s'" group-new-name))))
+
+(defun tab-bar-close-group-tabs (group-name)
+ "Close all tabs that belong to GROUP-NAME on the selected frame."
+ (interactive
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (group-name (alist-get 'group (tab-bar--current-tab-find tabs))))
+ (list (completing-read
+ "Close all tabs with group name: "
+ (delete-dups (delq nil (cons group-name
+ (mapcar (lambda (tab)
+ (alist-get 'group tab))
+ (funcall
tab-bar-tabs-function)))))))))
+ (let* ((close-group (and (> (length group-name) 0) group-name))
+ (tab-bar-tab-prevent-close-functions
+ (cons (lambda (tab _last-tab-p)
+ (not (equal (alist-get 'group tab) close-group)))
+ tab-bar-tab-prevent-close-functions)))
+ (tab-bar-close-other-tabs)
+
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (current-tab (tab-bar--current-tab-find tabs)))
+ (when (and current-tab (equal (alist-get 'group current-tab)
+ close-group))
+ (tab-bar-close-tab)))))
+
+
;;; Tab history mode
(defvar tab-bar-history-limit 10
@@ -1260,7 +1328,7 @@ function `tab-bar-tab-name-function'."
(defvar tab-bar-history-old-minibuffer-depth 0
"Minibuffer depth before the current command.")
-(defun tab-bar-history--pre-change ()
+(defun tab-bar--history-pre-change ()
(setq tab-bar-history-old-minibuffer-depth (minibuffer-depth))
;; Store wc before possibly entering the minibuffer
(when (zerop tab-bar-history-old-minibuffer-depth)
@@ -1343,9 +1411,9 @@ and can restore them."
:ascent center))
tab-bar-forward-button))
- (add-hook 'pre-command-hook 'tab-bar-history--pre-change)
+ (add-hook 'pre-command-hook 'tab-bar--history-pre-change)
(add-hook 'window-configuration-change-hook 'tab-bar--history-change))
- (remove-hook 'pre-command-hook 'tab-bar-history--pre-change)
+ (remove-hook 'pre-command-hook 'tab-bar--history-pre-change)
(remove-hook 'window-configuration-change-hook 'tab-bar--history-change)))
@@ -1630,6 +1698,8 @@ a function, then it is called with two arguments: BUFFER
and ALIST, and
should return the tab name. When a `tab-name' entry is omitted, create
a new tab without an explicit name.
+The ALIST entry `tab-group' (string or function) defines the tab group.
+
If ALIST contains a `reusable-frames' entry, its value determines
which frames to search for a reusable tab:
nil -- the selected frame (actually the last non-minibuffer frame)
@@ -1682,6 +1752,8 @@ then it is called with two arguments: BUFFER and ALIST,
and should return
the tab name. When a `tab-name' entry is omitted, create a new tab without
an explicit name.
+The ALIST entry `tab-group' (string or function) defines the tab group.
+
This is an action function for buffer display, see Info
node `(elisp) Buffer Display Action Functions'. It should be
called only by `display-buffer' or a function directly or
@@ -1693,6 +1765,11 @@ indirectly called by the latter."
(setq tab-name (funcall tab-name buffer alist)))
(when tab-name
(tab-bar-rename-tab tab-name)))
+ (let ((tab-group (alist-get 'tab-group alist)))
+ (when (functionp tab-group)
+ (setq tab-group (funcall tab-group buffer alist)))
+ (when tab-group
+ (tab-bar-change-tab-group tab-group)))
(window--display-buffer buffer (selected-window) 'tab alist)))
(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord)
@@ -1760,6 +1837,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(defalias 'tab-duplicate 'tab-bar-duplicate-tab)
(defalias 'tab-close 'tab-bar-close-tab)
(defalias 'tab-close-other 'tab-bar-close-other-tabs)
+(defalias 'tab-close-group 'tab-bar-close-group-tabs)
(defalias 'tab-undo 'tab-bar-undo-close-tab)
(defalias 'tab-select 'tab-bar-select-tab)
(defalias 'tab-switch 'tab-bar-switch-to-tab)
@@ -1770,6 +1848,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(defalias 'tab-move 'tab-bar-move-tab)
(defalias 'tab-move-to 'tab-bar-move-tab-to)
(defalias 'tab-rename 'tab-bar-rename-tab)
+(defalias 'tab-group 'tab-bar-change-tab-group)
(defalias 'tab-list 'tab-switcher)
(define-key tab-prefix-map "n" 'tab-duplicate)
@@ -1777,10 +1856,12 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(define-key tab-prefix-map "2" 'tab-new)
(define-key tab-prefix-map "1" 'tab-close-other)
(define-key tab-prefix-map "0" 'tab-close)
+(define-key tab-prefix-map "u" 'tab-undo)
(define-key tab-prefix-map "o" 'tab-next)
(define-key tab-prefix-map "O" 'tab-previous)
(define-key tab-prefix-map "m" 'tab-move)
(define-key tab-prefix-map "M" 'tab-move-to)
+(define-key tab-prefix-map "G" 'tab-group)
(define-key tab-prefix-map "r" 'tab-rename)
(define-key tab-prefix-map "\r" 'tab-switch)
(define-key tab-prefix-map "b" 'switch-to-buffer-other-tab)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 59f7c87..fa9b475 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -685,12 +685,12 @@ For instance, if mode is #o700, then it produces
`rwx------'."
(define-derived-mode tar-mode special-mode "Tar"
"Major mode for viewing a tar file as a dired-like listing of its contents.
You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the tar file and into its own buffer;
+Letters no longer insert themselves.\\<tar-mode-map>
+Type \\[tar-extract] to pull a file out of the tar file and into its own
buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
-Type `c' to copy an entry from the tar file into another file on disk.
+Type \\[tar-copy] to copy an entry from the tar file into another file on disk.
-If you edit a sub-file of this archive (as with the `e' command) and
+If you edit a sub-file of this archive (as with the \\[tar-extract] command)
and
save it with \\[save-buffer], the contents of that buffer will be
saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 9a886d2..3d08122 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -3466,7 +3466,7 @@ The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
(line-char (if artist-line-char-set artist-line-char ?-))
(i 0)
(point-list nil)
- (fill-info nil)
+ ;; (fill-info nil)
(shape-info (make-vector 2 0)))
(while (< i width)
(let* ((line-x (+ left-edge i))
@@ -3479,7 +3479,7 @@ The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
(setq point-list (append point-list (list new-coord)))
(setq i (1+ i))))
(aset shape-info 0 point-list)
- (aset shape-info 1 fill-info)
+ (aset shape-info 1 nil) ;; fill-info
(artist-make-2point-object (artist-make-endpoint x1 y1)
(artist-make-endpoint x-radius y-radius)
shape-info)))
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 83dba71..a48b345 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -2293,8 +2293,8 @@ If OPOINT is non-nil, restore point there after adjusting
it for replacement."
corrects)
'()))
(affix (car (cdr (cdr (cdr poss)))))
- show-affix-info
- (base-menu (let ((save (if (and (consp affix) show-affix-info)
+ ;; show-affix-info
+ (base-menu (let ((save (if nil ;; (and (consp affix) show-affix-info)
(list
(list (concat "Save affix: " (car affix))
'save)
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 1b29eaf..5b1e8bd 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1318,7 +1318,7 @@ macro before insertion. For example, it will change
\\cite[][Chapter 1]{Jones} -> \\cite[Chapter 1]{Jones}
\\cite[see][]{Jones} -> \\cite[see][]{Jones}
\\cite[see][Chapter 1]{Jones} -> \\cite{Jones}
-Is is possible that other packages have other conventions about which
+It is possible that other packages have other conventions about which
optional argument is interpreted how - that is why this cleaning up
can be turned off."
:group 'reftex-citation-support
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index c51285d..ce15637 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -616,7 +616,7 @@ After interpretation of ARGS the results are concatenated
as for
(:constructor
rst-Ado-new-transition
(&aux
- (char nil)
+ ;; (char nil)
(-style 'transition)))
;; Construct a simple section header.
(:constructor
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 06785e4..60122b2 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1492,7 +1492,7 @@ Move the point under the table as shown below.
+--------------+------+--------------------------------+
-!-
-Type M-x table-insert-row instead of \\[table-insert-row-column].
\\[table-insert-row-column] does not work
+Type \\[table-insert-row] instead of \\[table-insert-row-column].
\\[table-insert-row-column] does not work
when the point is outside of the table. This insertion at
outside of the table effectively appends a row at the end.
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 8e00aa5..af3b86b 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -248,7 +248,12 @@ in echo area."
(setf (alist-get 'border-color params) fg))
(when (stringp bg)
(setf (alist-get 'background-color params) bg))
- (x-show-tip (propertize text 'face 'tooltip)
+ ;; Use non-nil APPEND argument below to avoid overriding any
+ ;; faces used in our TEXT. Among other things, this allows
+ ;; tooltips to use the `help-key-binding' face used in
+ ;; `substitute-command-keys' substitutions.
+ (add-face-text-property 0 (length text) 'tooltip t text)
+ (x-show-tip text
(selected-frame)
params
tooltip-hide-delay
diff --git a/lisp/userlock.el b/lisp/userlock.el
index a340ff8..57311ac 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -1,4 +1,4 @@
-;;; userlock.el --- handle file access contention between multiple users
+;;; userlock.el --- handle file access contention between multiple users -*-
lexical-binding: t -*-
;; Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
@@ -39,6 +39,10 @@
(define-error 'file-locked "File is locked" 'file-error)
+(defun userlock--fontify-key (key)
+ "Add the `help-key-binding' face to string KEY."
+ (propertize key 'face 'help-key-binding))
+
;;;###autoload
(defun ask-user-about-lock (file opponent)
"Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
@@ -64,8 +68,12 @@ in any way you like."
(match-string 0 opponent)))
opponent))
(while (null answer)
- (message "%s locked by %s: (s, q, p, ?)? "
- short-file short-opponent)
+ (message "%s locked by %s: (%s, %s, %s, %s)? "
+ short-file short-opponent
+ (userlock--fontify-key "s")
+ (userlock--fontify-key "q")
+ (userlock--fontify-key "p")
+ (userlock--fontify-key "?"))
(if noninteractive (error "Cannot resolve lock conflict in batch mode"))
(let ((tem (let ((inhibit-quit t)
(cursor-in-echo-area t))
@@ -80,7 +88,12 @@ in any way you like."
(?? . help))))
(cond ((null answer)
(beep)
- (message "Please type q, s, or p; or ? for help")
+ (message "Please type %s, %s, or %s; or %s for help"
+ (userlock--fontify-key "q")
+ (userlock--fontify-key "s")
+ (userlock--fontify-key "p")
+ ;; FIXME: Why do we use "?" here and "C-h" below?
+ (userlock--fontify-key "?"))
(sit-for 3))
((eq (cdr answer) 'help)
(ask-user-about-lock-help)
@@ -91,14 +104,19 @@ in any way you like."
(defun ask-user-about-lock-help ()
(with-output-to-temp-buffer "*Help*"
- (princ "It has been detected that you want to modify a file that someone
else has
+ (with-current-buffer standard-output
+ (insert
+ (format
+ "It has been detected that you want to modify a file that someone else
has
already started modifying in Emacs.
-You can <s>teal the file; the other user becomes the
+You can <%s>teal the file; the other user becomes the
intruder if (s)he ever unmodifies the file and then changes it again.
-You can <p>roceed; you edit at your own (and the other user's) risk.
-You can <q>uit; don't modify this file.")
- (with-current-buffer standard-output
+You can <%s>roceed; you edit at your own (and the other user's) risk.
+You can <%s>uit; don't modify this file."
+ (userlock--fontify-key "s")
+ (userlock--fontify-key "p")
+ (userlock--fontify-key "q")))
(help-mode))))
(define-error 'file-supersession nil 'file-error)
@@ -151,8 +169,13 @@ The buffer in question is current when this function is
called."
(save-window-excursion
(let ((prompt
(format "%s changed on disk; \
-really edit the buffer? (y, n, r or C-h) "
- (file-name-nondirectory filename)))
+really edit the buffer? (%s, %s, %s or %s) "
+ (file-name-nondirectory filename)
+ (userlock--fontify-key "y")
+ (userlock--fontify-key "n")
+ (userlock--fontify-key "r")
+ ;; FIXME: Why do we use "C-h" here and "?" above?
+ (userlock--fontify-key "C-h")))
(choices '(?y ?n ?r ?? ?\C-h))
answer)
(when noninteractive
@@ -177,20 +200,28 @@ really edit the buffer? (y, n, r or C-h) "
(defun ask-user-about-supersession-help ()
(with-output-to-temp-buffer "*Help*"
- (princ
- (substitute-command-keys
- "You want to modify a buffer whose disk file has changed
+ (let ((revert-buffer-binding
+ ;; This takes place in the original buffer.
+ (substitute-command-keys "\\[revert-buffer]")))
+ (with-current-buffer standard-output
+ (insert
+ (format
+ "You want to modify a buffer whose disk file has changed
since you last read it in or saved it with this buffer.
-If you say `y' to go ahead and modify this buffer,
+If you say %s to go ahead and modify this buffer,
you risk ruining the work of whoever rewrote the file.
-If you say `r' to revert, the contents of the buffer are refreshed
+If you say %s to revert, the contents of the buffer are refreshed
from the file on disk.
-If you say `n', the change you started to make will be aborted.
-
-Usually, you should type `n' and then `\\[revert-buffer]',
-to get the latest version of the file, then make the change again."))
- (with-current-buffer standard-output
- (help-mode))))
+If you say %s, the change you started to make will be aborted.
+
+Usually, you should type %s and then %s,
+to get the latest version of the file, then make the change again."
+ (userlock--fontify-key "y")
+ (userlock--fontify-key "r")
+ (userlock--fontify-key "n")
+ (userlock--fontify-key "n")
+ revert-buffer-binding))
+ (help-mode)))))
;;; userlock.el ends here
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index d0b2e89..3a96c93 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -197,6 +197,9 @@ The remaining KEYS are passed directly to
`cvs-create-fileinfo'."
(defun cvs-parse-table ()
"Table of message objects for `cvs-parse-process'."
+ (with-suppressed-warnings ((lexical c file dir path base-rev subtype))
+ (defvar c) (defvar file) (defvar dir) (defvar path) (defvar base-rev)
+ (defvar subtype))
(let (c file dir path base-rev subtype)
(cvs-or
@@ -402,6 +405,8 @@ The remaining KEYS are passed directly to
`cvs-create-fileinfo'."
(defun cvs-parse-merge ()
+ (with-suppressed-warnings ((lexical path base-rev head-rev type))
+ (defvar path) (defvar base-rev) (defvar head-rev) (defvar type))
(let (path base-rev head-rev type)
;; A merge (maybe with a conflict).
(and
@@ -446,6 +451,9 @@ The remaining KEYS are passed directly to
`cvs-create-fileinfo'."
:merge (cons base-rev head-rev))))))
(defun cvs-parse-status ()
+ (with-suppressed-warnings ((lexical nofile path base-rev head-rev type))
+ (defvar nofile) (defvar path) (defvar base-rev) (defvar head-rev)
+ (defvar type))
(let (nofile path base-rev head-rev type)
(and
(cvs-match
@@ -494,6 +502,8 @@ The remaining KEYS are passed directly to
`cvs-create-fileinfo'."
:head-rev head-rev))))
(defun cvs-parse-commit ()
+ (with-suppressed-warnings ((lexical path file base-rev subtype))
+ (defvar path) (defvar file) (defvar base-rev) (defvar subtype))
(let (path file base-rev subtype)
(cvs-or
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 782c799..694d452 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1450,30 +1450,31 @@ If no conflict maker is found, turn off `smerge-mode'."
First tries to go to the next conflict in the current buffer, and if not
found, uses VC to try and find the next file with conflict."
(interactive)
- (let ((buffer (current-buffer)))
- (condition-case nil
- ;; FIXME: Try again from BOB before moving to the next file.
- (smerge-next)
- (error
- (if (and (or smerge-change-buffer-confirm
- (and (buffer-modified-p) buffer-file-name))
- (not (or (eq last-command this-command)
- (eq ?\r last-command-event)))) ;Called via M-x!?
- ;; FIXME: Don't emit this message if `vc-find-conflicted-file' won't
- ;; go to another file anyway (because there are no more conflicted
- ;; files).
- (message (if (buffer-modified-p)
- "No more conflicts here. Repeat to save and go to
next buffer"
- "No more conflicts here. Repeat to go to next buffer"))
- (if (and (buffer-modified-p) buffer-file-name)
- (save-buffer))
- (vc-find-conflicted-file)
- (when (eq buffer (current-buffer))
- ;; Try to find a conflict marker in current file above the point.
- (let ((prev-pos (point)))
- (goto-char (point-min))
- (unless (ignore-errors (not (smerge-next)))
- (goto-char prev-pos)))))))))
+ (condition-case nil
+ ;; FIXME: Try again from BOB before moving to the next file.
+ (smerge-next)
+ (error
+ (if (and (or smerge-change-buffer-confirm
+ (and (buffer-modified-p) buffer-file-name))
+ (not (or (eq last-command this-command)
+ (eq ?\r last-command-event)))) ;Called via M-x!?
+ ;; FIXME: Don't emit this message if `vc-find-conflicted-file' won't
+ ;; go to another file anyway (because there are no more conflicted
+ ;; files).
+ (message (if (buffer-modified-p)
+ "No more conflicts here. Repeat to save and go to next
buffer"
+ "No more conflicts here. Repeat to go to next buffer"))
+ (if (and (buffer-modified-p) buffer-file-name)
+ (save-buffer))
+ (vc-find-conflicted-file)
+ ;; At this point, the caret will only be at a conflict marker
+ ;; if the file did not correspond to an opened
+ ;; buffer. Otherwise we need to jump to a marker explicitly.
+ (unless (looking-at "^<<<<<<<")
+ (let ((prev-pos (point)))
+ (goto-char (point-min))
+ (unless (ignore-errors (not (smerge-next)))
+ (goto-char prev-pos))))))))
(provide 'smerge-mode)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index b926c38..95126fa 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1832,7 +1832,7 @@ Return t if the buffer had changes, nil otherwise."
(backend (car vc-fileset))
(first (car files))
(rev1-default nil)
- (rev2-default nil))
+ ) ;; (rev2-default nil)
(cond
;; someday we may be able to do revision completion on non-singleton
;; filesets, but not yet.
@@ -1856,9 +1856,10 @@ Return t if the buffer had changes, nil otherwise."
rev1-default "): ")
"Older revision: "))
(rev2-prompt (concat "Newer revision (default "
- (or rev2-default "current source") "): "))
+ ;; (or rev2-default
+ "current source): "))
(rev1 (vc-read-revision rev1-prompt files backend rev1-default))
- (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
+ (rev2 (vc-read-revision rev2-prompt files backend nil))) ;;
rev2-default
(when (string= rev1 "") (setq rev1 nil))
(when (string= rev2 "") (setq rev2 nil))
(list files rev1 rev2))))
diff --git a/lisp/xdg.el b/lisp/xdg.el
index 0f0df53..1103949 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -256,8 +256,8 @@ which is expected to be ordered by priority as in
(when (file-readable-p f)
(insert-file-contents-literally f nil nil nil t)
(goto-char (point-min))
- (let (end)
- (while (not (or (eobp) end))
+ (let () ;; end
+ (while (not (or (eobp))) ;; end
(if (= (following-char) ?\[)
(progn (setq sec (char-after (1+ (point))))
(forward-line))
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index 28c16ac..fb0ae0e 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -26,6 +26,7 @@ all: liblw.a
.PHONY: all
srcdir=@srcdir@
+top_builddir=@top_builddir@
# MinGW CPPFLAGS may use this.
abs_top_srcdir=@abs_top_srcdir@
VPATH=@srcdir@
@@ -56,23 +57,7 @@ TOOLKIT_OBJS = $(@X_TOOLKIT_TYPE@_OBJS)
OBJS = lwlib.o $(TOOLKIT_OBJS) lwlib-utils.o
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
diff --git a/nt/Makefile.in b/nt/Makefile.in
index aa3a762..0d44890 100644
--- a/nt/Makefile.in
+++ b/nt/Makefile.in
@@ -41,23 +41,8 @@ WERROR_CFLAGS = @WERROR_CFLAGS@
# Program name transformation.
TRANSFORM = @program_transform_name@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_RC = $(am__v_RC_@AM_V@)
-am__v_RC_ = $(am__v_RC_@AM_DEFAULT_V@)
-am__v_RC_0 = @echo " RC " $@;
-am__v_RC_1 =
+top_builddir = @top_builddir@
+-include ${top_builddir}/src/verbose.mk
# ==================== Where To Install Things ====================
diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in
index 7ae355b..39fd155 100644
--- a/oldXMenu/Makefile.in
+++ b/oldXMenu/Makefile.in
@@ -43,6 +43,7 @@
### Code:
srcdir=@srcdir@
+top_builddir = @top_builddir@
# MinGW CPPFLAGS may use this.
abs_top_srcdir=@abs_top_srcdir@
VPATH=@srcdir@
@@ -93,23 +94,7 @@ OBJS = Activate.o \
all: libXMenu11.a
.PHONY: all
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
diff --git a/src/Makefile.in b/src/Makefile.in
index 8478dc1..c6b1f55 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -29,6 +29,7 @@ SHELL = @SHELL@
# We use $(srcdir) explicitly in dependencies so as not to depend on VPATH.
srcdir = @srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
# MinGW CPPFLAGS may use this.
abs_top_srcdir=@abs_top_srcdir@
VPATH = $(srcdir)
@@ -345,33 +346,7 @@ HAVE_PDUMPER = @HAVE_PDUMPER@
## invalidates the signature, we must re-sign to fix it.
DO_CODESIGN=$(patsubst aarch64-apple-darwin%,yes,@configuration@)
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
-
-AM_V_NO_PD = $(am__v_NO_PD_@AM_V@)
-am__v_NO_PD_ = $(am__v_NO_PD_@AM_DEFAULT_V@)
-am__v_NO_PD_0 = --no-print-directory
-am__v_NO_PD_1 =
+-include ${top_builddir}/src/verbose.mk
bootstrap_exe = ../src/bootstrap-emacs$(EXEEXT)
ifeq ($(DUMPING),pdumper)
@@ -627,11 +602,6 @@ buildobj.h: Makefile
GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m)
-AM_V_GLOBALS = $(am__v_GLOBALS_@AM_V@)
-am__v_GLOBALS_ = $(am__v_GLOBALS_@AM_DEFAULT_V@)
-am__v_GLOBALS_0 = @echo " GEN " globals.h;
-am__v_GLOBALS_1 =
-
gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES)
$(AM_V_GLOBALS)$(libsrc)/make-docfile -d $(srcdir) -g $(obj) >
globals.tmp
$(AM_V_at)$(top_srcdir)/build-aux/move-if-change globals.tmp globals.h
@@ -730,7 +700,7 @@ bootstrap-clean: clean
fi
distclean: bootstrap-clean
- rm -f Makefile lisp.mk
+ rm -f Makefile lisp.mk verbose.mk
rm -fr $(DEPDIR)
maintainer-clean: distclean
diff --git a/src/buffer.c b/src/buffer.c
index 03c10cc..8e33162 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2419,6 +2419,7 @@ results, see Info node `(elisp)Swapping Text'. */)
swapfield (overlay_center, ptrdiff_t);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
+ swapfield_ (mark_active, Lisp_Object); /* Belongs with the `mark'. */
swapfield_ (enable_multibyte_characters, Lisp_Object);
swapfield_ (bidi_display_reordering, Lisp_Object);
swapfield_ (bidi_paragraph_direction, Lisp_Object);
diff --git a/src/fns.c b/src/fns.c
index b193ad6..766e767 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1867,7 +1867,8 @@ If SEQ is not a list, deletion is never performed
destructively;
instead this function creates and returns a new vector or string.
Write `(setq foo (delete element foo))' to be sure of correctly
-changing the value of a sequence `foo'. */)
+changing the value of a sequence `foo'. See also `remove', which
+does not modify the argument. */)
(Lisp_Object elt, Lisp_Object seq)
{
if (VECTORP (seq))
diff --git a/src/image.c b/src/image.c
index 8137dbe..6d493f6 100644
--- a/src/image.c
+++ b/src/image.c
@@ -135,11 +135,13 @@ typedef struct ns_bitmap_record Bitmap_Record;
# define COLOR_TABLE_SUPPORT 1
#endif
+#ifdef HAVE_RSVG
#if defined HAVE_NS
# define FRAME_SCALE_FACTOR(f) ns_frame_scale_factor (f)
#else
# define FRAME_SCALE_FACTOR(f) 1;
#endif
+#endif
static void image_disable_image (struct frame *, struct image *);
static void image_edge_detection (struct frame *, struct image *, Lisp_Object,
@@ -2225,12 +2227,17 @@ image_set_transform (struct frame *f, struct image *img)
compute_image_rotation (img, &rotation);
# if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS
- /* We want scale up operations to use a nearest neighbour filter to
+ /* We want scale up operations to use a nearest neighbor filter to
show real pixels instead of munging them, but scale down
operations to use a blended filter, to avoid aliasing and the like.
TODO: implement for Windows. */
- bool scale_down = (width < img->width) || (height < img->height);
+ bool smoothing;
+ Lisp_Object s = image_spec_value (img->spec, QCtransform_smoothing, NULL);
+ if (NILP (s))
+ smoothing = (width < img->width) || (height < img->height);
+ else
+ smoothing = !NILP (s);
# endif
/* Perform scale transformation. */
@@ -2344,13 +2351,13 @@ image_set_transform (struct frame *f, struct image *img)
/* Under NS the transform is applied to the drawing surface at
drawing time, so store it for later. */
ns_image_set_transform (img->pixmap, matrix);
- ns_image_set_smoothing (img->pixmap, scale_down);
+ ns_image_set_smoothing (img->pixmap, smoothing);
# elif defined USE_CAIRO
cairo_matrix_t cr_matrix = {matrix[0][0], matrix[0][1], matrix[1][0],
matrix[1][1], matrix[2][0], matrix[2][1]};
cairo_pattern_t *pattern = cairo_pattern_create_rgb (0, 0, 0);
cairo_pattern_set_matrix (pattern, &cr_matrix);
- cairo_pattern_set_filter (pattern, scale_down
+ cairo_pattern_set_filter (pattern, smoothing
? CAIRO_FILTER_BEST : CAIRO_FILTER_NEAREST);
/* Dummy solid color pattern just to record pattern matrix. */
img->cr_data = pattern;
@@ -2369,13 +2376,13 @@ image_set_transform (struct frame *f, struct image *img)
XDoubleToFixed (matrix[2][2])}}};
XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture,
- scale_down ? FilterBest : FilterNearest, 0, 0);
+ smoothing ? FilterBest : FilterNearest, 0, 0);
XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat);
if (img->mask_picture)
{
XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->mask_picture,
- scale_down ? FilterBest : FilterNearest, 0,
0);
+ smoothing ? FilterBest : FilterNearest, 0,
0);
XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->mask_picture,
&tmat);
}
@@ -10693,6 +10700,7 @@ non-numeric, there is no explicit limit on the size of
images. */);
DEFSYM (QCrotation, ":rotation");
DEFSYM (QCmatrix, ":matrix");
DEFSYM (QCscale, ":scale");
+ DEFSYM (QCtransform_smoothing, ":transform-smoothing");
DEFSYM (QCcolor_adjustment, ":color-adjustment");
DEFSYM (QCmask, ":mask");
diff --git a/src/keymap.c b/src/keymap.c
index 782931f..bb26b63 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2846,6 +2846,21 @@ DESCRIBER is the output function used; nil means use
`princ'. */)
return unbind_to (count, Qnil);
}
+static Lisp_Object fontify_key_properties;
+
+static Lisp_Object
+describe_key_maybe_fontify (Lisp_Object str, Lisp_Object prefix,
+ bool keymap_p)
+{
+ Lisp_Object key_desc = Fkey_description (str, prefix);
+ if (keymap_p)
+ Fadd_text_properties (make_fixnum (0),
+ make_fixnum (SCHARS (key_desc)),
+ fontify_key_properties,
+ key_desc);
+ return key_desc;
+}
+
DEFUN ("help--describe-vector", Fhelp__describe_vector,
Shelp__describe_vector, 7, 7, 0,
doc: /* Insert in the current buffer a description of the contents of
VECTOR.
Call DESCRIBER to insert the description of one value found in VECTOR.
@@ -3021,7 +3036,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- insert1 (Fkey_description (kludge, prefix));
+ insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
/* Find all consecutive characters or rows that have the same
definition. But, if VECTOR is a char-table, we had better
@@ -3071,7 +3086,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- insert1 (Fkey_description (kludge, prefix));
+ insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
}
/* Print a description of the definition of this character.
@@ -3200,6 +3215,12 @@ be preferred. */);
staticpro (&where_is_cache);
staticpro (&where_is_cache_keymaps);
+ DEFSYM (Qfont_lock_face, "font-lock-face");
+ DEFSYM (Qhelp_key_binding, "help-key-binding");
+ staticpro (&fontify_key_properties);
+ fontify_key_properties = Fcons (Qfont_lock_face,
+ Fcons (Qhelp_key_binding, Qnil));
+
defsubr (&Skeymapp);
defsubr (&Skeymap_parent);
defsubr (&Skeymap_prompt);
diff --git a/src/sysdep.c b/src/sysdep.c
index 941b4e2..d940acc 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1785,7 +1785,15 @@ handle_arith_signal (int sig)
/* Alternate stack used by SIGSEGV handler below. */
-static unsigned char sigsegv_stack[SIGSTKSZ];
+/* Storage for the alternate signal stack.
+ 64 KiB is not too large for Emacs, and is large enough
+ for all known platforms. Smaller sizes may run into trouble.
+ For example, libsigsegv 2.6 through 2.8 have a bug where some
+ architectures use more than the Linux default of an 8 KiB alternate
+ stack when deciding if a fault was caused by stack overflow. */
+static max_align_t sigsegv_stack[(64 * 1024
+ + sizeof (max_align_t) - 1)
+ / sizeof (max_align_t)];
/* Return true if SIGINFO indicates a stack overflow. */
@@ -2662,6 +2670,13 @@ void
errputc (int c)
{
fputc_unlocked (c, errstream ());
+
+#ifdef WINDOWSNT
+ /* Flush stderr after outputting a newline since stderr is fully
+ buffered when redirected to a pipe, contrary to POSIX. */
+ if (c == '\n')
+ fflush_unlocked (stderr);
+#endif
}
void
diff --git a/src/verbose.mk.in b/src/verbose.mk.in
new file mode 100644
index 0000000..085a05a
--- /dev/null
+++ b/src/verbose.mk.in
@@ -0,0 +1,50 @@
+### verbose.mk --- Makefile fragment for GNU Emacs
+
+## 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/>.
+
+# 'make' verbosity.
+V = @AM_DEFAULT_VERBOSITY@
+ifeq (${V},1)
+AM_V_AR =
+AM_V_at =
+AM_V_CC =
+AM_V_CCLD =
+AM_V_ELC =
+AM_V_GEN =
+AM_V_GLOBALS =
+AM_V_NO_PD =
+AM_V_RC =
+else
+AM_V_AR = @echo " AR " $@;
+AM_V_at = @
+AM_V_CC = @echo " CC " $@;
+AM_V_CCLD = @echo " CCLD " $@;
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ifeq ($(NATIVE_DISABLED),1)
+AM_V_ELC = @echo " ELC " $@;
+else
+AM_V_ELC = @echo " ELC+ELN " $@;
+endif
+else
+AM_V_ELC = @echo " ELC " $@;
+endif
+AM_V_GEN = @echo " GEN " $@;
+AM_V_GLOBALS = @echo " GEN " globals.h;
+AM_V_NO_PD = --no-print-directory
+AM_V_RC = @echo " RC " $@;
+endif
diff --git a/test/Makefile.in b/test/Makefile.in
index c7501fa..cb86f8e 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -32,6 +32,7 @@ SHELL = @SHELL@
srcdir = @srcdir@
abs_top_srcdir=@abs_top_srcdir@
+top_builddir = @top_builddir@
VPATH = $(srcdir)
FIND_DELETE = @FIND_DELETE@
@@ -46,32 +47,10 @@ SO = @MODULES_SUFFIX@
SEPCHAR = @SEPCHAR@
-
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_ELC = $(am__v_ELC_@AM_V@)
-am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
-am__v_ELC_0 = @echo " ELC " $@;
-am__v_ELC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
-
HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+-include ${top_builddir}/src/verbose.mk
+
# Load any GNU ELPA dependencies that are present, for optional tests.
GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa
# Keep elpa_dependencies dependency-ordered.
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index 421264d..cde657a 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -28,7 +28,7 @@ FROM debian:stretch as emacs-base
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
- libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git \
+ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git
texinfo \
&& rm -rf /var/lib/apt/lists/*
FROM emacs-base as emacs-inotify
@@ -40,7 +40,7 @@ RUN apt-get update && \
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --without-makeinfo
+RUN ./configure
RUN make -j4 bootstrap
RUN make -j4
@@ -53,8 +53,8 @@ RUN apt-get update && \
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --without-makeinfo --with-file-notification=gfile
-RUN make bootstrap
+RUN ./configure --with-file-notification=gfile
+RUN make -j4 bootstrap
RUN make -j4
FROM emacs-base as emacs-gnustep
@@ -66,6 +66,6 @@ RUN apt-get update && \
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --without-makeinfo --with-ns
-RUN make bootstrap
+RUN ./configure --with-ns
+RUN make -j4 bootstrap
RUN make -j4
diff --git a/test/lisp/cedet/semantic-utest-c.el
b/test/lisp/cedet/semantic-utest-c.el
index a7cbe11..d08c79c 100644
--- a/test/lisp/cedet/semantic-utest-c.el
+++ b/test/lisp/cedet/semantic-utest-c.el
@@ -43,7 +43,6 @@
(defvar semantic-lex-c-nested-namespace-ignore-second)
;;; Code:
-;;;###autoload
(ert-deftest semantic-test-c-preprocessor-simulation ()
"Run parsing test for C from the test directory."
:tags '(:expensive-test)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 03c267c..5147cd2 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1222,6 +1222,11 @@ compiled correctly."
(byte-compile 'counter)
(should (equal (counter) 1))))))
+(ert-deftest bytecomp-string-vs-docstring ()
+ ;; Don't confuse a string return value for a docstring.
+ (let ((lexical-binding t))
+ (should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy)
"foo"))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/ert-tests.el
b/test/lisp/emacs-lisp/ert-tests.el
index bdacb08..5c96961 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -814,7 +814,7 @@ This macro is used to test if macroexpansion in `should'
works."
:body (lambda () (should (integerp (ert-fail "Boo"))))))))
(should (ert-test-failed-p result))
(should (equal (ert-test-failed-condition result)
- '(ert-test-failed ("Boo"))))))
+ '(ert-test-failed "Boo")))))
(provide 'ert-tests)
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 8034764..b2fec5c 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -26,6 +26,7 @@
(require 'ert)
(eval-when-compile (require 'cl-lib))
+(require 'text-property-search) ; for `text-property-search-forward'
(ert-deftest help-split-fundoc-SECTION ()
"Test new optional arg SECTION."
@@ -60,9 +61,8 @@
(defmacro with-substitute-command-keys-test (&rest body)
`(cl-flet* ((test
(lambda (orig result)
- (should (equal-including-properties
- (substitute-command-keys orig)
- result))))
+ (should (equal (substitute-command-keys orig)
+ result))))
(test-re
(lambda (orig regexp)
(should (string-match (concat "^" regexp "$")
@@ -222,6 +222,24 @@ M-s next-matching-history-element
(define-minor-mode help-tests-minor-mode
"Minor mode for testing shadowing.")
+(ert-deftest help-tests-substitute-command-keys/add-key-face ()
+ (should (equal (substitute-command-keys "\\[next-line]")
+ (propertize "C-n"
+ 'face 'help-key-binding
+ 'font-lock-face 'help-key-binding))))
+
+(ert-deftest help-tests-substitute-command-keys/add-key-face-listing ()
+ (with-temp-buffer
+ (insert (substitute-command-keys "\\{help-tests-minor-mode-map}"))
+ (goto-char (point-min))
+ (text-property-search-forward 'face 'help-key-binding)
+ (should (looking-at "C-e"))
+ ;; Don't fontify trailing whitespace.
+ (should-not (get-text-property (+ (point) 3) 'face))
+ (text-property-search-forward 'face 'help-key-binding)
+ (should (looking-at "x"))
+ (should-not (get-text-property (+ (point) 1) 'face))))
+
(ert-deftest help-tests-substitute-command-keys/test-mode ()
(with-substitute-command-keys-test
(with-temp-buffer
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
index c891072..8736f7f 100644
--- a/test/lisp/kmacro-tests.el
+++ b/test/lisp/kmacro-tests.el
@@ -519,7 +519,7 @@ This is a regression test for: Bug#3412, Bug#11817."
(should (eq saved-binding (key-binding "\C-a")))))
(kmacro-tests-deftest kmacro-tests-name-or-bind-to-key-when-no-macro ()
- "Bind to key, symbol or register fails when when no macro exists."
+ "Bind to key, symbol or register fails when no macro exists."
(should-error (kmacro-bind-to-key nil))
(should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test))
(should-error (kmacro-to-register)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 016b4d3..6565919 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2824,9 +2824,10 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(should (file-exists-p (expand-file-name "bla" tmp-name2)))
(should-error
(delete-directory tmp-name1 nil 'trash)
- ;; tramp-rclone.el calls the local `delete-directory'.
- ;; This raises another error.
- :type (if (tramp--test-rclone-p) 'error 'file-error))
+ ;; tramp-rclone.el and tramp-sshfs.el call the local
+ ;; `delete-directory'. This raises another error.
+ :type (if (or (tramp--test-rclone-p) (tramp--test-sshfs-p))
+ 'error 'file-error))
(delete-directory tmp-name1 'recursive 'trash)
(should-not (file-directory-p tmp-name1))
(should
@@ -3254,8 +3255,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ignore-errors (delete-directory tmp-name1 'recursive))))))
;; Method "smb" supports `make-symbolic-link' only if the remote host
-;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and
-;; tramp-rclone.el do not support symbolic links at all.
+;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
+;; and tramp-sshfs.el do not support symbolic links at all.
(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
"Run BODY, ignoring \"make-symbolic-link not supported\" file error."
(declare (indent defun) (debug (body)))
@@ -3536,7 +3537,7 @@ They might differ only in time attributes or directory
size."
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
(skip-unless
- (or (tramp--test-sh-p) (tramp--test-sudoedit-p)
+ (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
;; Not all tramp-gvfs.el methods support changing the file mode.
(and
(tramp--test-gvfs-p)
@@ -4367,11 +4368,15 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
(delete-file tmp-name))))))
+(defun tramp--test-shell-file-name ()
+ "Return default remote shell.."
+ (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+
(ert-deftest tramp-test28-process-file ()
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)
(tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4388,25 +4393,27 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(should-not (zerop (process-file "binary-does-not-exist")))
;; Return exit code.
(should (= 42 (process-file
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
+ (tramp--test-shell-file-name)
nil nil nil "-c" "exit 42")))
;; Return exit code in case the process is interrupted,
;; and there's no indication for a signal describing string.
- (let (process-file-return-signal-string)
- (should
- (= (+ 128 2)
- (process-file
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
- nil nil nil "-c" "kill -2 $$"))))
+ (unless (tramp--test-sshfs-p)
+ (let (process-file-return-signal-string)
+ (should
+ (= (+ 128 2)
+ (process-file
+ (tramp--test-shell-file-name)
+ nil nil nil "-c" "kill -2 $$")))))
;; Return string in case the process is interrupted and
;; there's an indication for a signal describing string.
- (let ((process-file-return-signal-string t))
- (should
- (string-match-p
- "Interrupt\\|Signal 2"
- (process-file
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
- nil nil nil "-c" "kill -2 $$"))))
+ (unless (tramp--test-sshfs-p)
+ (let ((process-file-return-signal-string t))
+ (should
+ (string-match-p
+ "Interrupt\\|Signal 2"
+ (process-file
+ (tramp--test-shell-file-name)
+ nil nil nil "-c" "kill -2 $$")))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
@@ -4450,7 +4457,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)
(tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4570,7 +4577,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)
(tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
@@ -4798,7 +4805,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
- (tramp--test-sh-p)))
+ (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4897,7 +4904,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless nil)
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)
(tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
(skip-unless (tramp--test-emacs27-p))
@@ -5222,7 +5229,7 @@ Use direct async.")
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
- (tramp--test-sh-p)))
+ (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
@@ -5244,8 +5251,7 @@ Use direct async.")
(with-no-warnings
(connection-local-set-profile-variables
'remote-sh
- `((explicit-shell-file-name
- . ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+ `((explicit-shell-file-name . ,(tramp--test-shell-file-name))
(explicit-sh-args . ("-c" "echo foo"))))
(connection-local-set-profiles
`(:application tramp
@@ -5279,7 +5285,7 @@ Use direct async.")
(ert-deftest tramp-test35-exec-path ()
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)
(tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@@ -5819,6 +5825,11 @@ Additionally, ls does not support \"--dired\"."
"^\\(afp\\|davs?\\|smb\\)$"
(file-remote-p tramp-test-temporary-file-directory 'method))))
+(defun tramp--test-sshfs-p ()
+ "Check, whether the remote host is offered by sshfs.
+This requires restrictions of file name syntax."
+ (tramp-sshfs-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-sudoedit-p ()
"Check, whether the sudoedit method is used."
(tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))
@@ -6114,7 +6125,6 @@ Use the `stat' command."
(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 (or (tramp--test-emacs26-p) (not (tramp--test-rclone-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)))
@@ -6134,7 +6144,6 @@ Use the `perl' command."
(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 (or (tramp--test-emacs26-p) (not (tramp--test-rclone-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)))
@@ -6157,7 +6166,6 @@ Use the `ls' command."
(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 (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6243,7 +6251,6 @@ Use the `stat' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-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)))
@@ -6267,7 +6274,6 @@ Use the `perl' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-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)))
@@ -6294,7 +6300,6 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6335,6 +6340,7 @@ Use the `ls' command."
"Set \"process-name\" and \"process-buffer\" connection properties.
The values are derived from PROC. Run BODY.
This is needed in timer functions as well as process filters and sentinels."
+ ;; FIXME: For tramp-sshfs.el, `processp' does not work.
(declare (indent 1) (debug (processp body)))
`(let* ((v (tramp-get-connection-property ,proc "vector" nil))
(pname (tramp-get-connection-property v "process-name" nil))
@@ -6374,7 +6380,7 @@ process sentinels. They shall not disturb each other."
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
- (tramp--test-sh-p)))
+ (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-windows-nt-p)))
@@ -6384,7 +6390,7 @@ process sentinels. They shall not disturb each other."
(define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
(let* (;; For the watchdog.
(default-directory (expand-file-name temporary-file-directory))
- (shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+ (shell-file-name (tramp--test-shell-file-name))
;; It doesn't work on w32 systems.
(watchdog
(start-process-shell-command
@@ -6759,9 +6765,8 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
-;; * Implement `tramp-test31-interrupt-process' for `adb' and for
-;; direct async processes.
-;; * Fix `tramp-test44-threads'.
+;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and
+;; for direct async processes.
(provide 'tramp-tests)
diff --git a/test/lisp/progmodes/xref-resources/file1.txt
b/test/lisp/progmodes/xref-resources/file1.txt
index 5d7cc54..85b92f1 100644
--- a/test/lisp/progmodes/xref-resources/file1.txt
+++ b/test/lisp/progmodes/xref-resources/file1.txt
@@ -1,2 +1,2 @@
-foo foo
+ foo foo
bar
diff --git a/test/lisp/progmodes/xref-resources/file3.txt
b/test/lisp/progmodes/xref-resources/file3.txt
new file mode 100644
index 0000000..6283185
--- /dev/null
+++ b/test/lisp/progmodes/xref-resources/file3.txt
@@ -0,0 +1 @@
+ match some words match more match ends here
diff --git a/test/lisp/progmodes/xref-tests.el
b/test/lisp/progmodes/xref-tests.el
index b4b5e4d..9982c32 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -59,15 +59,33 @@
(should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 1
locs))))
(should (equal 1 (xref-location-line (nth 0 locs))))
(should (equal 1 (xref-location-line (nth 1 locs))))
- (should (equal 0 (xref-location-column (nth 0 locs))))
- (should (equal 4 (xref-location-column (nth 1 locs))))))
+ (should (equal 1 (xref-file-location-column (nth 0 locs))))
+ (should (equal 5 (xref-file-location-column (nth 1 locs))))))
(ert-deftest xref-matches-in-directory-finds-an-empty-line-regexp-match ()
(let ((locs (xref-tests--locations-in-data-dir "^$")))
(should (= 1 (length locs)))
(should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0
locs))))
(should (equal 1 (xref-location-line (nth 0 locs))))
- (should (equal 0 (xref-location-column (nth 0 locs))))))
+ (should (equal 0 (xref-file-location-column (nth 0 locs))))))
+
+(ert-deftest xref-matches-in-files-includes-matches-from-all-the-files ()
+ (let ((matches (xref-matches-in-files "bar"
+ (directory-files xref-tests--data-dir t
+ "\\`[^.]"))))
+ (should (= 2 (length matches)))
+ (should (cl-every
+ (lambda (match) (equal (xref-item-summary match) "bar"))
+ matches))))
+
+(ert-deftest xref-matches-in-files-trims-summary-for-matches-on-same-line ()
+ (let ((matches (xref-matches-in-files "match"
+ (directory-files xref-tests--data-dir t
+ "\\`[^.]"))))
+ (should (= 3 (length matches)))
+ (should
+ (equal (mapcar #'xref-item-summary matches)
+ '(" match some words " "match more " "match ends here")))))
(ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 ()
(let* ((xrefs (xref-tests--matches-in-data-dir "foo"))
@@ -99,18 +117,18 @@
(should (null (marker-position (cdr (nth 0 (cdr cons2))))))))
(ert-deftest xref--xref-file-name-display-is-abs ()
- (let ((xref-file-name-display 'abs)
- ;; Some older BSD find versions can produce '//' in the output.
- (expected (list
- (concat xref-tests--data-dir "/?file1.txt")
- (concat xref-tests--data-dir "/?file2.txt")))
- (actual (delete-dups
- (mapcar 'xref-location-group
- (xref-tests--locations-in-data-dir
"\\(bar\\|foo\\)")))))
- (should (and (= (length expected) (length actual))
- (cl-every (lambda (e1 e2)
- (string-match-p e1 e2))
- expected actual)))))
+ (let* ((xref-file-name-display 'abs)
+ ;; Some older BSD find versions can produce '//' in the output.
+ (expected (list
+ (concat xref-tests--data-dir "/?file1.txt")
+ (concat xref-tests--data-dir "/?file2.txt")))
+ (actual (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir
"\\(bar\\|foo\\)")))))
+ (should (= (length expected) (length actual)))
+ (should (cl-every (lambda (e1 e2)
+ (string-match-p e1 e2))
+ expected actual))))
(ert-deftest xref--xref-file-name-display-is-nondirectory ()
(let ((xref-file-name-display 'nondirectory))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index f2ddc2e..1819775 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -465,8 +465,117 @@ See bug#35036."
(simple-tests--exec '(backward-char undo-redo undo-redo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo-redo undo-redo))
+ (should (equal (buffer-string) "abcde")))
+ ;; Test undo/redo in region.
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (dolist (x '("a" "b" "c" "d" "e"))
+ (insert x)
+ (undo-boundary))
+ (should (equal (buffer-string) "abcde"))
+ ;; The test does this: activate region, `undo', break the undo
+ ;; chain (by deactivating and reactivating the region), then
+ ;; `undo-only'. There used to be a bug in
+ ;; `undo-make-selective-list' that makes `undo-only' error out in
+ ;; that case, which is fixed by in the same commit as this change.
+ (simple-tests--exec '(move-beginning-of-line
+ push-mark-command
+ forward-char
+ forward-char
+ undo))
+ (should (equal (buffer-string) "acde"))
+ (simple-tests--exec '(move-beginning-of-line
+ push-mark-command
+ forward-char
+ forward-char
+ undo-only))
(should (equal (buffer-string) "abcde"))
- ))
+ ;; Rest are simple redo in region tests.
+ (simple-tests--exec '(undo-redo))
+ (should (equal (buffer-string) "acde"))
+ (simple-tests--exec '(undo-redo))
+ (should (equal (buffer-string) "abcde"))))
+
+(defun simple-tests--sans-leading-nil (lst)
+ "Return LST sans the leading nils."
+ (while (and (consp lst) (null (car lst)))
+ (setq lst (cdr lst)))
+ lst)
+
+(ert-deftest simple-tests--undo-equiv-table ()
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (let ((ul-hash-table (make-hash-table :test #'equal)))
+ (dolist (x '("a" "b" "c"))
+ (insert x)
+ (puthash x (simple-tests--sans-leading-nil buffer-undo-list)
+ ul-hash-table)
+ (undo-boundary))
+ (should (equal (buffer-string) "abc"))
+ ;; Tests mappings in `undo-equiv-table'.
+ (simple-tests--exec '(undo))
+ (should (equal (buffer-string) "ab"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ (gethash "b" ul-hash-table)))
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "abc"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ (gethash "c" ul-hash-table)))
+ ;; Undo in region should map to 'undo-in-region.
+ (simple-tests--exec '(backward-char
+ push-mark-command
+ move-end-of-line
+ undo))
+ (should (equal (buffer-string) "ab"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ 'undo-in-region))
+ ;; The undo that undoes to the beginning should map to t.
+ (deactivate-mark 'force)
+ (simple-tests--exec '(backward-char
+ undo undo undo
+ undo undo undo))
+ (should (equal (buffer-string) ""))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ t))
+ ;; Erroneous nil undo should map to 'empty.
+ (insert "a")
+ (undo-boundary)
+ (push nil buffer-undo-list)
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "a"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ 'empty))
+ ;; But if the previous record is a redo record, its mapping
+ ;; shouldn't change.
+ (insert "e")
+ (undo-boundary)
+ (should (equal (buffer-string) "ea"))
+ (puthash "e" (simple-tests--sans-leading-nil buffer-undo-list)
+ ul-hash-table)
+ (insert "a")
+ (undo-boundary)
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "ea"))
+ (push nil buffer-undo-list)
+ (simple-tests--exec '(forward-char undo))
+ ;; Buffer content should change since we just undid a nil
+ ;; record.
+ (should (equal (buffer-string) "ea"))
+ ;; The previous redo record shouldn't map to empty.
+ (should (equal (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ (gethash "e" ul-hash-table))))))
;;; undo auto-boundary tests
(ert-deftest undo-auto-boundary-timer ()
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 843981f..8fa3917 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -78,10 +78,14 @@
(ert-deftest subr-test-define-prefix-command ()
(define-prefix-command 'foo-prefix-map)
+ (defvar foo-prefix-map)
+ (declare-function foo-prefix-map "subr-tests")
(should (keymapp foo-prefix-map))
(should (fboundp #'foo-prefix-map))
;; With optional argument.
(define-prefix-command 'bar-prefix 'bar-prefix-map)
+ (defvar bar-prefix-map)
+ (declare-function bar-prefix "subr-tests")
(should (keymapp bar-prefix-map))
(should (fboundp #'bar-prefix))
;; Returns the symbol.
@@ -531,7 +535,8 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should (equal (string-replace "a" "aa" "aaa") "aaaaaa"))
(should (equal (string-replace "abc" "defg" "abc") "defg"))
- (should-error (string-replace "" "x" "abc")))
+ (should (equal (should-error (string-replace "" "x" "abc"))
+ '(wrong-length-argument 0))))
(ert-deftest subr-replace-regexp-in-string ()
(should (equal (replace-regexp-in-string "a+" "xy" "abaabbabaaba")