pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'savannah/master' into native-comp

Browse source
This commit is contained in:
Andrea Corallo 2021-04-13 12:06:23 +02:00
commit b064ddd3f6
162 changed files with 3635 additions and 2579 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
.gitignore vendored
View file

@ -88,6 +88,7 @@ lisp/cedet/semantic/wisent/javat-wy.el
lisp/cedet/semantic/wisent/js-wy.el
lisp/cedet/semantic/wisent/python-wy.el
lisp/cedet/srecode/srt-wy.el
lisp/cedet/semantic/grammar-wy.el
lisp/eshell/esh-groups.el
lisp/finder-inf.el
lisp/leim/ja-dic/
@ -189,6 +190,7 @@ lib-src/make-docfile
lib-src/make-fingerprint
lib-src/movemail
lib-src/profile
lib-src/seccomp-filter
lib-src/test-distrib
lib-src/update-game-score
nextstep/Cocoa/Emacs.base/Contents/Info.plist
@ -302,3 +304,9 @@ nt/emacs.rc
nt/emacsclient.rc
src/gdb.ini
/var/
# Seccomp filter files.
lib-src/seccomp-filter.bpf
lib-src/seccomp-filter.pfc
lib-src/seccomp-filter-exec.bpf
lib-src/seccomp-filter-exec.pfc

13
admin/grammars/Makefile.in
View file

@ -51,14 +51,11 @@ BOVINE = \
${bovinedir}/make-by.el \
${bovinedir}/scm-by.el
## FIXME Should include this one too:
## ${cedetdir}/semantic/grammar-wy.el
## but semantic/grammar.el (which is what we use to generate grammar-wy.el)
## requires it! https://debbugs.gnu.org/16008
WISENT = \
${wisentdir}/javat-wy.el \
${wisentdir}/js-wy.el \
${wisentdir}/python-wy.el \
WISENT = \
${cedetdir}/semantic/grammar-wy.el \
${wisentdir}/javat-wy.el \
${wisentdir}/js-wy.el \
${wisentdir}/python-wy.el \
${cedetdir}/srecode/srt-wy.el
ALL = ${BOVINE} ${WISENT}

12
admin/update_autogen
View file

@ -317,7 +317,7 @@ EOF
echo "Finding loaddef targets..."
find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \
sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
>| $tempfile || die "Error finding targets"
genfiles=
@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error"
## Ignore comment differences.
[ ! "$lboot_flag" ] || \
[ ! "$lboot_flag" ] || \
diff -q -I '^;' $ldefs_in $ldefs_out || \
cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
# Refresh the prebuilt grammar-wy.el
grammar_in=lisp/cedet/semantic/grammar-wy.el
grammar_out=lisp/cedet/semantic/grm-wy-boot.el
make -C admin/grammars/ ../../$grammar_in
cp $grammar_in $grammar_out || die "cp grm_wy_boot error"
echo "Checking status of loaddef files..."
## It probably would be fine to just check+commit lisp/, since
## making autoloads should not effect any other files. But better
## safe than sorry.
modified=$(status $genfiles $ldefs_out) || die
modified=$(status $genfiles $ldefs_out $grammar_out) || die
commit "loaddefs" $modified || die "commit error"

31
configure.ac
View file

@ -4302,6 +4302,22 @@ fi
AC_SUBST([BLESSMAIL_TARGET])
AC_SUBST([LIBS_MAIL])
HAVE_SECCOMP=no
AC_CHECK_HEADERS(
[linux/seccomp.h linux/filter.h],
[AC_CHECK_DECLS(
[SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC],
[HAVE_SECCOMP=yes], [],
[[
#include <linux/seccomp.h>
]])])
AC_SUBST([HAVE_SECCOMP])
EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0])
AC_SUBST([HAVE_LIBSECCOMP])
AC_SUBST([LIBSECCOMP_LIBS])
AC_SUBST([LIBSECCOMP_CFLAGS])
OLD_LIBS=$LIBS
LIBS="$LIB_PTHREAD $LIB_MATH $LIBS"
AC_CHECK_FUNCS(accept4 fchdir gethostname \
@ -4309,7 +4325,7 @@ getrusage get_current_dir_name \
lrand48 random rint trunc \
select getpagesize setlocale newlocale \
getrlimit setrlimit shutdown \
pthread_sigmask strsignal setitimer timer_getoverrun \
pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getifaddrs freeifaddrs \
gai_strerror sync \
getpwent endpwent getgrent endgrent \
@ -5607,6 +5623,12 @@ gl_INIT
CFLAGS=$SAVE_CFLAGS
LIBS=$SAVE_LIBS
# timer_getoverrun needs the same libarary as timer_settime
OLD_LIBS=$LIBS
LIBS="$LIB_TIMER_TIME $LIBS"
AC_CHECK_FUNCS(timer_getoverrun)
LIBS=$OLD_LIBS
if test "${opsys}" = "mingw32"; then
CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc"
# Remove unneeded switches from the value of CC that goes to Makefiles
@ -5796,9 +5818,10 @@ optsep=
emacs_config_features=
for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND \
THREADS TIFF TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS \
X_TOOLKIT ZLIB; do
M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \
SOUND THREADS TIFF \
TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
ZLIB; do
case $opt in
PDUMPER) val=${with_pdumper} ;;

9
doc/emacs/buffers.texi
View file

@ -765,6 +765,15 @@ your initialization file (@pxref{Init File}):
the variable @code{fido-mode} to @code{t} (@pxref{Easy
Customization}).
@findex icomplete-vertical-mode
@cindex Icomplete vertical mode
Icomplete mode and Fido mode display the possible completions on the
same line as the prompt by default. To display the completion candidates
vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or
customize the variable @code{icomplete-vertical-mode} to @code{t}
(@pxref{Easy Customization}).
@node Buffer Menus
@subsection Customizing Buffer Menus

8
doc/emacs/search.texi
View file

@ -201,6 +201,14 @@ something before the starting point, type @kbd{C-r} to switch to a
backward search, leaving the search string unchanged. Similarly,
@kbd{C-s} in a backward search switches to a forward search.
@cindex search, changing direction
@vindex isearch-repeat-on-direction-change
When you change the direction of a search, the first command you
type will, by default, remain on the same match, and the cursor will
move to the other end of the match. To move to another match
immediately, customize the variable
@code{isearch-repeat-on-direction-change} to @code{t}.
@cindex search, wrapping around
@cindex search, overwrapped
@cindex wrapped search

10
doc/lispref/edebug.texi
View file

@ -1510,11 +1510,11 @@ form specifications (that is, @code{form}, @code{body}, @code{def-form}, and
must be in the form itself rather than at a higher level.
Backtracking is also disabled after successfully matching a quoted
symbol or string specification, since this usually indicates a
recognized construct. But if you have a set of alternative constructs that
all begin with the same symbol, you can usually work around this
constraint by factoring the symbol out of the alternatives, e.g.,
@code{["foo" &or [first case] [second case] ...]}.
symbol, string specification, or @code{&define} keyword, since this
usually indicates a recognized construct. But if you have a set of
alternative constructs that all begin with the same symbol, you can
usually work around this constraint by factoring the symbol out of the
alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}.
Most needs are satisfied by these two ways that backtracking is
automatically disabled, but occasionally it is useful to explicitly

1
doc/lispref/elisp.texi
View file

@ -531,6 +531,7 @@ Scoping Rules for Variable Bindings
* Dynamic Binding Tips:: Avoiding problems with dynamic binding.
* Lexical Binding:: A different type of local variable binding.
* Using Lexical Binding:: How to enable lexical binding.
* Converting to Lexical Binding:: Convert existing code to lexical binding.
Buffer-Local Variables

5
doc/lispref/frames.texi
View file

@ -2628,7 +2628,7 @@ When Emacs gets one of these commands, it generates a
@code{delete-frame} event, whose normal definition is a command that
calls the function @code{delete-frame}. @xref{Misc Events}.
@deffn Command delete-other-frames &optional frame
@deffn Command delete-other-frames &optional frame iconify
This command deletes all frames on @var{frame}'s terminal, except
@var{frame}. If @var{frame} uses another frame's minibuffer, that
minibuffer frame is left untouched. The argument @var{frame} must
@ -2639,6 +2639,9 @@ this command works by calling @code{delete-frame} with @var{force}
This function does not delete any of @var{frame}'s child frames
(@pxref{Child Frames}). If @var{frame} is a child frame, it deletes
@var{frame}'s siblings only.
With the prefix argument @var{iconify}, the frames are iconified rather
than deleted.
@end deffn

66
doc/lispref/modes.texi
View file

@ -1660,7 +1660,7 @@ reserved for users. @xref{Key Binding Conventions}.
The macro @code{define-minor-mode} offers a convenient way of
implementing a mode in one self-contained definition.
@defmac define-minor-mode mode doc [init-value [lighter [keymap]]] keyword-args@dots{} body@dots{}
@defmac define-minor-mode mode doc keyword-args@dots{} body@dots{}
This macro defines a new minor mode whose name is @var{mode} (a
symbol). It defines a command named @var{mode} to toggle the minor
mode, with @var{doc} as its documentation string.
@ -1675,14 +1675,36 @@ If @var{doc} is @code{nil}, the macro supplies a default documentation string
explaining the above.
By default, it also defines a variable named @var{mode}, which is set to
@code{t} or @code{nil} by enabling or disabling the mode. The variable
is initialized to @var{init-value}. Except in unusual circumstances
(see below), this value must be @code{nil}.
@code{t} or @code{nil} by enabling or disabling the mode.
The @var{keyword-args} consist of keywords followed by
corresponding values. A few keywords have special meanings:
@table @code
@item :global @var{global}
If non-@code{nil}, this specifies that the minor mode should be global
rather than buffer-local. It defaults to @code{nil}.
One of the effects of making a minor mode global is that the
@var{mode} variable becomes a customization variable. Toggling it
through the Customize interface turns the mode on and off, and its
value can be saved for future Emacs sessions (@pxref{Saving
Customizations,,, emacs, The GNU Emacs Manual}. For the saved
variable to work, you should ensure that the minor mode function
is available each time Emacs starts; usually this is done by
marking the @code{define-minor-mode} form as autoloaded.
@item :init-value @var{init-value}
This is the value to which the @var{mode} variable is initialized.
Except in unusual circumstances (see below), this value must be
@code{nil}.
@item :lighter @var{lighter}
The string @var{lighter} says what to display in the mode line
when the mode is enabled; if it is @code{nil}, the mode is not displayed
in the mode line.
@item :keymap @var{keymap}
The optional argument @var{keymap} specifies the keymap for the minor
mode. If non-@code{nil}, it should be a variable name (whose value is
a keymap), a keymap, or an alist of the form
@ -1697,42 +1719,6 @@ suitable for passing to @code{define-key} (@pxref{Changing Key
Bindings}). If @var{keymap} is a keymap or an alist, this also
defines the variable @code{@var{mode}-map}.
The above three arguments @var{init-value}, @var{lighter}, and
@var{keymap} can be (partially) omitted when @var{keyword-args} are
used. The @var{keyword-args} consist of keywords followed by
corresponding values. A few keywords have special meanings:
@table @code
@item :group @var{group}
Custom group name to use in all generated @code{defcustom} forms.
Defaults to @var{mode} without the possible trailing @samp{-mode}.
@strong{Warning:} don't use this default group name unless you have
written a @code{defgroup} to define that group properly. @xref{Group
Definitions}.
@item :global @var{global}
If non-@code{nil}, this specifies that the minor mode should be global
rather than buffer-local. It defaults to @code{nil}.
One of the effects of making a minor mode global is that the
@var{mode} variable becomes a customization variable. Toggling it
through the Customize interface turns the mode on and off, and its
value can be saved for future Emacs sessions (@pxref{Saving
Customizations,,, emacs, The GNU Emacs Manual}. For the saved
variable to work, you should ensure that the @code{define-minor-mode}
form is evaluated each time Emacs starts; for packages that are not
part of Emacs, the easiest way to do this is to specify a
@code{:require} keyword.
@item :init-value @var{init-value}
This is equivalent to specifying @var{init-value} positionally.
@item :lighter @var{lighter}
This is equivalent to specifying @var{lighter} positionally.
@item :keymap @var{keymap}
This is equivalent to specifying @var{keymap} positionally.
@item :variable @var{place}
This replaces the default variable @var{mode}, used to store the state
of the mode. If you specify this, the @var{mode} variable is not

19
doc/misc/eww.texi
View file

@ -124,17 +124,25 @@ which part of the document contains the ``readable'' text, and will
only display this part. This usually gets rid of menus and the like.
@findex eww-toggle-fonts
@findex shr-use-fonts
@vindex shr-use-fonts
@kindex F
The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use
variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable.
@findex eww-toggle-colors
@findex shr-use-colors
@kindex F
@vindex shr-use-colors
@kindex M-C
The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use
HTML-specified colors or not. This sets the @code{shr-use-colors} variable.
@findex eww-toggle-images
@vindex shr-inhibit-images
@kindex M-I
@cindex Image Display
The @kbd{M-I} command (@code{eww-toggle-images}, capital letter i)
toggles whether to display images or not. This also sets the
@code{shr-inhibit-images} variable.
@findex eww-download
@vindex eww-download-directory
@kindex d
@ -305,6 +313,11 @@ of the width and height. If Emacs supports image scaling (ImageMagick
support required) then larger images are scaled down. You can block
specific images completely by customizing @code{shr-blocked-images}.
@vindex shr-inhibit-images
You can control image display by customizing
@code{shr-inhibit-images}. If this variable is @code{nil}, display
the ``ALT'' text of images instead.
@vindex shr-color-visible-distance-min
@vindex shr-color-visible-luminance-min
@cindex Contrast

27
doc/misc/tramp.texi
View file

@ -5066,6 +5066,33 @@ path, or somewhere else entirely (including locally). @pxref{Renaming
remote files}.
@item
How to prevent @value{tramp} from clearing the @code{recentf-list}?
When @value{tramp} cleans a connection, it removes the respective
remote file name(s) from @code{recentf-list}. This is needed, because
an unresponsive remote host could trigger @code{recentf} to connect
that host again and again.
If you find the cleanup disturbing, because the file names in
@code{recentf-list} are precious to you, you could add the following
two forms in your @file{~/.emacs} after loading the @code{tramp} and
@code{recentf} packages:
@lisp
@group
(remove-hook
'tramp-cleanup-connection-hook
#'tramp-recentf-cleanup)
@end group
@group
(remove-hook
'tramp-cleanup-all-connections-hook
#'tramp-recentf-cleanup-all)
@end group
@end lisp
@item
I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d}

55
etc/NEWS
View file

@ -95,6 +95,17 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit
true color by setting 'COLORTERM=truecolor' in the environment. This is
useful on systems such as FreeBSD which ships only with "etc/termcap".
** Emacs now supports loading a Secure Computing filter.
This is supported only on capable GNU/Linux systems. To activate,
invoke Emacs with the '--seccomp=FILE' command-line option. FILE must
name a binary file containing an array of 'struct sock_filter'
structures. Emacs will then install that list of Secure Computing
filters into its own process early during the startup process. You
can use this functionality to put an Emacs process in a sandbox to
avoid security issues when executing untrusted code. See the manual
page for 'seccomp' system call, for details about Secure Computing
filters.
* Changes in Emacs 28.1
@ -269,6 +280,9 @@ input using the minibuffer.
* Editing Changes in Emacs 28.1
+++
** A prefix arg now causes 'delete-other-frames' to only iconify frames
+++
** New command 'execute-extended-command-for-buffer'.
This new command, bound to 'M-S-x', works like
@ -372,6 +386,12 @@ trying to be non-destructive.
This command opens a new buffer called "*Memory Report*" and gives a
summary of where Emacs is using memory currently.
+++
** New user option 'isearch-repeat-on-direction-change'.
When this option is set, direction changes in Isearch move to another
search match, if there is one, instead of moving point to the other
end of the current match.
** Outline
+++
@ -482,6 +502,13 @@ documented.
SMIE is now always enabled and 'ruby-use-smie' only controls whether
indentation is done using SMIE or with the old ad-hoc code.
** Icomplete
+++
*** New minor mode Icomplete-Vertical mode.
This mode is intended to be used with Icomplete or Fido, to display the
list of completions candidates vertically instead of horizontally.
---
** Specific warnings can now be disabled from the warning buffer.
When a warning is displayed to the user, the resulting buffer now has
@ -934,6 +961,14 @@ take the actual screenshot, and defaults to "ImageMagick import".
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
** Search and Replace
*** New user option 'isearch-wrap-pause' defines how to wrap the search.
There are choices to disable wrapping completely and to wrap immediately.
When wrapping immediately, it consistently handles the numeric arguments
of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
continuing with the remaining count after wrapping.
** Grep
+++
@ -2264,6 +2299,10 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
'M-g n n p p' to navigate next-error matches. Any other key exits
transient mode and then is executed normally. 'repeat-exit-key'
defines an additional key to exit mode like 'isearch-exit' ('RET').
With 'repeat-keep-prefix' you can keep the prefix arg of the previous command.
For example, this can help to reverse the window navigation direction
with e.g. 'C-x o M-- o o'. Also it can help to set a new step with
e.g. 'C-x { C-5 { { {' will set the window resizing step to 5 columns.
* New Modes and Packages in Emacs 28.1
@ -2340,6 +2379,11 @@ This is to keep the same behavior as Eshell.
* Incompatible Lisp Changes in Emacs 28.1
+++
** The use of positional arguments in 'define-minor-mode' is obsolete.
These were actually rendered obsolete in Emacs-21 but were never
marked as such.
** 'facemenu-color-alist' is now obsolete, and is not used.
** 'facemenu.el' is no longer preloaded.
@ -2403,11 +2447,6 @@ parameter.
'previous-system-time-locale' have been removed, as they were created
by mistake and were not useful to Lisp code.
---
** Loading 'generic-x' unconditionally loads all modes.
The user option 'generic-extras-enable-list' is now obsolete, and
setting it has no effect.
---
** The 'load-dangerous-libraries' variable is now obsolete.
It was used to allow loading Lisp libraries compiled by XEmacs, a
@ -2524,6 +2563,12 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete',
** The 'values' variable is now obsolete.
+++
** The '&define' keyword in an Edebug specification now disables backtracking.
The implementation was buggy, and multiple &define forms in an &or
form should be exceedingly rare. See the Info node 'Backtracking' in
the Emacs Lisp reference manual for background.
* Lisp Changes in Emacs 28.1

39
lib-src/Makefile.in
View file

@ -189,6 +189,30 @@ LIB_WSOCK32=@LIB_WSOCK32@
## Extra libraries for etags
LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM)
HAVE_SECCOMP=@HAVE_SECCOMP@
HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@
LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@
LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@
# Currently, we can only generate seccomp filter files for x86-64.
ifeq ($(HAVE_SECCOMP),yes)
ifeq ($(HAVE_LIBSECCOMP),yes)
ifeq ($(shell uname -m),x86_64)
# We require SECCOMP_RET_KILL_PROCESS, which is only available in
# Linux 4.14 and later.
ifeq ($(shell { echo 4.14; uname -r | cut -d . -f 1-2; } | \
sort -C -t . -n -k 1,1 -k 2,2 && \
echo 1),1)
SECCOMP_FILTER=1
endif
endif
endif
endif
ifeq ($(SECCOMP_FILTER),1)
DONT_INSTALL += seccomp-filter$(EXEEXT)
endif
## Extra libraries to use when linking movemail.
LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
$(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS)
@ -218,6 +242,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h
all: ${EXE_FILES} ${SCRIPTS}
ifeq ($(SECCOMP_FILTER),1)
all: seccomp-filter.bpf seccomp-filter-exec.bpf
endif
.PHONY: all need-blessmail maybe-blessmail
LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
@ -400,4 +428,15 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h)
emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico
$(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $<
ifeq ($(SECCOMP_FILTER),1)
seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h)
$(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \
$(LIBSECCOMP_LIBS) -o $@
seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT)
$(AM_V_GEN)./seccomp-filter$(EXEEXT) \
seccomp-filter.bpf seccomp-filter.pfc \
seccomp-filter-exec.bpf seccomp-filter-exec.pfc
endif
## Makefile ends here.

363
lib-src/seccomp-filter.c Normal file
View file

@ -0,0 +1,363 @@
/* Generate a Secure Computing filter definition file.
Copyright (C) 2020-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 3 of the License, or (at your
option) any later version.
GNU Emacs is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* This program creates a small Secure Computing filter usable for a
typical minimal Emacs sandbox. See the man page for `seccomp' for
details about Secure Computing filters. This program requires the
`libseccomp' library. However, the resulting filter file requires
only a Linux kernel supporting the Secure Computing extension.
Usage:
seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc
This writes the raw `struct sock_filter' array to out.bpf and a
human-readable representation to out.pfc. Additionally, it writes
variants of those files that can be used to sandbox Emacs before
'execve' to out-exec.bpf and out-exec.pfc. */
#include "config.h"
#include <errno.h>
#include <limits.h>
#include <stdarg.h>
#include <stdbool.h>
#include <stdlib.h>
#include <stdint.h>
#include <stdio.h>
#include <time.h>
#include <asm/prctl.h>
#include <sys/ioctl.h>
#include <sys/mman.h>
#include <sys/prctl.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <linux/futex.h>
#include <linux/filter.h>
#include <linux/seccomp.h>
#include <fcntl.h>
#include <sched.h>
#include <seccomp.h>
#include <unistd.h>
#include "verify.h"
static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void
fail (int error, const char *format, ...)
{
va_list ap;
va_start (ap, format);
if (error == 0)
{
vfprintf (stderr, format, ap);
fputc ('\n', stderr);
}
else
{
char buffer[1000];
vsnprintf (buffer, sizeof buffer, format, ap);
errno = error;
perror (buffer);
}
va_end (ap);
fflush (NULL);
exit (EXIT_FAILURE);
}
/* This binary is trivial, so we use a single global filter context
object that we release using `atexit'. */
static scmp_filter_ctx ctx;
static void
release_context (void)
{
seccomp_release (ctx);
}
/* Wrapper functions and macros for libseccomp functions. We exit
immediately upon any error to avoid error checking noise. */
static void
set_attribute (enum scmp_filter_attr attr, uint32_t value)
{
int status = seccomp_attr_set (ctx, attr, value);
if (status < 0)
fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value);
}
/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you
don't have to specify the number of comparator arguments, and any
failure will exit the process. */
#define RULE(action, syscall, ...) \
do \
{ \
const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \
enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \
int status = seccomp_rule_add_array (ctx, (action), (syscall), \
arg_cnt, arg_array); \
if (status < 0) \
fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \
#action, #syscall, arg_cnt, #__VA_ARGS__); \
} \
while (false)
static void
export_filter (const char *file,
int (*function) (const scmp_filter_ctx, int),
const char *name)
{
int fd = TEMP_FAILURE_RETRY (
open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC,
0644));
if (fd < 0)
fail (errno, "open %s", file);
int status = function (ctx, fd);
if (status < 0)
fail (-status, "%s", name);
if (close (fd) != 0)
fail (errno, "close");
}
#define EXPORT_FILTER(file, function) \
export_filter ((file), (function), #function)
int
main (int argc, char **argv)
{
if (argc != 5)
fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc",
argv[0]);
/* Any unhandled syscall should abort the Emacs process. */
ctx = seccomp_init (SCMP_ACT_KILL_PROCESS);
if (ctx == NULL)
fail (0, "seccomp_init");
atexit (release_context);
/* We want to abort immediately if the architecture is unknown. */
set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS);
set_attribute (SCMP_FLTATR_CTL_NNP, 1);
set_attribute (SCMP_FLTATR_CTL_TSYNC, 1);
verify (CHAR_BIT == 8);
verify (sizeof (int) == 4 && INT_MIN == INT32_MIN
&& INT_MAX == INT32_MAX);
verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN
&& LONG_MAX == INT64_MAX);
verify (sizeof (void *) == 8);
verify ((uintptr_t) NULL == 0);
/* Allow a clean exit. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group));
/* Allow `mmap' and friends. This is necessary for dynamic loading,
reading the portable dump file, and thread creation. We don't
allow pages to be both writable and executable. */
verify (MAP_PRIVATE != 0);
verify (MAP_SHARED != 0);
RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(PROT_NONE | PROT_READ | PROT_WRITE)),
/* Only support known flags. MAP_DENYWRITE is ignored, but
some versions of the dynamic loader still use it. Also
allow allocating thread stacks. */
SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
~(MAP_PRIVATE | MAP_FILE | MAP_ANONYMOUS
| MAP_FIXED | MAP_DENYWRITE | MAP_STACK
| MAP_NORESERVE),
0));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(PROT_NONE | PROT_READ | PROT_EXEC)),
/* Only support known flags. MAP_DENYWRITE is ignored, but
some versions of the dynamic loader still use it. */
SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED
| MAP_DENYWRITE),
0));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect),
/* Don't allow making pages executable. */
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(PROT_NONE | PROT_READ | PROT_WRITE), 0));
/* Futexes are used everywhere. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex),
SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE));
/* Allow basic dynamic memory management. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk));
/* Allow some status inquiries. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp));
/* Allow operations on open file descriptors. File descriptors are
capabilities, and operating on them shouldn't cause security
issues. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (read));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (write));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (close));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat));
/* Allow read operations on the filesystem. If necessary, these
should be further restricted using mount namespaces. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (access));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd));
/* Allow opening files, assuming they are only opened for
reading. */
verify (O_WRONLY != 0);
verify (O_RDWR != 0);
verify (O_CREAT != 0);
RULE (SCMP_ACT_ALLOW, SCMP_SYS (open),
SCMP_A1_32 (SCMP_CMP_MASKED_EQ,
~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
| O_DIRECTORY | O_NOFOLLOW),
0));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat),
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
| O_DIRECTORY | O_NOFOLLOW),
0));
/* Allow `tcgetpgrp'. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl),
SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO),
SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP));
/* Allow reading (but not setting) file flags. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl),
SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64),
SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
/* Allow reading random numbers from the kernel. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom));
/* Changing the umask is uncritical. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask));
/* Allow creation of pipes. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2));
/* Allow reading (but not changing) resource limits. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64),
SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */);
/* Block changing resource limits, but don't crash. */
RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64),
SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */);
/* Emacs installs signal handlers, which is harmless. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask));
/* Allow reading the current time. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime),
SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (time));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday));
/* Allow timer support. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create));
/* Allow thread creation. See the NOTES section in the manual page
for the `clone' function. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone),
SCMP_A0_64 (SCMP_CMP_MASKED_EQ,
/* Flags needed to create threads. See
create_thread in libc. */
~(CLONE_VM | CLONE_FS | CLONE_FILES
| CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD
| CLONE_SETTLS | CLONE_PARENT_SETTID
| CLONE_CHILD_CLEARTID),
0));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list));
/* Allow setting the process name for new threads. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME));
/* Allow some event handling functions used by glib. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll));
/* Don't allow creating sockets (network access would be extremely
dangerous), but also don't crash. */
RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket));
EXPORT_FILTER (argv[1], seccomp_export_bpf);
EXPORT_FILTER (argv[2], seccomp_export_pfc);
/* When applying a Seccomp filter before executing the Emacs binary
(e.g. using the `bwrap' program), we need to allow further system
calls. Firstly, the wrapper binary will need to `execve' the
Emacs binary. Furthermore, the C library requires some system
calls at startup time to set up thread-local storage. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl),
SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs));
/* We want to allow starting the Emacs binary itself with the
--seccomp flag, so we need to allow the `prctl' and `seccomp'
system calls. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS),
SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0),
SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp),
SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER),
SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC));
EXPORT_FILTER (argv[3], seccomp_export_bpf);
EXPORT_FILTER (argv[4], seccomp_export_pfc);
}

54
lisp/array.el
View file

@ -1,4 +1,4 @@
;;; array.el --- array editing commands for GNU Emacs
;;; array.el --- array editing commands for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc.
@ -769,25 +769,25 @@ Return COLUMN."
(defvar array-mode-map
(let ((map (make-keymap)))
(define-key map "\M-ad" 'array-display-local-variables)
(define-key map "\M-am" 'array-make-template)
(define-key map "\M-ae" 'array-expand-rows)
(define-key map "\M-ar" 'array-reconfigure-rows)
(define-key map "\M-a=" 'array-what-position)
(define-key map "\M-ag" 'array-goto-cell)
(define-key map "\M-af" 'array-fill-rectangle)
(define-key map "\C-n" 'array-next-row)
(define-key map "\C-p" 'array-previous-row)
(define-key map "\C-f" 'array-forward-column)
(define-key map "\C-b" 'array-backward-column)
(define-key map "\M-n" 'array-copy-down)
(define-key map "\M-p" 'array-copy-up)
(define-key map "\M-f" 'array-copy-forward)
(define-key map "\M-b" 'array-copy-backward)
(define-key map "\M-\C-n" 'array-copy-row-down)
(define-key map "\M-\C-p" 'array-copy-row-up)
(define-key map "\M-\C-f" 'array-copy-column-forward)
(define-key map "\M-\C-b" 'array-copy-column-backward)
(define-key map "\M-ad" #'array-display-local-variables)
(define-key map "\M-am" #'array-make-template)
(define-key map "\M-ae" #'array-expand-rows)
(define-key map "\M-ar" #'array-reconfigure-rows)
(define-key map "\M-a=" #'array-what-position)
(define-key map "\M-ag" #'array-goto-cell)
(define-key map "\M-af" #'array-fill-rectangle)
(define-key map "\C-n" #'array-next-row)
(define-key map "\C-p" #'array-previous-row)
(define-key map "\C-f" #'array-forward-column)
(define-key map "\C-b" #'array-backward-column)
(define-key map "\M-n" #'array-copy-down)
(define-key map "\M-p" #'array-copy-up)
(define-key map "\M-f" #'array-copy-forward)
(define-key map "\M-b" #'array-copy-backward)
(define-key map "\M-\C-n" #'array-copy-row-down)
(define-key map "\M-\C-p" #'array-copy-row-up)
(define-key map "\M-\C-f" #'array-copy-column-forward)
(define-key map "\M-\C-b" #'array-copy-column-backward)
map)
"Keymap used in array mode.")
@ -815,17 +815,17 @@ in array mode may have different values assigned to the variables.
The variables are:
Variables you assign:
array-max-row: The number of rows in the array.
array-max-column: The number of columns in the array.
array-columns-per-line: The number of columns in the array
`array-max-row': The number of rows in the array.
`array-max-column': The number of columns in the array.
`array-columns-per-line': The number of columns in the array
per line of buffer.
array-field-width: The width of each field, in characters.
array-rows-numbered: A logical variable describing whether to ignore
`array-field-width': The width of each field, in characters.
`array-rows-numbered': A logical variable describing whether to ignore
row numbers in the buffer.
Variables which are calculated:
array-line-length: The number of characters in a buffer line.
array-lines-per-row: The number of buffer lines used to
`array-line-length': The number of characters in a buffer line.
`array-lines-per-row': The number of buffer lines used to
display each row.
The following commands are available (an asterisk indicates it may

4
lisp/autoarg.el
View file

@ -107,7 +107,7 @@ then invokes the normal binding of \\[autoarg-terminate].
`C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times.
\\{autoarg-mode-map}"
nil " Aarg" autoarg-mode-map :global t :group 'keyboard)
:lighter" Aarg" :global t :group 'keyboard)
;;;###autoload
(define-minor-mode autoarg-kp-mode
@ -118,7 +118,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
`kp-1' etc. to supply digit arguments.
\\{autoarg-kp-mode-map}"
nil " Aakp" autoarg-kp-mode-map :global t :group 'keyboard
:lighter " Aakp" :global t :group 'keyboard
(if autoarg-kp-mode
(dotimes (i 10)
(let ((sym (intern (format "kp-%d" i))))

4
lisp/autorevert.el
View file

@ -227,10 +227,10 @@ modes, etc., of files. You may still sometimes want to revert
them manually.
Use this option with care since it could lead to excessive auto-reverts.
For more information, see Info node `(emacs)Autorevert'."
For more information, see Info node `(emacs)Auto Revert'."
:group 'auto-revert
:type 'boolean
:link '(info-link "(emacs)Autorevert"))
:link '(info-link "(emacs)Auto Revert"))
(defcustom global-auto-revert-ignore-modes ()
"List of major modes Global Auto-Revert Mode should not check."

9
lisp/calculator.el
View file

@ -836,10 +836,11 @@ The result should not exceed the screen width."
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
(string-to-number str (cadr (assq calculator-input-radix
'((bin 2) (oct 8) (hex 16)))))
;; Allow entry of "1.e3".
(let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str)))
(string-to-number str (cadr (assq calculator-input-radix
'((bin 2) (oct 8) (hex 16)))))
;; parse numbers similarly to calculators
;; (see tests in test/lisp/calculator-tests.el)
(let ((str (replace-regexp-in-string "\\.\\([^0-9].*\\)?$" ".0\\1" str)))
(float (string-to-number str)))))
(defun calculator-push-curnum ()

26
lisp/calendar/icalendar.el
View file

@ -581,19 +581,19 @@ ALIST is a VTIMEZONE potentially containing historical records."
(list
(car
(sort components
#'(lambda (a b)
(let* ((get-recent (lambda (n)
(car
(sort
(delq nil
(mapcar (lambda (p)
(and (memq (car p) '(DTSTART RDATE))
(car (cddr p))))
n))
'string-greaterp))))
(a-recent (funcall get-recent (car (cddr a))))
(b-recent (funcall get-recent (car (cddr b)))))
(string-greaterp a-recent b-recent))))))))
(lambda (a b)
(let* ((get-recent (lambda (n)
(car
(sort
(delq nil
(mapcar (lambda (p)
(and (memq (car p) '(DTSTART RDATE))
(car (cddr p))))
n))
'string-greaterp))))
(a-recent (funcall get-recent (car (cddr a))))
(b-recent (funcall get-recent (car (cddr b)))))
(string-greaterp a-recent b-recent))))))))
(defun icalendar--convert-all-timezones (icalendar)
"Convert all timezones in the ICALENDAR into an alist.

62
lisp/calendar/parse-time.el
View file

@ -103,46 +103,46 @@ letters, digits, plus or minus signs or colons."
((4) parse-time-months)
((5) (100))
((2 1 0)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 8)
(= (aref parse-time-elt 2) ?:)
(= (aref parse-time-elt 5) ?:)))
,(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 8)
(= (aref parse-time-elt 2) ?:)
(= (aref parse-time-elt 5) ?:)))
[0 2] [3 5] [6 8])
((8 7) parse-time-zoneinfo
,#'(lambda () (car parse-time-val))
,#'(lambda () (cadr parse-time-val)))
,(lambda () (car parse-time-val))
,(lambda () (cadr parse-time-val)))
((8)
,#'(lambda ()
(and (stringp parse-time-elt)
(= 5 (length parse-time-elt))
(or (= (aref parse-time-elt 0) ?+)
(= (aref parse-time-elt 0) ?-))))
,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
(* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
(if (= (aref parse-time-elt 0) ?-) -1 1))))
,(lambda ()
(and (stringp parse-time-elt)
(= 5 (length parse-time-elt))
(or (= (aref parse-time-elt 0) ?+)
(= (aref parse-time-elt 0) ?-))))
,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
(* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
(if (= (aref parse-time-elt 0) ?-) -1 1))))
((5 4 3)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 10)
(= (aref parse-time-elt 4) ?-)
(= (aref parse-time-elt 7) ?-)))
,(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 10)
(= (aref parse-time-elt 4) ?-)
(= (aref parse-time-elt 7) ?-)))
[0 4] [5 7] [8 10])
((2 1 0)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 5)
(= (aref parse-time-elt 2) ?:)))
[0 2] [3 5] ,#'(lambda () 0))
,(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 5)
(= (aref parse-time-elt 2) ?:)))
[0 2] [3 5] ,(lambda () 0))
((2 1 0)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 4)
(= (aref parse-time-elt 1) ?:)))
[0 1] [2 4] ,#'(lambda () 0))
,(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 4)
(= (aref parse-time-elt 1) ?:)))
[0 1] [2 4] ,(lambda () 0))
((2 1 0)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 7)
(= (aref parse-time-elt 1) ?:)))
,(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 7)
(= (aref parse-time-elt 1) ?:)))
[0 1] [2 4] [5 7])
((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
((5) (50 110) ,(lambda () (+ 1900 parse-time-elt)))
((5) (0 49) ,(lambda () (+ 2000 parse-time-elt))))
"(slots predicate extractor...)")
;;;###autoload(put 'parse-time-rules 'risky-local-variable t)

2
lisp/cedet/semantic/decorate/mode.el
View file

@ -254,7 +254,7 @@ available and the current buffer was set up for parsing. Return
non-nil if the minor mode is enabled."
;;
;;\\{semantic-decoration-map}"
nil nil nil
:lighter nil
(if semantic-decoration-mode
(if (not (and (featurep 'semantic) (semantic-active-p)))
(progn

7
lisp/cedet/semantic/grammar.el
View file

@ -31,7 +31,12 @@
(require 'semantic/format)
;; FIXME this is a generated file, but we need to load this file to
;; generate it!
(require 'semantic/grammar-wy)
;; We need `semantic/grammar-wy.el' but we're also needed to generate
;; that file from `grammar.wy', so to break the dependency, we keep
;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008.
(eval-and-compile
(unless (require 'semantic/grammar-wy nil t)
(load "semantic/grm-wy-boot")))
(require 'semantic/idle)
(require 'help-fns)
(require 'semantic/analyze)

0
lisp/cedet/semantic/grammar-wy.el → lisp/cedet/semantic/grm-wy-boot.el
View file

3
lisp/cedet/semantic/idle.el
View file

@ -171,7 +171,8 @@ date, and reparses while the user is idle (not typing.)
The minor mode can be turned on only if semantic feature is
available and the current buffer was set up for parsing. Return
non-nil if the minor mode is enabled." nil nil nil
non-nil if the minor mode is enabled."
:lighter nil
(if semantic-idle-scheduler-mode
(if (not (and (featurep 'semantic) (semantic-active-p)))
(progn

103
lisp/cmuscheme.el
View file

@ -1,7 +1,6 @@
;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*- lexical-binding: t -*-
;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Copyright (C) 1988-2021 Free Software Foundation, Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
;; Maintainer: emacs-devel@gnu.org
@ -26,20 +25,18 @@
;; This is a customization of comint-mode (see comint.el)
;;
;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
;; 8/88
;;
;; Please send me bug reports, bug fixes, and extensions, so that I can
;; merge them into the master source.
;;
;; The changelog is at the end of this file.
;;
;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
;; interface that communicates process state back to the superior emacs by
;; outputting special control sequences. The Emacs package, xscheme.el, has
;; outputting special control sequences. The Emacs package, xscheme.el, has
;; lots and lots of special purpose code to read these control sequences, and
;; so is very tightly integrated with the cscheme process. The cscheme
;; so is very tightly integrated with the cscheme process. The cscheme
;; interrupt handler and debugger read single character commands in cbreak
;; mode; when this happens, xscheme.el switches to special keymaps that bind
;; the single letter command keys to emacs functions that directly send the
@ -49,18 +46,18 @@
;;
;; Here's a summary of the pros and cons, as I see them.
;; xscheme: Tightly integrated with inferior cscheme process! A few commands
;; not in cmuscheme. But. Integration is a bit of a hack. Input
;; history only keeps the immediately prior input. Bizarre
;; not in cmuscheme. But. Integration is a bit of a hack. Input
;; history only keeps the immediately prior input. Bizarre
;; keybindings.
;;
;; cmuscheme: Not tightly integrated with inferior cscheme process. But.
;; Carefully integrated functionality with the entire suite of
;; comint-derived CMU process modes. Keybindings reminiscent of
;; Zwei and Hemlock. Good input history. A few commands not in
;; comint-derived CMU process modes. Keybindings reminiscent of
;; Zwei and Hemlock. Good input history. A few commands not in
;; xscheme.
;;
;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
;; Cscheme-specific; you must use cmuscheme.el. Interested parties are
;; invited to port xscheme functionality on top of comint mode...
@ -70,18 +67,18 @@
;; Created.
;;
;; 2/15/89 Olin
;; Removed -emacs flag from process invocation. It's only useful for
;; Removed -emacs flag from process invocation. It's only useful for
;; cscheme, and makes cscheme assume it's running under xscheme.el,
;; which messes things up royally. A bug.
;; which messes things up royally. A bug.
;;
;; 5/22/90 Olin
;; - Upgraded to use comint-send-string and comint-send-region.
;; - run-scheme now offers to let you edit the command line if
;; you invoke it with a prefix-arg. M-x scheme is redundant, and
;; you invoke it with a prefix-arg. M-x scheme is redundant, and
;; has been removed.
;; - Explicit references to process "scheme" have been replaced with
;; (scheme-proc). This allows better handling of multiple process bufs.
;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
;; (scheme-proc). This allows better handling of multiple process bufs.
;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
;; and friends, but interested hackers might find a useful application
;; of this facility.
@ -95,42 +92,37 @@
(require 'scheme)
(require 'comint)
(defgroup cmuscheme nil
"Run a scheme process in a buffer."
:group 'scheme)
;;; INFERIOR SCHEME MODE STUFF
;;;============================================================================
(defcustom inferior-scheme-mode-hook nil
"Hook for customizing inferior-scheme mode."
:type 'hook
:group 'cmuscheme)
:type 'hook)
(defvar inferior-scheme-mode-map
(let ((m (make-sparse-keymap)))
(define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention
(define-key m "\C-x\C-e" 'scheme-send-last-sexp)
(define-key m "\C-c\C-l" 'scheme-load-file)
(define-key m "\C-c\C-k" 'scheme-compile-file)
(define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention
(define-key m "\C-x\C-e" #'scheme-send-last-sexp)
(define-key m "\C-c\C-l" #'scheme-load-file)
(define-key m "\C-c\C-k" #'scheme-compile-file)
(scheme-mode-commands m)
m))
;; Install the process communication commands in the scheme-mode keymap.
(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention
(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention
(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition)
(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go)
(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region)
(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure)
(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form)
(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention
(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention
(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition)
(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go)
(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region)
(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go)
(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition)
(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go)
(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure)
(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form)
(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme)
(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file)
(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile"
(let ((map (lookup-key scheme-mode-map [menu-bar scheme])))
(define-key map [separator-eval] '("--"))
@ -157,8 +149,7 @@
(define-key map [send-region]
'("Evaluate Region" . scheme-send-region))
(define-key map [send-sexp]
'("Evaluate Last S-expression" . scheme-send-last-sexp))
)
'("Evaluate Last S-expression" . scheme-send-last-sexp)))
(defvar scheme-buffer)
@ -209,8 +200,7 @@ to continue it."
(defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
"Input matching this regexp are not saved on the history list.
Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
:type 'regexp
:group 'cmuscheme)
:type 'regexp)
(defun scheme-input-filter (str)
"Don't save anything matching `inferior-scheme-filter-regexp'."
@ -242,7 +232,7 @@ is run).
scheme-program-name)))
(if (not (comint-check-proc "*scheme*"))
(let ((cmdlist (split-string-and-unquote cmd)))
(set-buffer (apply 'make-comint "scheme" (car cmdlist)
(set-buffer (apply #'make-comint "scheme" (car cmdlist)
(scheme-start-file (car cmdlist)) (cdr cmdlist)))
(inferior-scheme-mode)))
(setq scheme-program-name cmd)
@ -282,8 +272,7 @@ in this order. Return nil if no start file found."
(defcustom scheme-compile-exp-command "(compile '%s)"
"Template for issuing commands to compile arbitrary Scheme expressions."
:type 'string
:group 'cmuscheme)
:type 'string)
(defun scheme-compile-region (start end)
"Compile the current region in the inferior Scheme process.
@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use
(setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\")
For Scheme 48 and Scsh use \",trace %s\"."
:type 'string
:group 'cmuscheme)
:type 'string)
(defcustom scheme-untrace-command "(untrace %s)"
"Template for switching off tracing of a Scheme procedure.
Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
:type 'string
:group 'cmuscheme)
:type 'string)
(defun scheme-trace-procedure (proc &optional untrace)
"Trace procedure PROC in the inferior Scheme process.
@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure PROC."
(defcustom scheme-macro-expand-command "(expand %s)"
"Template for macro-expanding a Scheme form.
For Scheme 48 and Scsh use \",expand %s\"."
:type 'string
:group 'cmuscheme)
:type 'string)
(defun scheme-expand-current-form ()
"Macro-expand the form at point in the inferior Scheme process."
@ -410,8 +395,7 @@ Then switch to the process buffer."
If it's loaded into a buffer that is in one of these major modes, it's
considered a scheme source file by `scheme-load-file' and `scheme-compile-file'.
Used by these commands to determine defaults."
:type '(repeat function)
:group 'cmuscheme)
:type '(repeat function))
(defvar scheme-prev-l/c-dir/file nil
"Caches the last (directory . file) pair.
@ -514,8 +498,7 @@ command to run."
(defcustom cmuscheme-load-hook nil
"This hook is run when cmuscheme is loaded in.
This is a good place to put keybindings."
:type 'hook
:group 'cmuscheme)
:type 'hook)
(make-obsolete-variable 'cmuscheme-load-hook
"use `with-eval-after-load' instead." "28.1")

25
lisp/comint.el
View file

@ -1627,7 +1627,6 @@ or to the last history element for a backward search."
(if isearch-forward
(comint-goto-input (1- (ring-length comint-input-ring)))
(comint-goto-input nil))
(setq isearch-success t)
(goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
@ -1798,6 +1797,10 @@ Ignore duplicates if `comint-input-ignoredups' is non-nil."
(min size (- comint-input-ring-size size)))))
(ring-insert comint-input-ring cmd)))
(defconst comint--prompt-rear-nonsticky
'(field inhibit-line-move-field-capture read-only font-lock-face)
"Text properties we set on the prompt and don't want to leak past it.")
(defun comint-send-input (&optional no-newline artificial)
"Send input to process.
After the process output mark, sends all text from the process mark to
@ -1917,7 +1920,8 @@ Similarly for Soar, Scheme, etc."
(unless (or no-newline comint-use-prompt-regexp)
;; Cover the terminating newline
(add-text-properties end (1+ end)
'(rear-nonsticky t
`(rear-nonsticky
,comint--prompt-rear-nonsticky
field boundary
inhibit-line-move-field-capture t)))))
@ -2124,9 +2128,10 @@ Make backspaces delete the previous character."
(unless comint-use-prompt-regexp
(with-silent-modifications
(add-text-properties comint-last-output-start (point)
'(front-sticky
`(rear-nonsticky
,comint--prompt-rear-nonsticky
front-sticky
(field inhibit-line-move-field-capture)
rear-nonsticky t
field output
inhibit-line-move-field-capture t))))
@ -2155,7 +2160,9 @@ Make backspaces delete the previous character."
(font-lock-prepend-text-property prompt-start (point)
'font-lock-face
'comint-highlight-prompt)
(add-text-properties prompt-start (point) '(rear-nonsticky t)))
(add-text-properties prompt-start (point)
`(rear-nonsticky
,comint--prompt-rear-nonsticky)))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
@ -2251,23 +2258,23 @@ This function could be on `comint-output-filter-functions' or bound to a key."
(let ((inhibit-read-only t))
(delete-region (point-min) (point)))))
(defun comint-strip-ctrl-m (&optional _string)
(defun comint-strip-ctrl-m (&optional _string interactive)
"Strip trailing `^M' characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
(interactive)
(interactive (list nil t))
(let ((process (get-buffer-process (current-buffer))))
(if (not process)
;; This function may be used in
;; `comint-output-filter-functions', and in that case, if
;; there's no process, then we should do nothing. If
;; interactive, report an error.
(when (called-interactively-p 'interactive)
(when interactive
(error "No process in the current buffer"))
(let ((pmark (process-mark process)))
(save-excursion
(condition-case nil
(goto-char
(if (called-interactively-p 'interactive)
(if interactive
comint-last-input-end comint-last-output-start))
(error nil))
(while (re-search-forward "\r+$" pmark t)

6
lisp/cus-dep.el
View file

@ -1,4 +1,4 @@
;;; cus-dep.el --- find customization dependencies
;;; cus-dep.el --- find customization dependencies -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;;
@ -132,7 +132,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
(eval expr))
(eval expr t))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
;; in the file (we haven't loaded the file).
@ -164,7 +164,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(let ((members (get symbol 'custom-group))
where found)
(when members
(dolist (member (mapcar 'car members))
(dolist (member (mapcar #'car members))
(setq where (get member 'custom-where))
(unless (or (null where)
(member where found))

2
lisp/dired-aux.el
View file

@ -2980,7 +2980,7 @@ a file name. Otherwise, it searches the whole buffer without restrictions."
When on, Isearch skips matches outside file names using the predicate
`dired-isearch-filter-filenames' that matches only at file names.
When off, it uses the original predicate."
nil nil nil
:lighter nil
(if dired-isearch-filenames-mode
(add-function :before-while (local 'isearch-filter-predicate)
#'dired-isearch-filter-filenames

4
lisp/dirtrack.el
View file

@ -184,7 +184,7 @@ working directory at all times, and that you set the variable
This is an alternative to `shell-dirtrack-mode', which works by
tracking `cd' and similar commands which change the shell working
directory."
nil nil nil
:lighter nil
(if dirtrack-mode
(add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
@ -192,7 +192,7 @@ directory."
(define-minor-mode dirtrack-debug-mode
"Toggle Dirtrack debugging."
nil nil nil
:lighter nil
(if dirtrack-debug-mode
(display-buffer (get-buffer-create dirtrack-debug-buffer))))

7
lisp/dynamic-setting.el
View file

@ -24,8 +24,8 @@
;;; Commentary:
;; This file provides the lisp part of the GConf and XSetting code in
;; xsetting.c. But it is nothing that prevents it from being used by
;; This file provides the Lisp part of the GConf and XSetting code in
;; xsetting.c. But there is nothing that prevents it from being used by
;; other configuration schemes.
;;; Code:
@ -92,3 +92,6 @@ Changes can be
(define-key special-event-map [config-changed-event]
#'dynamic-setting-handle-config-changed-event)
(provide 'dynamic-setting)
;;; dynamic-setting.el ends here

36
lisp/edmacro.el
View file

@ -1,4 +1,4 @@
;;; edmacro.el --- keyboard macro editor
;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal notation."
(defvar edmacro-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'edmacro-finish-edit)
(define-key map "\C-c\C-q" 'edmacro-insert-key)
(define-key map "\C-c\C-c" #'edmacro-finish-edit)
(define-key map "\C-c\C-q" #'edmacro-insert-key)
map))
(defvar edmacro-store-hook)
@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise way."
(set-buffer-modified-p nil))
(run-hooks 'edmacro-format-hook)))))
;;; The next two commands are provided for convenience and backward
;;; compatibility.
;; The next two commands are provided for convenience and backward
;; compatibility.
;;;###autoload
(defun edit-last-kbd-macro (&optional prefix)
@ -237,8 +237,7 @@ or nil, use a compact 80-column format."
((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
(when edmacro-store-hook
(error "\"Command\" line not allowed in this context"))
(let ((str (buffer-substring (match-beginning 1)
(match-end 1))))
(let ((str (match-string 1)))
(unless (equal str "")
(setq cmd (and (not (equal str "none"))
(intern str)))
@ -253,8 +252,7 @@ or nil, use a compact 80-column format."
(when edmacro-store-hook
(error "\"Key\" line not allowed in this context"))
(let ((key (edmacro-parse-keys
(buffer-substring (match-beginning 1)
(match-end 1)))))
(match-string 1))))
(unless (equal key "")
(if (equal key "none")
(setq no-keys t)
@ -274,16 +272,14 @@ or nil, use a compact 80-column format."
((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
(when edmacro-store-hook
(error "\"Counter\" line not allowed in this context"))
(let ((str (buffer-substring (match-beginning 1)
(match-end 1))))
(let ((str (match-string 1)))
(unless (equal str "")
(setq mac-counter (string-to-number str))))
t)
((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$")
(when edmacro-store-hook
(error "\"Format\" line not allowed in this context"))
(let ((str (buffer-substring (match-beginning 1)
(match-end 1))))
(let ((str (match-string 1)))
(unless (equal str "")
(setq mac-format str)))
t)
@ -475,7 +471,7 @@ doubt, use whitespace."
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ")
(cl-callf cl-subseq rest-mac i)))))))
(bind-len (apply 'max 1
(bind-len (apply #'max 1
(cl-loop for map in maps
for b = (lookup-key map rest-mac)
when b collect b)))
@ -506,7 +502,7 @@ doubt, use whitespace."
finally return i))
desc)
(if (stringp bind) (setq bind nil))
(cond ((and (eq bind 'self-insert-command) (not prefix)
(cond ((and (eq bind #'self-insert-command) (not prefix)
(> text 1) (integerp first)
(> first 32) (<= first maxkey) (/= first 92)
(progn
@ -520,11 +516,11 @@ doubt, use whitespace."
desc))))
(when (or (string-match "^\\^.$" desc)
(member desc res-words))
(setq desc (mapconcat 'char-to-string desc " ")))
(setq desc (mapconcat #'char-to-string desc " ")))
(when verbose
(setq bind (format "%s * %d" bind text)))
(setq bind-len text))
((and (eq bind 'execute-extended-command)
((and (eq bind #'execute-extended-command)
(> text bind-len)
(memq (aref rest-mac text) '(return 13))
(progn
@ -667,10 +663,8 @@ This function assumes that the events can be stored in a string."
(substring word 2 -2) "\r")))
((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
(progn
(setq word (concat (substring word (match-beginning 1)
(match-end 1))
(substring word (match-beginning 3)
(match-end 3))))
(setq word (concat (match-string 1 word)
(match-string 3 word)))
(not (string-match
"\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
word))))

10
lisp/emacs-lisp/byte-opt.el
View file

@ -528,8 +528,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
`(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
`(,(car clause)
,@(byte-optimize-body (cdr clause) for-effect)))
(let ((byte-optimize--lexvars
(and lexical-binding
(if var
(cons (list var t)
byte-optimize--lexvars)
byte-optimize--lexvars))))
(cons (car clause)
(byte-optimize-body (cdr clause) for-effect))))
clauses))))
(`(unwind-protect ,exp . ,exps)

2
lisp/emacs-lisp/cconv.el
View file

@ -498,7 +498,7 @@ places where they originally did not directly appear."
(let* ((class (and var (cconv--var-classification (list var) form)))
(newenv
(cond ((eq class :captured+mutated)
(cons `(,var . (car-save ,var)) env))
(cons `(,var . (car-safe ,var)) env))
((assq var env) (cons `(,var) env))
(t env)))
(msg (when (eq class :unused)

2
lisp/emacs-lisp/checkdoc.el
View file

@ -1242,7 +1242,7 @@ bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-c
checking of documentation strings.
\\{checkdoc-minor-mode-map}"
nil checkdoc-minor-mode-string nil
:lighter checkdoc-minor-mode-string
:group 'checkdoc)
;;; Subst utils

7
lisp/emacs-lisp/cl-macs.el
View file

@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; tail-called any more.
(not (memq var shadowings)))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
((and `(condition-case ,err-var ,bodyform . ,handlers)
(guard (not (eq err-var var))))
`(condition-case ,err-var
(progn (setq ,retvar ,bodyform) nil)
. ,(mapcar (lambda (h)
(cons (car h) (funcall opt-exps (cdr h))))
handlers)))
('nil nil) ;No need to set `retvar' to return nil.
(_ `(progn (setq ,retvar ,exp) nil))))))

197
lisp/emacs-lisp/easy-mmode.el
View file

@ -139,39 +139,31 @@ documenting what its argument does. If the word \"ARG\" does not
appear in DOC, a paragraph is added to DOC explaining
usage of the mode argument.
Optional INIT-VALUE is the initial value of the mode's variable.
Note that the minor mode function won't be called by setting
this option, so the value *reflects* the minor mode's natural
initial state, rather than *setting* it.
In the vast majority of cases it should be nil.
Optional LIGHTER is displayed in the mode line when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
or an expression that returns either a keymap or a list of
(KEY . BINDING) pairs where KEY and BINDING are suitable for
`define-key'. If you supply a KEYMAP argument that is not a
symbol, this macro defines the variable MODE-map and gives it
the value that KEYMAP specifies.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
alternating keywords and values. If you provide BODY, then you must
provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
at least one keyword argument, or both; otherwise, BODY would be
misinterpreted as the first omitted argument. The following special
provide at least one keyword argument. The following special
keywords are supported (other keywords are passed to `defcustom' if
the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
:init-value VAL Same as the INIT-VALUE argument.
:init-value VAL the initial value of the mode's variable.
Note that the minor mode function won't be called by setting
this option, so the value *reflects* the minor mode's natural
initial state, rather than *setting* it.
In the vast majority of cases it should be nil.
Not used if you also specify :variable.
:lighter SPEC Same as the LIGHTER argument.
:keymap MAP Same as the KEYMAP argument.
:require SYM Same as in `defcustom'.
:lighter SPEC Text displayed in the mode line when the mode is on.
:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'.
If non-nil, it should be a variable name (whose value is
a keymap), or an expression that returns either a keymap or
a list of (KEY . BINDING) pairs where KEY and BINDING are
suitable for `define-key'. If you supply a KEYMAP argument
that is not a symbol, this macro defines the variable MODE-map
and gives it the value that KEYMAP specifies.
:interactive VAL Whether this mode should be a command or not. The default
is to make it one; use nil to avoid that. If VAL is a list,
it's interpreted as a list of major modes this minor mode
@ -185,15 +177,18 @@ BODY contains code to execute each time the mode is enabled or disabled.
sets it. If you specify a :variable, this function does
not define a MODE variable (nor any of the terms used
in :variable).
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
:lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\"
...BODY CODE...)"
...BODY CODE...)
For backward compatibility with the Emacs<21 calling convention,
BODY can also start with the triplet INIT-VALUE LIGHTER KEYMAP."
(declare (doc-string 2)
(advertised-calling-convention (mode doc &rest body) "28.1")
(debug (&define name string-or-null-p
[&optional [&not keywordp] sexp
&optional [&not keywordp] sexp
@ -201,23 +196,12 @@ For example, you could write
[&rest [keywordp sexp]]
def-body)))
;; Allow skipping the first three args.
(cond
((keywordp init-value)
(setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
`(,init-value ,lighter))
init-value nil lighter nil keymap nil))
((keywordp lighter)
(setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
((keywordp keymap) (push keymap body) (setq keymap nil)))
(let* ((last-message (make-symbol "last-message"))
(mode-name (symbol-name mode))
(pretty-name (easy-mmode-pretty-mode-name mode lighter))
(pretty-name nil)
(globalp nil)
(set nil)
(initialize nil)
(group nil)
(type nil)
(extra-args nil)
(extra-keywords nil)
@ -225,14 +209,28 @@ For example, you could write
(setter `(setq ,mode)) ;The beginning of the exp to set the mode var.
(getter mode) ;The exp to get the mode value.
(modefun mode) ;The minor mode function name we're defining.
(require t)
(after-hook nil)
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(hook-off (intern (concat mode-name "-off-hook")))
(interactive t)
(warnwrap (if (keywordp init-value) #'identity
(lambda (exp)
(macroexp-warn-and-return
"Use keywords rather than deprecated positional arguments to `define-minor-mode'"
exp))))
keyw keymap-sym tmp)
;; Allow skipping the first three args.
(cond
((keywordp init-value)
(setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
`(,init-value ,lighter))
init-value nil lighter nil keymap nil))
((keywordp lighter)
(setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
((keywordp keymap) (push keymap body) (setq keymap nil)))
;; Check keys.
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
@ -246,9 +244,7 @@ For example, you could write
(:extra-args (setq extra-args (pop body)))
(:set (setq set (list :set (pop body))))
(:initialize (setq initialize (list :initialize (pop body))))
(:group (setq group (nconc group (list :group (pop body)))))
(:type (setq type (list :type (pop body))))
(:require (setq require (pop body)))
(:keymap (setq keymap (pop body)))
(:interactive (setq interactive (pop body)))
(:variable (setq variable (pop body))
@ -264,6 +260,7 @@ For example, you could write
(:after-hook (setq after-hook (pop body)))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
(setq pretty-name (easy-mmode-pretty-mode-name mode lighter))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
@ -301,70 +298,72 @@ or call the function `%s'."))))
,(format base-doc-string pretty-name mode mode)
,@set
,@initialize
,@group
,@type
,@(unless (eq require t) `(:require ,require))
,@(nreverse extra-keywords)))))
;; The actual function.
(defun ,modefun (&optional arg ,@extra-args)
,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
,(when interactive
;; Use `toggle' rather than (if ,mode 0 1) so that using
;; repeat-command still does the toggling correctly.
(if (consp interactive)
`(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
'toggle))
,@interactive)
'(interactive (list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
'toggle)))))
(let ((,last-message (current-message)))
(,@setter
(cond ((eq arg 'toggle)
(not ,getter))
((and (numberp arg)
(< arg 1))
nil)
(t
t)))
;; Keep minor modes list up to date.
,@(if globalp
;; When running this byte-compiled code in earlier
;; Emacs versions, these variables may not be defined
;; there. So check defensively, even if they're
;; always defined in Emacs 28 and up.
`((when (boundp 'global-minor-modes)
(setq global-minor-modes
(delq ',modefun global-minor-modes))
(when ,getter
(push ',modefun global-minor-modes))))
;; Ditto check.
`((when (boundp 'local-minor-modes)
(setq local-minor-modes (delq ',modefun local-minor-modes))
(when ,getter
(push ',modefun local-minor-modes)))))
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,getter ',hook-on ',hook-off))
(if (called-interactively-p 'any)
(progn
,(if (and globalp (not variable))
`(customize-mark-as-set ',mode))
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless (and (current-message)
(not (equal ,last-message
(current-message))))
(let ((local ,(if globalp "" " in current buffer")))
(message ,(format "%s %%sabled%%s" pretty-name)
(if ,getter "en" "dis") local)))))
,@(when after-hook `(,after-hook)))
(force-mode-line-update)
;; Return the new setting.
,getter)
,(funcall
warnwrap
`(defun ,modefun (&optional arg ,@extra-args)
,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
,(when interactive
;; Use `toggle' rather than (if ,mode 0 1) so that using
;; repeat-command still does the toggling correctly.
(if (consp interactive)
`(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
'toggle))
,@interactive)
'(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
'toggle)))))
(let ((,last-message (current-message)))
(,@setter
(cond ((eq arg 'toggle)
(not ,getter))
((and (numberp arg)
(< arg 1))
nil)
(t
t)))
;; Keep minor modes list up to date.
,@(if globalp
;; When running this byte-compiled code in earlier
;; Emacs versions, these variables may not be defined
;; there. So check defensively, even if they're
;; always defined in Emacs 28 and up.
`((when (boundp 'global-minor-modes)
(setq global-minor-modes
(delq ',modefun global-minor-modes))
(when ,getter
(push ',modefun global-minor-modes))))
;; Ditto check.
`((when (boundp 'local-minor-modes)
(setq local-minor-modes
(delq ',modefun local-minor-modes))
(when ,getter
(push ',modefun local-minor-modes)))))
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,getter ',hook-on ',hook-off))
(if (called-interactively-p 'any)
(progn
,(if (and globalp (not variable))
`(customize-mark-as-set ',mode))
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless (and (current-message)
(not (equal ,last-message
(current-message))))
(let ((local ,(if globalp "" " in current buffer")))
(message ,(format "%s %%sabled%%s" pretty-name)
(if ,getter "en" "dis") local)))))
,@(when after-hook `(,after-hook)))
(force-mode-line-update)
;; Return the new setting.
,getter))
;; Autoloading a define-minor-mode autoloads everything
;; up-to-here.

8
lisp/emacs-lisp/easymenu.el
View file

@ -494,14 +494,16 @@ To implement dynamic menus, either call this from
`menu-bar-update-hook' or use a menu filter."
(easy-menu-add-item map path (easy-menu-create-menu name items) before))
(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1"
(defalias 'easy-menu-remove #'ignore
"Remove MENU from the current menu bar.
Contrary to XEmacs, this is a nop on Emacs since menus are automatically
\(de)activated when the corresponding keymap is (de)activated.
\(fn MENU)")
(make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \
and can be safely removed." "28.1")
(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1"
(defalias 'easy-menu-add #'ignore
"Add the menu to the menubar.
On Emacs this is a nop, because menus are already automatically
activated when the corresponding keymap is activated. On XEmacs
@ -511,6 +513,8 @@ You should call this once the menu and keybindings are set up
completely and menu filter functions can be expected to work.
\(fn MENU &optional MAP)")
(make-obsolete 'easy-menu-add "this was always a no-op in Emacs \
and can be safely removed." "28.1")
(defun add-submenu (menu-path submenu &optional before in-menu)
"Add submenu SUBMENU in the menu at MENU-PATH.

22
lisp/emacs-lisp/edebug.el
View file

@ -1942,14 +1942,16 @@ a sequence of elements."
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
;; of the current list. e.g. ("lambda" &define args def-body)
(edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
;; Find the last offset in the list.
(let ((offsets (edebug-cursor-offsets cursor)))
(while (consp offsets) (setq offsets (cdr offsets)))
offsets)
specs))
(prog1 (edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
;; Find the last offset in the list.
(let ((offsets (edebug-cursor-offsets cursor)))
(while (consp offsets) (setq offsets (cdr offsets)))
offsets)
specs)
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
@ -4114,12 +4116,12 @@ This should be a list of `edebug---frame' objects.")
"Stack frames of the current Edebug Backtrace buffer with instrumentation.
This should be a list of `edebug---frame' objects.")
;; Data structure for backtrace frames with information
;; from Edebug instrumentation found in the backtrace.
(cl-defstruct
(edebug--frame
(:constructor edebug--make-frame)
(:include backtrace-frame))
"Data structure for backtrace frames with information
from Edebug instrumentation found in the backtrace."
def-name before-index after-index)
(defun edebug-pop-to-backtrace ()

3
lisp/emacs-lisp/eieio-base.el
View file

@ -1,7 +1,6 @@
;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software
;;; Foundation, Inc.
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp

1
lisp/emacs-lisp/float-sup.el
View file

@ -31,6 +31,7 @@
(with-suppressed-warnings ((lexical pi))
(defconst pi float-pi
"Obsolete since Emacs-23.3. Use `float-pi' instead."))
(make-obsolete-variable 'pi 'float-pi "23.3")
(internal-make-var-non-special 'pi)
(defconst float-e (exp 1) "The value of e (2.7182818...).")

3
lisp/emacs-lisp/macroexp.el
View file

@ -394,7 +394,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; Record which arguments expect functions, so we can warn when those
;; are accidentally quoted with ' rather than with #'
(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash))
(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash
map-char-table map-keymap map-keymap-internal))
(put f 'funarg-positions '(1)))
(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
defalias fset global-set-key run-after-idle-timeout

18
lisp/emacs-lisp/memory-report.el
View file

@ -182,7 +182,7 @@ by counted more than once."
(cl-defmethod memory-report--object-size-1 (_ (value symbol))
;; Don't count global symbols -- makes sizes of lists of symbols too
;; heavey.
;; heavy.
(if (intern-soft value obarray)
0
(memory-report--size 'symbol)))
@ -214,14 +214,14 @@ by counted more than once."
(setf (gethash value counted) t)
(when (car value)
(cl-incf total (memory-report--object-size counted (car value))))
(if (cdr value)
(if (consp (cdr value))
(if (gethash (cdr value) counted)
(setq value nil)
(setq value (cdr value)))
(cl-incf total (memory-report--object-size counted (cdr value)))
(setq value nil))
(setq value nil)))
(let ((next (cdr value)))
(setq value (when next
(if (consp next)
(unless (gethash next counted)
(cdr value))
(cl-incf total (memory-report--object-size
counted next))
nil)))))
total))
(cl-defmethod memory-report--object-size-1 (counted (value vector))

34
lisp/emacs-lisp/smie.el
View file

@ -57,7 +57,7 @@
;;
;; SMIE: Weakness is Power! Auto-indentation with incomplete information
;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
;; doi: 10.22152/programming-journal.org/2020/5/1
;; doi: 10.22152/programming-journal.org/2021/5/1
;; A good background to understand the development (especially the parts
;; building the 2D precedence tables and then computing the precedence levels
@ -68,7 +68,7 @@
;; OTOH we had to kill many chickens, read many coffee grounds, and practice
;; untold numbers of black magic spells, to come up with the indentation code.
;; Since then, some of that code has been beaten into submission, but the
;; smie-indent-keyword is still pretty obscure.
;; `smie-indent-keyword' function is still pretty obscure.
;; Conflict resolution:
@ -247,7 +247,7 @@ be either:
;; (exp (exp (or "+" "*" "=" ..) exp)).
;; Basically, make it EBNF (except for the specification of a separator in
;; the repetition, maybe).
(let* ((nts (mapcar 'car bnf)) ;Non-terminals.
(let* ((nts (mapcar #'car bnf)) ;Non-terminals.
(first-ops-table ())
(last-ops-table ())
(first-nts-table ())
@ -266,7 +266,7 @@ be either:
(push resolver precs))
(t (error "Unknown resolver %S" resolver))))
(apply #'smie-merge-prec2s over
(mapcar 'smie-precs->prec2 precs))))
(mapcar #'smie-precs->prec2 precs))))
again)
(dolist (rules bnf)
(let ((nt (car rules))
@ -497,7 +497,7 @@ CSTS is a list of pairs representing arcs in a graph."
res))
cycle)))
(mapconcat
(lambda (elems) (mapconcat 'identity elems "="))
(lambda (elems) (mapconcat #'identity elems "="))
(append names (list (car names)))
" < ")))
@ -567,7 +567,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
;; Then eliminate trivial constraints iteratively.
(let ((i 0))
(while csts
(let ((rhvs (mapcar 'cdr csts))
(let ((rhvs (mapcar #'cdr csts))
(progress nil))
(dolist (cst csts)
(unless (memq (car cst) rhvs)
@ -657,8 +657,8 @@ use syntax-tables to handle them in efficient C code.")
Same calling convention as `smie-forward-token-function' except
it should move backward to the beginning of the previous token.")
(defalias 'smie-op-left 'car)
(defalias 'smie-op-right 'cadr)
(defalias 'smie-op-left #'car)
(defalias 'smie-op-right #'cadr)
(defun smie-default-backward-token ()
(forward-comment (- (point)))
@ -974,8 +974,7 @@ I.e. a good choice can be:
(defcustom smie-blink-matching-inners t
"Whether SMIE should blink to matching opener for inner keywords.
If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
:type 'boolean
:group 'smie)
:type 'boolean)
(defun smie-blink-matching-check (start end)
(save-excursion
@ -1141,8 +1140,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
(defcustom smie-indent-basic 4
"Basic amount of indentation."
:type 'integer
:group 'smie)
:type 'integer)
(defvar smie-rules-function #'ignore
"Function providing the indentation rules.
@ -1189,7 +1187,7 @@ designed specifically for use in this function.")
(and ;; (looking-at comment-start-skip) ;(bug#16041).
(forward-comment (point-max))))))
(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p)
(defalias 'smie-rule-hanging-p #'smie-indent--hanging-p)
(defun smie-indent--hanging-p ()
"Return non-nil if the current token is \"hanging\".
A hanging keyword is one that's at the end of a line except it's not at
@ -1205,7 +1203,7 @@ the beginning of a line."
(funcall smie--hanging-eolp-function)
(point))))))
(defalias 'smie-rule-bolp 'smie-indent--bolp)
(defalias 'smie-rule-bolp #'smie-indent--bolp)
(defun smie-indent--bolp ()
"Return non-nil if the current token is the first on the line."
(save-excursion (skip-chars-backward " \t") (bolp)))
@ -1421,7 +1419,7 @@ BASE-POS is the position relative to which offsets should be applied."
(forward-sexp 1)
nil)
((eobp) nil)
(t (error "Bumped into unknown token")))))
(t (error "Bumped into unknown token: %S" tok)))))
(defun smie-indent-backward-token ()
"Skip token backward and return it, along with its levels."
@ -1810,9 +1808,11 @@ Each function is called with no argument, shouldn't move point, and should
return either nil if it has no opinion, or an integer representing the column
to which that point should be aligned, if we were to reindent it.")
(defalias 'smie--funcall #'funcall) ;Debugging/tracing convenience indirection.
(defun smie-indent-calculate ()
"Compute the indentation to use for point."
(run-hook-with-args-until-success 'smie-indent-functions))
(run-hook-wrapped 'smie-indent-functions #'smie--funcall))
(defun smie-indent-line ()
"Indent current line using the SMIE indentation engine."
@ -2016,7 +2016,7 @@ value with which to replace it."
;; FIXME improve value-type.
:type '(choice (const nil)
(alist :key-type symbol))
:initialize 'custom-initialize-set
:initialize #'custom-initialize-set
:set #'smie-config--setter)
(defun smie-config-local (rules)

19
lisp/emacs-lisp/tabulated-list.el
View file

@ -410,8 +410,7 @@ specified by `tabulated-list-sort-key'. It then erases the
buffer and inserts the entries with `tabulated-list-printer'.
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line and
recenter window line accordingly.
to the entry with the same ID element as the current line.
Non-nil UPDATE argument means to use an alternative printing
method which is faster if most entries haven't changed since the
@ -424,18 +423,10 @@ changing `tabulated-list-sort-key'."
(funcall tabulated-list-entries)
tabulated-list-entries))
(sorter (tabulated-list--get-sorter))
entry-id saved-pt saved-col window-line)
entry-id saved-pt saved-col)
(and remember-pos
(setq entry-id (tabulated-list-get-id))
(setq saved-col (current-column))
(when (eq (window-buffer) (current-buffer))
(setq window-line
(save-excursion
(save-restriction
(widen)
(narrow-to-region (window-start) (point))
(goto-char (point-min))
(vertical-motion (buffer-size)))))))
(setq saved-col (current-column)))
;; Sort the entries, if necessary.
(when sorter
(setq entries (sort entries sorter)))
@ -490,9 +481,7 @@ changing `tabulated-list-sort-key'."
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
(progn (goto-char saved-pt)
(move-to-column saved-col)
(when window-line
(recenter window-line)))
(move-to-column saved-col))
(goto-char (point-min)))))
(defun tabulated-list-print-entry (id cols)

4
lisp/epa-file.el
View file

@ -198,7 +198,9 @@ encryption is used."
(mapcar #'car (epg-context-result-for
context 'encrypted-to)))
(if (or beg end)
(setq string (substring string (or beg 0) end)))
(setq string (substring string
(or beg 0)
(and end (min end (length string))))))
(save-excursion
;; If visiting, bind off buffer-file-name so that
;; file-locking will not ask whether we should

2
lisp/epa-mail.el
View file

@ -59,7 +59,7 @@ Otherwise, signal an error."
;;;###autoload
(define-minor-mode epa-mail-mode
"A minor-mode for composing encrypted/clearsigned mails."
nil " epa-mail" epa-mail-mode-map)
:lighter " epa-mail")
;;; Utilities

24
lisp/erc/erc-dcc.el
View file

@ -415,33 +415,33 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcase (intern (downcase (pcomplete-arg 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
(cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type) 'CHAT))
(lambda (elt)
(eq (plist-get elt :type) 'CHAT))
erc-dcc-list)))
('close (delete-dups
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
erc-dcc-list)))
('get (mapcar #'erc-dcc-nick
(cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type) 'GET))
(lambda (elt)
(eq (plist-get elt :type) 'GET))
erc-dcc-list)))
('send (pcomplete-erc-all-nicks))))
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 2)))
('get (mapcar (lambda (elt) (plist-get elt :file))
(cl-remove-if-not
#'(lambda (elt)
(and (eq (plist-get elt :type) 'GET)
(erc-nick-equal-p (erc-extract-nick
(plist-get elt :nick))
(pcomplete-arg 1))))
(lambda (elt)
(and (eq (plist-get elt :type) 'GET)
(erc-nick-equal-p (erc-extract-nick
(plist-get elt :nick))
(pcomplete-arg 1))))
erc-dcc-list)))
('close (mapcar #'erc-dcc-nick
(cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type)
(intern (upcase (pcomplete-arg 1)))))
(lambda (elt)
(eq (plist-get elt :type)
(intern (upcase (pcomplete-arg 1)))))
erc-dcc-list)))
('send (pcomplete-entries)))))

1
lisp/erc/erc-fill.el
View file

@ -46,7 +46,6 @@ the mode if ARG is omitted or nil.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
nil nil nil
:global t
(if erc-fill-mode
(erc-fill-enable)

9
lisp/erc/erc-track.el
View file

@ -464,9 +464,6 @@ ERC Track minor mode is a global minor mode. It exists for the
sole purpose of providing the C-c C-SPC and C-c C-@ keybindings.
Make sure that you have enabled the track module, otherwise the
keybindings will not do anything useful."
:init-value nil
:lighter ""
:keymap erc-track-minor-mode-map
:global t)
(defun erc-track-minor-mode-maybe (&optional buffer)
@ -686,9 +683,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
(let* ((buffers (mapcar #'car erc-modified-channels-alist))
(counts (mapcar #'cadr erc-modified-channels-alist))
(faces (mapcar #'cddr erc-modified-channels-alist))
(long-names (mapcar #'(lambda (buf)
(or (buffer-name buf)
""))
(long-names (mapcar (lambda (buf)
(or (buffer-name buf)
""))
buffers))
(short-names (if (functionp erc-track-shorten-function)
(funcall erc-track-shorten-function

27
lisp/erc/erc.el
View file

@ -1289,7 +1289,6 @@ With a prefix argument ARG, enable %s if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
%s" name name doc)
nil nil nil
;; FIXME: We don't know if this group exists, so this `:group' may
;; actually just silence a valid warning about the fact that the var
;; is not associated with any group.
@ -2321,7 +2320,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(use-local-map (make-sparse-keymap))
(local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
(add-hook 'kill-buffer-hook
#'(lambda () (setq erc-debug-irc-protocol nil))
(lambda () (setq erc-debug-irc-protocol nil))
nil 'local)
(goto-char (point-max))
(let ((inhibit-read-only t))
@ -2945,9 +2944,9 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(if (null (erc-with-server-buffer erc-ignore-list))
(erc-display-line (erc-make-notice "Ignore list is empty") 'active)
(erc-display-line (erc-make-notice "Ignore list:") 'active)
(mapc #'(lambda (item)
(erc-display-line (erc-make-notice item)
'active))
(mapc (lambda (item)
(erc-display-line (erc-make-notice item)
'active))
(erc-with-server-buffer erc-ignore-list))))
t)
@ -3129,8 +3128,8 @@ were most recently invited. See also `invitation'."
(when chnl
;; Prevent double joining of same channel on same server.
(let* ((joined-channels
(mapcar #'(lambda (chanbuf)
(with-current-buffer chanbuf (erc-default-target)))
(mapcar (lambda (chanbuf)
(with-current-buffer chanbuf (erc-default-target)))
(erc-channel-list erc-server-process)))
(server (with-current-buffer (process-buffer erc-server-process)
(or erc-session-server erc-server-announced-name)))
@ -4149,9 +4148,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
(mapconcat
#'identity
(let (res)
(mapc #'(lambda (x)
(if (stringp x)
(setq res (append res (list x)))))
(mapc (lambda (x)
(if (stringp x)
(setq res (append res (list x)))))
parsed)
res)
" ")))
@ -4539,10 +4538,10 @@ See also: `erc-echo-notice-in-user-buffers',
;; Remove the unbanned masks from the ban list
(setq erc-channel-banlist
(cl-delete-if
#'(lambda (y)
(member (upcase (cdr y))
(mapcar #'upcase
(cdr (split-string mode)))))
(lambda (y)
(member (upcase (cdr y))
(mapcar #'upcase
(cdr (split-string mode)))))
erc-channel-banlist)))
((string-match "^\\+" mode)
;; Add the banned mask(s) to the ban list

38
lisp/eshell/esh-proc.el
View file

@ -37,23 +37,19 @@ finish."
(defcustom eshell-proc-load-hook nil
"A hook that gets run when `eshell-proc' is loaded."
:version "24.1" ; removed eshell-proc-initialize
:type 'hook
:group 'eshell-proc)
:type 'hook)
(defcustom eshell-process-wait-seconds 0
"The number of seconds to delay waiting for a synchronous process."
:type 'integer
:group 'eshell-proc)
:type 'integer)
(defcustom eshell-process-wait-milliseconds 50
"The number of milliseconds to delay waiting for a synchronous process."
:type 'integer
:group 'eshell-proc)
:type 'integer)
(defcustom eshell-done-messages-in-minibuffer t
"If non-nil, subjob \"Done\" messages will display in minibuffer."
:type 'boolean
:group 'eshell-proc)
:type 'boolean)
(defcustom eshell-delete-exited-processes t
"If nil, process entries will stick around until `jobs' is run.
@ -72,14 +68,12 @@ subjob is done is that it will no longer appear in the
Note that Eshell will have to be restarted for a change in this
variable's value to take effect."
:type 'boolean
:group 'eshell-proc)
:type 'boolean)
(defcustom eshell-reset-signals
"^\\(interrupt\\|killed\\|quit\\|stopped\\)"
"If a termination signal matches this regexp, the terminal will be reset."
:type 'regexp
:group 'eshell-proc)
:type 'regexp)
(defcustom eshell-exec-hook nil
"Called each time a process is exec'd by `eshell-gather-process-output'.
@ -88,8 +82,7 @@ It is useful for things that must be done each time a process is
executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag').
In contrast, `eshell-mode-hook' is only executed once, when the buffer
is created."
:type 'hook
:group 'eshell-proc)
:type 'hook)
(defcustom eshell-kill-hook nil
"Called when a process run by `eshell-gather-process-output' has ended.
@ -99,8 +92,7 @@ nil, in which case the user attempted to send a signal, but there was
no relevant process. This can be used for displaying help
information, for example."
:version "24.1" ; removed eshell-reset-after-proc
:type 'hook
:group 'eshell-proc)
:type 'hook)
;;; Internal Variables:
@ -126,8 +118,7 @@ information, for example."
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter."
;; Was there till 24.1, but it is not optional.
(if (memq #'eshell-reset-after-proc eshell-kill-hook)
(setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook)))
(remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
(eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
@ -165,7 +156,7 @@ The signals which will cause this to happen are matched by
eshell-process-wait-milliseconds))))
(setq procs (cdr procs))))
(defalias 'eshell/wait 'eshell-wait-for-process)
(defalias 'eshell/wait #'eshell-wait-for-process)
(defun eshell/jobs (&rest _args)
"List processes, if there are any."
@ -457,8 +448,7 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC."
(defcustom eshell-kill-process-wait-time 5
"Seconds to wait between sending termination signals to a subprocess."
:type 'integer
:group 'eshell-proc)
:type 'integer)
(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
"Signals used to kill processes when an Eshell buffer exits.
@ -466,8 +456,7 @@ Eshell calls each of these signals in order when an Eshell buffer is
killed; if the process is still alive afterwards, Eshell waits a
number of seconds defined by `eshell-kill-process-wait-time', and
tries the next signal in the list."
:type '(repeat symbol)
:group 'eshell-proc)
:type '(repeat symbol))
(defcustom eshell-kill-processes-on-exit nil
"If non-nil, kill active processes when exiting an Eshell buffer.
@ -489,8 +478,7 @@ long to delay between signals."
:type '(choice (const :tag "Kill all, don't ask" t)
(const :tag "Ask before killing" ask)
(const :tag "Ask for each process" every)
(const :tag "Don't kill subprocesses" nil))
:group 'eshell-proc)
(const :tag "Don't kill subprocesses" nil)))
(defun eshell-round-robin-kill (&optional query)
"Kill current process by trying various signals in sequence.

164
lisp/eshell/esh-util.el
View file

@ -23,6 +23,7 @@
;;; Code:
(require 'seq)
(eval-when-compile (require 'cl-lib))
(defgroup eshell-util nil
@ -37,25 +38,21 @@
If nil, t will be represented only in the exit code of the function,
and not printed as a string. This causes Lisp functions to behave
similarly to external commands, as far as successful result output."
:type 'boolean
:group 'eshell-util)
:type 'boolean)
(defcustom eshell-group-file "/etc/group"
"If non-nil, the name of the group file on your system."
:type '(choice (const :tag "No group file" nil) file)
:group 'eshell-util)
:type '(choice (const :tag "No group file" nil) file))
(defcustom eshell-passwd-file "/etc/passwd"
"If non-nil, the name of the passwd file on your system."
:type '(choice (const :tag "No passwd file" nil) file)
:group 'eshell-util)
:type '(choice (const :tag "No passwd file" nil) file))
(defcustom eshell-hosts-file "/etc/hosts"
"The name of the /etc/hosts file.
Use `pcomplete-hosts-file' instead; this variable is obsolete and
has no effect."
:type '(choice (const :tag "No hosts file" nil) file)
:group 'eshell-util)
:type '(choice (const :tag "No hosts file" nil) file))
;; Don't make it into an alias, because it doesn't really work with
;; custom and risks creating duplicate entries. Just point users to
;; the other variable, which is less frustrating.
@ -64,25 +61,21 @@ has no effect."
(defcustom eshell-handle-errors t
"If non-nil, Eshell will handle errors itself.
Setting this to nil is offered as an aid to debugging only."
:type 'boolean
:group 'eshell-util)
:type 'boolean)
(defcustom eshell-private-file-modes 384 ; umask 177
"The file-modes value to use for creating \"private\" files."
:type 'integer
:group 'eshell-util)
:type 'integer)
(defcustom eshell-private-directory-modes 448 ; umask 077
"The file-modes value to use for creating \"private\" directories."
:type 'integer
:group 'eshell-util)
:type 'integer)
(defcustom eshell-tar-regexp
"\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
"Regular expression used to match tar file names."
:version "24.1" ; added xz
:type 'regexp
:group 'eshell-util)
:type 'regexp)
(defcustom eshell-convert-numeric-arguments t
"If non-nil, converting arguments of numeric form to Lisp numbers.
@ -99,16 +92,14 @@ following in your init file:
Any function with the property `eshell-no-numeric-conversions' set to
a non-nil value, will be passed strings, not numbers, even when an
argument matches `eshell-number-regexp'."
:type 'boolean
:group 'eshell-util)
:type 'boolean)
(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?"
"Regular expression used to match numeric arguments.
If `eshell-convert-numeric-arguments' is non-nil, and an argument
matches this regexp, it will be converted to a Lisp number, using the
function `string-to-number'."
:type 'regexp
:group 'eshell-util)
:type 'regexp)
(defcustom eshell-ange-ls-uids nil
"List of user/host/id strings, used to determine remote ownership."
@ -116,8 +107,7 @@ function `string-to-number'."
(string :tag "Hostname")
(repeat (cons :tag "User/UID List"
(string :tag "Username")
(repeat :tag "UIDs" string)))))
:group 'eshell-util)
(repeat :tag "UIDs" string))))))
;;; Internal Variables:
@ -308,11 +298,11 @@ Prepend remote identification of `default-directory', if any."
(defsubst eshell-stringify-list (args)
"Convert each element of ARGS into a string value."
(mapcar 'eshell-stringify args))
(mapcar #'eshell-stringify args))
(defsubst eshell-flatten-and-stringify (&rest args)
"Flatten and stringify all of the ARGS into a single string."
(mapconcat 'eshell-stringify (flatten-tree args) " "))
(mapconcat #'eshell-stringify (flatten-tree args) " "))
(defsubst eshell-directory-files (regexp &optional directory)
"Return a list of files in the given DIRECTORY matching REGEXP."
@ -471,7 +461,7 @@ list."
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
(mapcar 'concat process-environment))
(mapcar #'concat process-environment))
(defun eshell-subgroups (groupsym)
"Return all of the subgroups of GROUPSYM."
@ -619,70 +609,68 @@ gid format. Valid values are `string' and `integer', defaulting to
"If the `processp' function does not exist, PROC is not a process."
(and (fboundp 'processp) (processp proc)))
; (defun eshell-copy-file
; (file newname &optional ok-if-already-exists keep-date)
; "Copy FILE to NEWNAME. See docs for `copy-file'."
; (let (copied)
; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
; (let ((front (match-string 1 file))
; (back (match-string 2 file))
; buffer)
; (if (and front (string-match eshell-tar-regexp front)
; (setq buffer (find-file-noselect front)))
; (with-current-buffer buffer
; (goto-char (point-min))
; (if (re-search-forward (concat " " (regexp-quote back)
; "$") nil t)
; (progn
; (tar-copy (if (file-directory-p newname)
; (expand-file-name
; (file-name-nondirectory back) newname)
; newname))
; (setq copied t))
; (error "%s not found in tar file %s" back front))))))
; (unless copied
; (copy-file file newname ok-if-already-exists keep-date))))
;; (defun eshell-copy-file
;; (file newname &optional ok-if-already-exists keep-date)
;; "Copy FILE to NEWNAME. See docs for `copy-file'."
;; (let (copied)
;; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
;; (let ((front (match-string 1 file))
;; (back (match-string 2 file))
;; buffer)
;; (if (and front (string-match eshell-tar-regexp front)
;; (setq buffer (find-file-noselect front)))
;; (with-current-buffer buffer
;; (goto-char (point-min))
;; (if (re-search-forward (concat " " (regexp-quote back)
;; "$") nil t)
;; (progn
;; (tar-copy (if (file-directory-p newname)
;; (expand-file-name
;; (file-name-nondirectory back) newname)
;; newname))
;; (setq copied t))
;; (error "%s not found in tar file %s" back front))))))
;; (unless copied
;; (copy-file file newname ok-if-already-exists keep-date))))
; (defun eshell-file-attributes (filename)
; "Return a list of attributes of file FILENAME.
; See the documentation for `file-attributes'."
; (let (result)
; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
; (let ((front (match-string 1 filename))
; (back (match-string 2 filename))
; buffer)
; (when (and front (string-match eshell-tar-regexp front)
; (setq buffer (find-file-noselect front)))
; (with-current-buffer buffer
; (goto-char (point-min))
; (when (re-search-forward (concat " " (regexp-quote back)
; "\\s-*$") nil t)
; (let* ((descrip (tar-current-descriptor))
; (tokens (tar-desc-tokens descrip)))
; (setq result
; (list
; (cond
; ((eq (tar-header-link-type tokens) 5)
; t)
; ((eq (tar-header-link-type tokens) t)
; (tar-header-link-name tokens)))
; 1
; (tar-header-uid tokens)
; (tar-header-gid tokens)
; (tar-header-date tokens)
; (tar-header-date tokens)
; (tar-header-date tokens)
; (tar-header-size tokens)
; (concat
; (cond
; ((eq (tar-header-link-type tokens) 5) "d")
; ((eq (tar-header-link-type tokens) t) "l")
; (t "-"))
; (tar-grind-file-mode (tar-header-mode tokens)
; (make-string 9 ? ) 0))
; nil nil nil))))))))
; (or result
; (file-attributes filename))))
;; (defun eshell-file-attributes (filename)
;; "Return a list of attributes of file FILENAME.
;; See the documentation for `file-attributes'."
;; (let (result)
;; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
;; (let ((front (match-string 1 filename))
;; (back (match-string 2 filename))
;; buffer)
;; (when (and front (string-match eshell-tar-regexp front)
;; (setq buffer (find-file-noselect front)))
;; (with-current-buffer buffer
;; (goto-char (point-min))
;; (when (re-search-forward (concat " " (regexp-quote back)
;; "\\s-*$") nil t)
;; (let* ((descrip (tar-current-descriptor))
;; (tokens (tar-desc-tokens descrip)))
;; (setq result
;; (list
;; (cond
;; ((eq (tar-header-link-type tokens) 5)
;; t)
;; ((eq (tar-header-link-type tokens) t)
;; (tar-header-link-name tokens)))
;; 1
;; (tar-header-uid tokens)
;; (tar-header-gid tokens)
;; (tar-header-date tokens)
;; (tar-header-date tokens)
;; (tar-header-date tokens)
;; (tar-header-size tokens)
;; (file-modes-number-to-symbolic
;; (logior (tar-header-mode tokens)
;; (cond
;; ((eq (tar-header-link-type tokens) 5) 16384)
;; ((eq (tar-header-link-type tokens) t) 32768))))
;; nil nil nil))))))))
;; (or result
;; (file-attributes filename))))
;; Obsolete.

1
lisp/facemenu.el
View file

@ -539,6 +539,7 @@ filter out the color from the output."
This is installed as a `revert-buffer-function' in the *Colors* buffer."
(list-colors-display nil (buffer-name) list-colors-callback))
;;;###autoload
(defun list-colors-display (&optional list buffer-name callback)
"Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of

4
lisp/files-x.el
View file

@ -1,4 +1,4 @@
;;; files-x.el --- extended file handling commands
;;; files-x.el --- extended file handling commands -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).")
"Normalize plist CRITERIA according to properties.
Return a reordered plist."
(apply
'append
#'append
(mapcar
(lambda (property)
(when (and (plist-member criteria property) (plist-get criteria property))

28
lisp/files.el
View file

@ -7638,6 +7638,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
;; FIXME: These divisions/shifts seem to be right
;; for the `7' part of the #o4700 mask, but not
;; for the `4' part. Same below for `g' and `o'.
(+ uright (/ uright #o10) (/ uright #o100))))
((= char ?g) (let ((gright (logand #o2070 from)))
(+ gright (/ gright #o10) (* gright #o10))))
@ -7672,11 +7675,28 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
(defun file-modes-number-to-symbolic (mode)
(defun file-modes-number-to-symbolic (mode &optional filetype)
"Return a string describing a a file's MODE.
For instance, if MODE is #o700, then it produces `-rwx------'.
FILETYPE if provided should be a character denoting the type of file,
such as `?d' for a directory, or `?l' for a symbolic link and will override
the leading `-' char."
(string
(if (zerop (logand 8192 mode))
(if (zerop (logand 16384 mode)) ?- ?d)
?c) ; completeness
(or filetype
(pcase (lsh mode -12)
;; POSIX specifies that the file type is included in st_mode
;; and provides names for the file types but values only for
;; the permissions (e.g., S_IWOTH=2).
;; (#o017 ??) ;; #define S_IFMT 00170000
(#o014 ?s) ;; #define S_IFSOCK 0140000
(#o012 ?l) ;; #define S_IFLNK 0120000
;; (8 ??) ;; #define S_IFREG 0100000
(#o006 ?b) ;; #define S_IFBLK 0060000
(#o004 ?d) ;; #define S_IFDIR 0040000
(#o002 ?c) ;; #define S_IFCHR 0020000
(#o001 ?p) ;; #define S_IFIFO 0010000
(_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))

300
lisp/find-file.el
View file

@ -1,4 +1,4 @@
;;; find-file.el --- find a file corresponding to this one given a pattern
;;; find-file.el --- find a file corresponding to this one given a pattern -*- lexical-binding: t; -*-
;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au>
;; Maintainer: emacs-devel@gnu.org
@ -39,8 +39,8 @@
;; and just has a different extension as described by the ff-other-file-alist
;; variable:
;;
;; '(("\\.cc$" (".hh" ".h"))
;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp")))
;; '(("\\.cc\\'" (".hh" ".h"))
;; ("\\.hh\\'" (".cc" ".C" ".CC" ".cxx" ".cpp")))
;;
;; If the current file has a .cc extension, ff-find-other-file will attempt
;; to look for a .hh file, and then a .h file in some directory as described
@ -55,8 +55,8 @@
;; format above can be changed to include a function to be called when the
;; current file matches the regexp:
;;
;; '(("\\.cc$" cc--function)
;; ("\\.hh$" hh-function))
;; '(("\\.cc\\'" cc--function)
;; ("\\.hh\\'" hh-function))
;;
;; These functions must return a list consisting of the possible names of the
;; corresponding file, with or without path. There is no real need for more
@ -64,10 +64,10 @@
;; file-alist:
;;
;; (setq cc-other-file-alist
;; '(("\\.cc$" ff-cc-hh-converter)
;; ("\\.hh$" ff-cc-hh-converter)
;; ("\\.c$" (".h"))
;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
;; '(("\\.cc\\'" ff-cc-hh-converter)
;; ("\\.hh\\'" ff-cc-hh-converter)
;; ("\\.c\\'" (".h"))
;; ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
;;
;; ff-cc-hh-converter is included at the end of this file as a reference.
;;
@ -130,62 +130,51 @@
(defcustom ff-pre-find-hook nil
"List of functions to be called before the search for the file starts."
:type 'hook
:group 'ff)
:type 'hook)
(defcustom ff-pre-load-hook nil
"List of functions to be called before the other file is loaded."
:type 'hook
:group 'ff)
:type 'hook)
(defcustom ff-post-load-hook nil
"List of functions to be called after the other file is loaded."
:type 'hook
:group 'ff)
:type 'hook)
(defcustom ff-not-found-hook nil
"List of functions to be called if the other file could not be found."
:type 'hook
:group 'ff)
:type 'hook)
(defcustom ff-file-created-hook nil
"List of functions to be called if the other file needs to be created."
:type 'hook
:group 'ff)
:type 'hook)
(defcustom ff-case-fold-search nil
"Non-nil means ignore cases in matches (see `case-fold-search').
If you have extensions in different cases, you will want this to be nil."
:type 'boolean
:group 'ff)
:type 'boolean)
(defcustom ff-always-in-other-window nil
"If non-nil, find the corresponding file in another window by default.
To override this, give an argument to `ff-find-other-file'."
:type 'boolean
:group 'ff)
:type 'boolean)
(defcustom ff-ignore-include nil
"If non-nil, ignore `#include' lines."
:type 'boolean
:group 'ff)
:type 'boolean)
(defcustom ff-always-try-to-create t
"If non-nil, always attempt to create the other file if it was not found."
:type 'boolean
:group 'ff)
:type 'boolean)
(defcustom ff-quiet-mode nil
"If non-nil, trace which directories are being searched."
:type 'boolean
:group 'ff)
:type 'boolean)
;;;###autoload
(defcustom ff-special-constructs
;; C/C++ include, for NeXTstep too
`((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
(lambda ()
(buffer-substring (match-beginning 2) (match-end 2)))))
,(lambda () (match-string 2))))
;; We include `ff-treat-as-special' documentation here so that autoload
;; can make it available to be read prior to loading this file.
"List of special constructs recognized by `ff-treat-as-special'.
@ -194,8 +183,7 @@ If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
filename that EXTRACT returned."
:type '(repeat (cons regexp function))
:group 'ff)
:type '(repeat (cons regexp function)))
(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
(defcustom ff-other-file-alist 'cc-other-file-alist
@ -207,8 +195,7 @@ directory specified in `ff-search-directories'. If a file is not found,
a new one is created with the first matching extension (`.cc' yields `.hh').
This alist should be set by the major mode."
:type '(choice (repeat (list regexp (choice (repeat string) function)))
symbol)
:group 'ff)
symbol))
(defcustom ff-search-directories 'cc-search-directories
"List of directories to search for a specific file.
@ -231,14 +218,12 @@ not exist, it is replaced (silently) with an empty string.
The stars are *not* wildcards: they are searched for together with
the preceding slash. The star represents all the subdirectories except
`..', and each of these subdirectories will be searched in turn."
:type '(choice (repeat directory) symbol)
:group 'ff)
:type '(choice (repeat directory) symbol))
(defcustom cc-search-directories
'("." "/usr/include" "/usr/local/include/*")
"See the description of the `ff-search-directories' variable."
:type '(repeat directory)
:group 'ff)
:type '(repeat directory))
(defcustom cc-other-file-alist
'(("\\.cc\\'" (".hh" ".h"))
@ -269,17 +254,15 @@ since the search algorithm searches sequentially through each directory
specified in `ff-search-directories'. If a file is not found, a new one
is created with the first matching extension (`.cc' yields `.hh')."
:version "24.4" ; add .m
:type '(repeat (list regexp (choice (repeat string) function)))
:group 'ff)
:type '(repeat (list regexp (choice (repeat string) function))))
(defcustom modula2-other-file-alist
'(
("\\.mi$" (".md")) ;; Modula-2 module definition
("\\.md$" (".mi")) ;; and implementation.
("\\.mi\\'" (".md")) ;; Modula-2 module definition
("\\.md\\'" (".mi")) ;; and implementation.
)
"See the description for the `ff-search-directories' variable."
:type '(repeat (list regexp (choice (repeat string) function)))
:group 'ff)
:type '(repeat (list regexp (choice (repeat string) function))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -308,16 +291,14 @@ See also the documentation for `ff-find-other-file'.
If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(interactive "P")
(let ((ignore ff-ignore-include))
(setq ff-ignore-include t)
(ff-find-the-other-file in-other-window)
(setq ff-ignore-include ignore)))
(let ((ff-ignore-include t))
(ff-find-the-other-file in-other-window)))
;;;###autoload
(defalias 'ff-find-related-file 'ff-find-other-file)
(defalias 'ff-find-related-file #'ff-find-other-file)
;;;###autoload
(defun ff-find-other-file (&optional in-other-window ignore-include)
(defun ff-find-other-file (&optional in-other-window ignore-include event)
"Find the header or source file corresponding to this file.
Being on a `#include' line pulls in that file.
@ -369,11 +350,11 @@ Variables of interest include:
- `ff-file-created-hook'
List of functions to be called if the other file has been created."
(interactive "P")
(let ((ignore ff-ignore-include))
(setq ff-ignore-include ignore-include)
(ff-find-the-other-file in-other-window)
(setq ff-ignore-include ignore)))
(interactive (list current-prefix-arg nil last-nonmenu-event))
(save-excursion
(posn-set-point (event-end event))
(let ((ff-ignore-include ignore-include))
(ff-find-the-other-file in-other-window))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support functions
@ -413,9 +394,9 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(message "Working...")
(setq dirs
(if (symbolp ff-search-directories)
(ff-list-replace-env-vars (symbol-value ff-search-directories))
(ff-list-replace-env-vars ff-search-directories)))
(ff-list-replace-env-vars (if (symbolp ff-search-directories)
(symbol-value ff-search-directories)
ff-search-directories)))
(setq fname (ff-treat-as-special))
@ -454,11 +435,10 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
;; if we have a function to generate new names,
;; invoke it with the name of the current file
(if (and (atom action) (fboundp action))
(progn
(setq suffixes (funcall action (ff-buffer-file-name))
match (cons (car match) (list suffixes))
stub nil
default-name (car suffixes)))
(setq suffixes (funcall action (ff-buffer-file-name))
match (cons (car match) (list suffixes))
stub nil
default-name (car suffixes))
;; otherwise build our filename stub
(cond
@ -472,7 +452,8 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(t
(setq format (concat "\\(.+\\)" (car match)))
(string-match format fname)
(setq stub (substring fname (match-beginning 1) (match-end 1)))
;; FIXME: What if `string-match' failed?
(setq stub (match-string 1 fname))
))
;; if we find nothing, we should try to get a file like this one
@ -522,89 +503,6 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
found)) ;; return buffer-name or filename
(defun ff-other-file-name ()
"Return name of the header or source file corresponding to the current file.
Being on a `#include' line pulls in that file, but see the help on
the `ff-ignore-include' variable."
(let (match ;; matching regexp for this file
suffixes ;; set of replacing regexps for the matching regexp
action ;; function to generate the names of the other files
fname ;; basename of this file
pos ;; where we start matching filenames
stub ;; name of the file without extension
alist ;; working copy of the list of file extensions
pathname ;; the pathname of the file or the #include line
format ;; what we have to match
found ;; name of the file or buffer found - nil if none
dirs) ;; local value of ff-search-directories
(message "Working...")
(setq dirs
(if (symbolp ff-search-directories)
(ff-list-replace-env-vars (symbol-value ff-search-directories))
(ff-list-replace-env-vars ff-search-directories)))
(setq fname (ff-treat-as-special))
(cond
((and (not ff-ignore-include) fname)
(setq found (ff-get-file-name dirs fname nil)))
;; let's just get the corresponding file
(t
(setq alist (if (symbolp ff-other-file-alist)
(symbol-value ff-other-file-alist)
ff-other-file-alist)
pathname (or (ff-buffer-file-name) "/none.none"))
(setq fname (file-name-nondirectory pathname)
match (car alist))
;; find the table entry corresponding to this file
(setq pos (ff-string-match (car match) fname))
(while (and match (if (and pos (>= pos 0)) nil (not pos)))
(setq alist (cdr alist))
(setq match (car alist))
(setq pos (ff-string-match (car match) fname)))
;; no point going on if we haven't found anything
(when match
;; otherwise, suffixes contains what we need
(setq suffixes (car (cdr match))
action (car (cdr match))
found nil)
;; if we have a function to generate new names,
;; invoke it with the name of the current file
(if (and (atom action) (fboundp action))
(progn
(setq suffixes (funcall action (ff-buffer-file-name))
match (cons (car match) (list suffixes))
stub nil))
;; otherwise build our filename stub
(cond
;; get around the problem that 0 and nil both mean false!
((= pos 0)
(setq format "")
(setq stub "")
)
(t
(setq format (concat "\\(.+\\)" (car match)))
(string-match format fname)
(setq stub (substring fname (match-beginning 1) (match-end 1)))
)))
;; do the real work - find the file
(setq found
(ff-get-file-name dirs stub suffixes)))))
found)) ;; return buffer-name or filename
(defun ff-get-file (search-dirs filename &optional suffix-list other-window)
"Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub).
If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search
@ -709,11 +607,10 @@ name of the first file found."
;; otherwise dir matches the '/*', so search each dir separately
(progn
(if (match-beginning 2)
(setq rest (substring dir (match-beginning 2) (match-end 2)))
(setq rest "")
)
(setq dir (substring dir (match-beginning 1) (match-end 1)))
(setq rest (if (match-beginning 2)
(match-string 2 dir)
""))
(setq dir (match-string 1 dir))
(let ((dirlist (ff-all-dirs-under dir '("..")))
this-dir compl-dirs)
@ -743,8 +640,8 @@ name of the first file found."
(defun ff-string-match (regexp string &optional start)
"Like `string-match', but set `case-fold-search' temporarily.
The value used comes from `ff-case-fold-search'."
(let ((case-fold-search ff-case-fold-search))
(if regexp
(if regexp
(let ((case-fold-search ff-case-fold-search))
(string-match regexp string start))))
(defun ff-list-replace-env-vars (search-list)
@ -752,12 +649,12 @@ The value used comes from `ff-case-fold-search'."
(let (list
(var (car search-list)))
(while search-list
(if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var)
(if (string-match "\\(.*\\)\\$[({]*\\([[:alnum:]_]+\\)[)}]*\\(.*\\)" var)
(setq var
(concat
(substring var (match-beginning 1) (match-end 1))
(getenv (substring var (match-beginning 2) (match-end 2)))
(substring var (match-beginning 3) (match-end 3)))))
(match-string 1 var)
(getenv (match-string 2 var))
(match-string 3 var))))
(setq search-list (cdr search-list))
(setq list (cons var list))
(setq var (car search-list)))
@ -782,11 +679,7 @@ See variable `ff-special-constructs'."
(setq match (cdr elem)))
fname)))
(defun ff-basename (string)
"Return the basename of pathname STRING."
(setq string (concat "/" string))
(string-match ".*/\\([^/]+\\)$" string)
(setq string (substring string (match-beginning 1) (match-end 1))))
(define-obsolete-function-alias 'ff-basename #'file-name-nondirectory "28.1")
(defun ff-all-dirs-under (here &optional exclude)
"Get all the directory files under directory HERE.
@ -800,7 +693,7 @@ Exclude all files in the optional EXCLUDE list."
(setq file (car files))
(if (and
(file-directory-p file)
(not (member (ff-basename file) exclude)))
(not (member (file-name-nondirectory file) exclude)))
(setq dirlist (cons file dirlist)))
(setq files (cdr files)))
(setq dirlist (reverse dirlist))))
@ -820,84 +713,65 @@ or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs.
If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is
called before `ff-post-load-hook'."
(run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks)
(if (or
(and in-other-window (not ff-always-in-other-window))
(and (not in-other-window) ff-always-in-other-window))
(funcall f2 file)
(funcall f1 file))
(funcall (if (or
(and in-other-window (not ff-always-in-other-window))
(and (not in-other-window) ff-always-in-other-window))
f2 f1)
file)
(if new-file
(run-hooks 'ff-file-created-hook 'ff-file-created-hooks))
(run-hooks 'ff-post-load-hook 'ff-post-load-hooks))
(defun ff-find-file (file &optional in-other-window new-file)
"Like `find-file', but may show the file in another window."
(ff-switch-file 'find-file
'find-file-other-window
(ff-switch-file #'find-file
#'find-file-other-window
file in-other-window new-file))
(defun ff-switch-to-buffer (buffer-or-name &optional in-other-window)
"Like `switch-to-buffer', but may show the buffer in another window."
(ff-switch-file 'switch-to-buffer
'switch-to-buffer-other-window
(ff-switch-file #'switch-to-buffer
#'switch-to-buffer-other-window
buffer-or-name in-other-window nil))
;;;###autoload
(defun ff-mouse-find-other-file (event)
"Visit the file you click on."
(interactive "e")
(save-excursion
(mouse-set-point event)
(ff-find-other-file nil)))
(define-obsolete-function-alias
'ff-mouse-find-other-file #'ff-find-other-file "28.1")
;;;###autoload
(defun ff-mouse-find-other-file-other-window (event)
"Visit the file you click on in another window."
(interactive "e")
(save-excursion
(mouse-set-point event)
(ff-find-other-file t)))
(define-obsolete-function-alias
'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1")
;;;###autoload
(defun ff-find-other-file-other-window (event)
"Visit the file you point at in another window."
(interactive (list last-nonmenu-event))
(ff-find-other-file t nil event))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This section offers an example of user defined function to select files
(defun ff-upcase-p (string &optional start end)
"Return t if STRING is all uppercase.
Given START and/or END, checks between these characters."
(let (match str)
(if (not start)
(setq start 0))
(if (not end)
(setq end (length string)))
(if (= start end)
(setq end (1+ end)))
(setq str (substring string start end))
(if (and
(ff-string-match "[A-Z]+" str)
(setq match (match-data))
(= (car match) 0)
(= (car (cdr match)) (length str)))
t
nil)))
(defun ff-upcase-p (string)
"Return t if STRING is all uppercase."
;; FIXME: Why `ff-string-match' since `[:upper:]' only makes
;; sense when `case-fold-search' is nil?
(ff-string-match "\\`[[:upper:]]*\\'" string))
(defun ff-cc-hh-converter (arg)
"Discriminate file extensions.
Build up a new file list based possibly on part of the directory name
and the name of the file passed in."
(ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg)
(let ((dire (if (match-beginning 2)
(substring arg (match-beginning 2) (match-end 2)) nil))
(file (if (match-beginning 3)
(substring arg (match-beginning 3) (match-end 3)) nil))
(extn (if (match-beginning 4)
(substring arg (match-beginning 4) (match-end 4)) nil))
(let ((dire (match-string 2 arg))
(file (match-string 3 arg))
(extn (match-string 4 arg))
return-list)
(cond
;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h}
((and (string= extn "cc")
(ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file))
(let ((stub (substring file (match-beginning 2) (match-end 2))))
(setq dire (upcase (substring file (match-beginning 1) (match-end 1))))
(ff-string-match "^\\([[:lower:]]+\\)\\([[:upper:]].+\\)$" file))
(let ((stub (match-string 2 file)))
(setq dire (upcase (match-string 1 file)))
(setq return-list (list (concat stub ".hh")
(concat stub ".h")
(concat file ".hh")

52
lisp/foldout.el
View file

@ -1,4 +1,4 @@
;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -*- lexical-binding: t -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@ -33,7 +33,7 @@
;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry)
;; to expose the body or C-c C-i to expose the child (level-2) headings.
;;
;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body
;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the body
;; and child subheadings and narrows the buffer so that only the level-1
;; heading, the body and the level-2 headings are visible. If you now want to
;; look under one of the level-2 headings, position the cursor on it and do C-c
@ -57,7 +57,7 @@
;; zoomed-in heading. This is useful for restricting changes to a particular
;; chapter or section of your document.
;;
;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides
;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides
;; all the text and subheadings under the top-level heading and returns you to
;; the previous view of the buffer. Specifying a numeric argument exits that
;; many folds. Specifying a zero argument exits *all* folds.
@ -216,6 +216,8 @@ An end marker of nil means the fold ends after (point-max).")
(defvar-local foldout-mode-line-string nil
"Mode line string announcing that we are in an outline fold.")
;; FIXME: This should be rewritten as a proper minor mode.
;; put our minor mode string immediately following outline-minor-mode's
(or (assq 'foldout-mode-line-string minor-mode-alist)
(let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist)
@ -227,8 +229,7 @@ An end marker of nil means the fold ends after (point-max).")
(error "Can't find outline-minor-mode in minor-mode-alist"))
;; slip our fold announcement into the list
(setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))
))
(setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))))
@ -275,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg) changes this:-
((> exposure-value 0)
(outline-show-children exposure-value))
(t
(outline-show-subtree))
)
(outline-show-subtree)))
;; save the location of the fold we are entering
(setq foldout-fold-list (cons (cons start-marker end-marker)
foldout-fold-list))
;; update the mode line
(foldout-update-mode-line)
)))
(foldout-update-mode-line))))
(defun foldout-exit-fold (&optional num-folds)
@ -308,8 +307,7 @@ exited and text is left visible."
;; have we been told not to hide the fold?
((< num-folds 0)
(setq hide-fold nil
num-folds (- num-folds)))
)
num-folds (- num-folds))))
;; limit the number of folds if we've been told to exit too many
(setq num-folds (min num-folds (length foldout-fold-list)))
@ -482,8 +480,8 @@ Signal an error if the final event isn't the same type as the first one."
event)
(defun foldout-mouse-goto-heading (event)
"Go to the heading where the mouse event started. Signal an error
if the event didn't occur on a heading."
"Go to the heading where the mouse EVENT started.
Signal an error if the event didn't occur on a heading."
(goto-char (posn-point (event-start event)))
(or (outline-on-heading-p)
;; outline.el sometimes treats beginning-of-buffer as a heading
@ -505,17 +503,16 @@ M-C-down-mouse-{1,2,3}.
Valid modifiers are shift, control, meta, alt, hyper and super.")
(if foldout-inhibit-key-bindings
()
(define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree)
(define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold)
(unless foldout-inhibit-key-bindings
(define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree)
(define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold)
(let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix)))
(unless map
(setq map (make-sparse-keymap))
(define-key outline-minor-mode-map outline-minor-mode-prefix map))
(define-key map "\C-z" 'foldout-zoom-subtree)
(define-key map "\C-x" 'foldout-exit-fold))
(let* ((modifiers (apply 'concat
(define-key map "\C-z" #'foldout-zoom-subtree)
(define-key map "\C-x" #'foldout-exit-fold))
(let* ((modifiers (apply #'concat
(mapcar (lambda (modifier)
(vector
(cond
@ -525,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
((eq modifier 'alt) ?A)
((eq modifier 'hyper) ?H)
((eq modifier 'super) ?s)
(t (error "invalid mouse modifier %s"
(t (error "Invalid mouse modifier %s"
modifier)))
?-))
foldout-mouse-modifiers)))
@ -533,14 +530,13 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
(mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
(mouse-3 (vector (intern (concat modifiers "down-mouse-3")))))
(define-key outline-mode-map mouse-1 'foldout-mouse-zoom)
(define-key outline-mode-map mouse-2 'foldout-mouse-show)
(define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit)
(define-key outline-mode-map mouse-1 #'foldout-mouse-zoom)
(define-key outline-mode-map mouse-2 #'foldout-mouse-show)
(define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit)
(define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom)
(define-key outline-minor-mode-map mouse-2 'foldout-mouse-show)
(define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit)
))
(define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom)
(define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show)
(define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit)))
;; Obsolete.

1
lisp/font-core.el
View file

@ -126,7 +126,6 @@ buffer local value for `font-lock-defaults', via its mode hook.
The above is the default behavior of `font-lock-mode'; you may
specify your own function which is called when `font-lock-mode'
is toggled via `font-lock-function'."
nil nil nil
:after-hook (font-lock-initial-fontify)
;; Don't turn on Font Lock mode if we don't have a display (we're running a
;; batch job) or if the buffer is invisible (the name starts with a space).

125
lisp/frame.el
View file

@ -301,7 +301,7 @@ This function runs the abnormal hook `move-frame-functions'."
(declare-function tool-bar-mode "tool-bar" (&optional arg))
(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
(defalias 'tool-bar-lines-needed 'tool-bar-height)
(defalias 'tool-bar-lines-needed #'tool-bar-height)
;; startup.el calls this function after loading the user's init
;; file. Now default-frame-alist and initial-frame-alist contain
@ -690,8 +690,8 @@ is not considered (see `next-frame')."
0))
(select-frame-set-input-focus (selected-frame)))
(defalias 'next-multiframe-window 'next-window-any-frame)
(defalias 'previous-multiframe-window 'previous-window-any-frame)
(defalias 'next-multiframe-window #'next-window-any-frame)
(defalias 'previous-multiframe-window #'previous-window-any-frame)
(defun window-system-for-display (display)
"Return the window system for DISPLAY.
@ -782,7 +782,7 @@ If DISPLAY is nil, that stands for the selected frame's display."
(format "Delete %s frames? " (length frames))
(format "Delete %s ? " (car frames))))))
(error "Abort!")
(mapc 'delete-frame frames)
(mapc #'delete-frame frames)
(x-close-connection display))))
(defun make-frame-command ()
@ -1162,8 +1162,8 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
:group 'faces
:set #'(lambda (var value)
(set-default var value)
(mapc 'frame-set-background-mode (frame-list)))
:initialize 'custom-initialize-changed
(mapc #'frame-set-background-mode (frame-list)))
:initialize #'custom-initialize-changed
:type '(choice (const dark)
(const light)
(const :tag "automatic" nil)))
@ -1176,6 +1176,27 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
(defvar inhibit-frame-set-background-mode nil)
(defun frame--current-backround-mode (frame)
(let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
(bg-color (frame-parameter frame 'background-color))
(tty-type (tty-type frame))
(default-bg-mode
(if (or (window-system frame)
(and tty-type
(string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
tty-type)))
'light
'dark)))
(cond (frame-default-bg-mode)
((equal bg-color "unspecified-fg") ; inverted colors
(if (eq default-bg-mode 'light) 'dark 'light))
((not (color-values bg-color frame))
default-bg-mode)
((color-dark-p (mapcar (lambda (c) (/ c 65535.0))
(color-values bg-color frame)))
'dark)
(t 'light))))
(defun frame-set-background-mode (frame &optional keep-face-specs)
"Set up display-dependent faces on FRAME.
Display-dependent faces are those which have different definitions
@ -1184,30 +1205,8 @@ according to the `background-mode' and `display-type' frame parameters.
If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
face specs for the new background mode."
(unless inhibit-frame-set-background-mode
(let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
(bg-color (frame-parameter frame 'background-color))
(tty-type (tty-type frame))
(default-bg-mode
(if (or (window-system frame)
(and tty-type
(string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
tty-type)))
'light
'dark))
(non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
(bg-mode
(cond (frame-default-bg-mode)
((equal bg-color "unspecified-fg") ; inverted colors
non-default-bg-mode)
((not (color-values bg-color frame))
default-bg-mode)
((>= (apply '+ (color-values bg-color frame))
;; Just looking at the screen, colors whose
;; values add up to .6 of the white total
;; still look dark to me.
(* (apply '+ (color-values "white" frame)) .6))
'light)
(t 'dark)))
(let* ((bg-mode
(frame--current-backround-mode frame))
(display-type
(cond ((null (window-system frame))
(if (tty-display-color-p frame) 'color 'mono))
@ -1273,6 +1272,26 @@ the `background-mode' terminal parameter."
(intern (downcase bg-resource))))
(terminal-parameter frame 'background-mode)))
;; FIXME: This needs to be significantly improved before we can use it:
;; - Fix the "scope" to be consistent: the code below is partly per-frame
;; and partly all-frames :-(
;; - Make it interact correctly with color themes (e.g. modus-themes).
;; Maybe automatically disabling color themes that disagree with the
;; selected value of `dark-mode'.
;; - Check interaction with "(in|re)verse-video".
;;
;; (define-minor-mode dark-mode
;; "Use light text on dark background."
;; :global t
;; :group 'faces
;; (when (eq dark-mode
;; (eq 'light (frame--current-backround-mode (selected-frame))))
;; ;; FIXME: Change the face's SPEC instead?
;; (set-face-attribute 'default nil
;; :foreground (face-attribute 'default :background)
;; :background (face-attribute 'default :foreground))
;; (frame-set-background-mode (selected-frame))))
;;;; Frame configurations
@ -1357,9 +1376,9 @@ differing font heights."
If FRAME is omitted, describe the currently selected frame."
(cdr (assq 'width (frame-parameters frame))))
(defalias 'frame-border-width 'frame-internal-border-width)
(defalias 'frame-pixel-width 'frame-native-width)
(defalias 'frame-pixel-height 'frame-native-height)
(defalias 'frame-border-width #'frame-internal-border-width)
(defalias 'frame-pixel-width #'frame-native-width)
(defalias 'frame-pixel-height #'frame-native-height)
(defun frame-inner-width (&optional frame)
"Return inner width of FRAME in pixels.
@ -1991,9 +2010,9 @@ frame's display)."
(fboundp 'image-mask-p)
(fboundp 'image-size)))
(defalias 'display-blink-cursor-p 'display-graphic-p)
(defalias 'display-multi-frame-p 'display-graphic-p)
(defalias 'display-multi-font-p 'display-graphic-p)
(defalias 'display-blink-cursor-p #'display-graphic-p)
(defalias 'display-multi-frame-p #'display-graphic-p)
(defalias 'display-multi-font-p #'display-graphic-p)
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
@ -2340,13 +2359,15 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to
the opposite frame edge from the edge indicated in the input spec."
(cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
(defun delete-other-frames (&optional frame)
(defun delete-other-frames (&optional frame iconify)
"Delete all frames on FRAME's terminal, except FRAME.
If FRAME uses another frame's minibuffer, the minibuffer frame is
left untouched. Do not delete any of FRAME's child frames. If
FRAME is a child frame, delete its siblings only. FRAME must be
a live frame and defaults to the selected one."
(interactive)
a live frame and defaults to the selected one.
If the prefix arg ICONIFY is non-nil, just iconify the frames rather than
deleting them."
(interactive "i\nP")
(setq frame (window-normalize-frame frame))
(let ((minibuffer-frame (window-frame (minibuffer-window frame)))
(this (next-frame frame t))
@ -2361,7 +2382,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
(delete-frame this))
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))
;; In a second round consider all remaining frames.
(setq this (next-frame frame t))
@ -2373,7 +2394,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
(delete-frame this))
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))))
@ -2399,7 +2420,7 @@ parameters `bottom-divider-width' and `right-divider-width'."
:type '(choice (const :tag "Bottom only" bottom-only)
(const :tag "Right only" right-only)
(const :tag "Bottom and right" t))
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@ -2420,7 +2441,7 @@ parameter `bottom-divider-width'."
:type '(restricted-sexp
:tag "Default width of bottom dividers"
:match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@ -2437,7 +2458,7 @@ parameter `right-divider-width'."
:type '(restricted-sexp
:tag "Default width of right dividers"
:match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@ -2714,14 +2735,14 @@ See also `toggle-frame-maximized'."
;;;; Key bindings
(define-key ctl-x-5-map "2" 'make-frame-command)
(define-key ctl-x-5-map "1" 'delete-other-frames)
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
(define-key ctl-x-5-map "5" 'other-frame-prefix)
(define-key global-map [f11] 'toggle-frame-fullscreen)
(define-key global-map [(meta f10)] 'toggle-frame-maximized)
(define-key esc-map [f10] 'toggle-frame-maximized)
(define-key ctl-x-5-map "2" #'make-frame-command)
(define-key ctl-x-5-map "1" #'delete-other-frames)
(define-key ctl-x-5-map "0" #'delete-frame)
(define-key ctl-x-5-map "o" #'other-frame)
(define-key ctl-x-5-map "5" #'other-frame-prefix)
(define-key global-map [f11] #'toggle-frame-fullscreen)
(define-key global-map [(meta f10)] #'toggle-frame-maximized)
(define-key esc-map [f10] #'toggle-frame-maximized)
;; Misc.

335
lisp/generic-x.el
View file

@ -32,6 +32,17 @@
;;
;; (require 'generic-x)
;;
;; You can decide which modes to load by setting the variable
;; `generic-extras-enable-list'. Its default value is platform-
;; specific. The recommended way to set this variable is through
;; customize:
;;
;; M-x customize-option RET generic-extras-enable-list RET
;;
;; This lets you select generic modes from the list of available
;; modes. If you manually set `generic-extras-enable-list' in your
;; .emacs, do it BEFORE loading generic-x with (require 'generic-x).
;;
;; You can also send in new modes; if the file types are reasonably
;; common, we would like to install them.
;;
@ -173,7 +184,88 @@ This hook will be installed if the variable
;; Other Generic modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; If you add a generic mode to this file, put it in one of these four
;; lists as well.
(defconst generic-default-modes
'(apache-conf-generic-mode
apache-log-generic-mode
hosts-generic-mode
java-manifest-generic-mode
java-properties-generic-mode
javascript-generic-mode
show-tabs-generic-mode
vrml-generic-mode)
"List of generic modes that are defined by default.")
(defconst generic-mswindows-modes
'(bat-generic-mode
inf-generic-mode
ini-generic-mode
rc-generic-mode
reg-generic-mode
rul-generic-mode)
"List of generic modes that are defined by default on MS-Windows.")
(defconst generic-unix-modes
'(alias-generic-mode
ansible-inventory-generic-mode
etc-fstab-generic-mode
etc-modules-conf-generic-mode
etc-passwd-generic-mode
etc-services-generic-mode
etc-sudoers-generic-mode
fvwm-generic-mode
inetd-conf-generic-mode
mailagent-rules-generic-mode
mailrc-generic-mode
named-boot-generic-mode
named-database-generic-mode
prototype-generic-mode
resolve-conf-generic-mode
samba-generic-mode
x-resource-generic-mode
xmodmap-generic-mode)
"List of generic modes that are defined by default on Unix.")
(defconst generic-other-modes
'(astap-generic-mode
ibis-generic-mode
pkginfo-generic-mode
spice-generic-mode)
"List of generic modes that are not defined by default.")
(defcustom generic-extras-enable-list
(append generic-default-modes
(if (memq system-type '(windows-nt ms-dos))
generic-mswindows-modes
generic-unix-modes)
nil)
"List of generic modes to define.
Each entry in the list should be a symbol. If you set this variable
directly, without using customize, you must reload generic-x to put
your changes into effect."
:type (let (list)
(dolist (mode
(sort (append generic-default-modes
generic-mswindows-modes
generic-unix-modes
generic-other-modes
nil)
(lambda (a b)
(string< (symbol-name b)
(symbol-name a))))
(cons 'set list))
(push `(const ,mode) list)))
:set (lambda (s v)
(set-default s v)
(unless load-in-progress
(load "generic-x")))
:version "22.1")
;;; Apache
(when (memq 'apache-conf-generic-mode generic-extras-enable-list)
(define-generic-mode apache-conf-generic-mode
'(?#)
nil
@ -186,7 +278,9 @@ This hook will be installed if the variable
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)
("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
"Generic mode for Apache or HTTPD configuration files.")
"Generic mode for Apache or HTTPD configuration files."))
(when (memq 'apache-log-generic-mode generic-extras-enable-list)
(define-generic-mode apache-log-generic-mode
nil
@ -197,9 +291,11 @@ This hook will be installed if the variable
(2 font-lock-variable-name-face)))
'("access_log\\'")
nil
"Generic mode for Apache log files.")
"Generic mode for Apache log files."))
;;; Samba
(when (memq 'samba-generic-mode generic-extras-enable-list)
(define-generic-mode samba-generic-mode
'(?\; ?#)
nil
@ -209,11 +305,13 @@ This hook will be installed if the variable
(2 font-lock-type-face)))
'("smb\\.conf\\'")
'(generic-bracket-support)
"Generic mode for Samba configuration files.")
"Generic mode for Samba configuration files."))
;;; Fvwm
;; This is pretty basic. Also, modes for other window managers could
;; be defined as well.
(when (memq 'fvwm-generic-mode generic-extras-enable-list)
(define-generic-mode fvwm-generic-mode
'(?#)
'("AddToMenu"
@ -232,28 +330,33 @@ This hook will be installed if the variable
nil
'("\\.fvwmrc\\'" "\\.fvwm2rc\\'")
nil
"Generic mode for FVWM configuration files.")
"Generic mode for FVWM configuration files."))
;;; X Resource
;; I'm pretty sure I've seen an actual mode to do this, but I don't
;; think it's standard with Emacs
(when (memq 'x-resource-generic-mode generic-extras-enable-list)
(define-generic-mode x-resource-generic-mode
'(?!)
nil
'(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face))
'("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'")
nil
"Generic mode for X Resource configuration files.")
"Generic mode for X Resource configuration files."))
(if (memq 'xmodmap-generic-mode generic-extras-enable-list)
(define-generic-mode xmodmap-generic-mode
'(?!)
'("add" "clear" "keycode" "keysym" "remove" "pointer")
nil
'("[xX]modmap\\(rc\\)?\\'")
nil
"Simple mode for xmodmap files.")
"Simple mode for xmodmap files."))
;;; Hosts
(when (memq 'hosts-generic-mode generic-extras-enable-list)
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
@ -261,20 +364,27 @@ This hook will be installed if the variable
("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
"Generic mode for HOSTS files.")
"Generic mode for HOSTS files."))
;;; Windows INF files
;; If i-g-m-f-f-h is defined, then so is i-g-m.
(declare-function ini-generic-mode "generic-x")
(when (memq 'inf-generic-mode generic-extras-enable-list)
(define-generic-mode inf-generic-mode
'(?\;)
nil
'(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face))
'("\\.[iI][nN][fF]\\'")
'(generic-bracket-support)
"Generic mode for MS-Windows INF files.")
"Generic mode for MS-Windows INF files."))
;;; Windows INI files
;; Should define escape character as well!
(when (memq 'ini-generic-mode generic-extras-enable-list)
(define-generic-mode ini-generic-mode
'(?\;)
nil
@ -301,9 +411,13 @@ like an INI file. You can add this hook to `find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
'ini-generic-mode-find-file-hook "28.1"))
;;; Windows REG files
;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
(when (memq 'reg-generic-mode generic-extras-enable-list)
(define-generic-mode reg-generic-mode
'(?\;)
'("key" "classes_root" "REGEDIT" "REGEDIT4")
@ -314,11 +428,19 @@ like an INI file. You can add this hook to `find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
"Generic mode for MS-Windows Registry files.")
"Generic mode for MS-Windows Registry files."))
(declare-function w32-shell-name "w32-fns" ())
;;; DOS/Windows BAT files
(when (memq 'bat-generic-mode generic-extras-enable-list)
(define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4"))
;;; Mailagent
;; Mailagent is a Unix mail filtering program. Anyone wanna do a
;; generic mode for procmail?
(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list)
(define-generic-mode mailagent-rules-generic-mode
'(?#)
'("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT")
@ -329,9 +451,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
"Generic mode for Mailagent rules files.")
"Generic mode for Mailagent rules files."))
;; Solaris/Sys V prototype files
(when (memq 'prototype-generic-mode generic-extras-enable-list)
(define-generic-mode prototype-generic-mode
'(?#)
nil
@ -350,9 +474,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face)))
'("prototype\\'")
nil
"Generic mode for Sys V prototype files.")
"Generic mode for Sys V prototype files."))
;; Solaris/Sys V pkginfo files
(when (memq 'pkginfo-generic-mode generic-extras-enable-list)
(define-generic-mode pkginfo-generic-mode
'(?#)
nil
@ -361,9 +487,17 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face)))
'("pkginfo\\'")
nil
"Generic mode for Sys V pkginfo files.")
"Generic mode for Sys V pkginfo files."))
;; Javascript mode
;; Obsolete; defer to js-mode from js.el.
(when (memq 'javascript-generic-mode generic-extras-enable-list)
(define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3"))
;; VRML files
(when (memq 'vrml-generic-mode generic-extras-enable-list)
(define-generic-mode vrml-generic-mode
'(?#)
'("DEF"
@ -411,9 +545,11 @@ like an INI file. You can add this hook to `find-file-hook'."
("*Definitions*"
"DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
1)))))
"Generic Mode for VRML files.")
"Generic Mode for VRML files."))
;; Java Manifests
(when (memq 'java-manifest-generic-mode generic-extras-enable-list)
(define-generic-mode java-manifest-generic-mode
'(?#)
'("Name"
@ -430,9 +566,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-constant-face)))
'("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'")
nil
"Generic mode for Java Manifest files.")
"Generic mode for Java Manifest files."))
;; Java properties files
(when (memq 'java-properties-generic-mode generic-extras-enable-list)
(define-generic-mode java-properties-generic-mode
'(?! ?#)
nil
@ -458,9 +596,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
"Generic mode for Java properties files.")
"Generic mode for Java properties files."))
;; C shell alias definitions
(when (memq 'alias-generic-mode generic-extras-enable-list)
(define-generic-mode alias-generic-mode
'(?#)
'("alias" "unalias")
@ -473,9 +613,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
"Generic mode for C Shell alias files.")
"Generic mode for C Shell alias files."))
;; Ansible inventory files
(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list)
(define-generic-mode ansible-inventory-generic-mode
'(?#)
nil
@ -494,10 +636,12 @@ like an INI file. You can add this hook to `find-file-hook'."
(setq imenu-generic-expression
'((nil "^\\s-*\\[\\(.*\\)\\]" 1)
("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
"Generic mode for Ansible inventory files.")
"Generic mode for Ansible inventory files."))
;;; Windows RC files
;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira)
(when (memq 'rc-generic-mode generic-extras-enable-list)
(define-generic-mode rc-generic-mode
;; '(?\/)
'("//")
@ -577,13 +721,15 @@ like an INI file. You can add this hook to `find-file-hook'."
'("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-constant-face)
(2 font-lock-variable-name-face nil t))))
'("\\.[rR][cC]\\'")
nil
"Generic mode for MS-Windows Resource files.")
'("\\.[rR][cC]\\'")
nil
"Generic mode for MS-Windows Resource files."))
;; InstallShield RUL files
;; Contributed by Alfred.Correira@Pervasive.Com
;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com>
(when (memq 'rul-generic-mode generic-extras-enable-list)
(eval-when-compile
;;; build the regexp strings using regexp-opt
@ -1226,9 +1372,11 @@ like an INI file. You can add this hook to `find-file-hook'."
> "begin" \n
> _ \n
resume:
> "end;")
> "end;"))
;; Additions by ACorreir@pervasive-sw.com (Alfred Correira)
(when (memq 'mailrc-generic-mode generic-extras-enable-list)
(define-generic-mode mailrc-generic-mode
'(?#)
'("alias"
@ -1250,9 +1398,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.mailrc\\'")
nil
"Mode for mailrc files.")
"Mode for mailrc files."))
;; Inetd.conf
(when (memq 'inetd-conf-generic-mode generic-extras-enable-list)
(define-generic-mode inetd-conf-generic-mode
'(?#)
'("stream"
@ -1267,9 +1417,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Services
(when (memq 'etc-services-generic-mode generic-extras-enable-list)
(define-generic-mode etc-services-generic-mode
'(?#)
'("tcp"
@ -1282,9 +1434,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Password and Group files
(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
(define-generic-mode etc-passwd-generic-mode
nil ;; No comment characters
'("root") ;; Only one keyword
@ -1322,9 +1476,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))
'((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
;; Fstab
(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
@ -1436,9 +1592,11 @@ like an INI file. You can add this hook to `find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^# \t]+\\)\\s-+" 1))))))
'((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
;; /etc/sudoers
(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
(define-generic-mode etc-sudoers-generic-mode
'(?#)
'("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias"
@ -1449,9 +1607,11 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face))
'("/etc/sudoers\\'")
nil
"Generic mode for sudoers configuration files.")
"Generic mode for sudoers configuration files."))
;; From Jacques Duthen <jacques.duthen@sncf.fr>
(when (memq 'show-tabs-generic-mode generic-extras-enable-list)
(eval-when-compile
(defconst show-tabs-generic-mode-font-lock-defaults-1
@ -1489,12 +1649,14 @@ like an INI file. You can add this hook to `find-file-hook'."
nil ;; no auto-mode-alist
;; '(show-tabs-generic-mode-hook-fun)
nil
"Generic mode to show tabs and trailing spaces.")
"Generic mode to show tabs and trailing spaces."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DNS modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when (memq 'named-boot-generic-mode generic-extras-enable-list)
(define-generic-mode named-boot-generic-mode
;; List of comment characters
'(?\;)
@ -1510,7 +1672,9 @@ like an INI file. You can add this hook to `find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/named\\.boot\\'")
;; List of set up functions to call
nil)
nil))
(when (memq 'named-database-generic-mode generic-extras-enable-list)
(define-generic-mode named-database-generic-mode
;; List of comment characters
@ -1531,7 +1695,9 @@ like an INI file. You can add this hook to `find-file-hook'."
(defun named-database-print-serial ()
"Print a serial number based on the current date."
(interactive)
(insert (format-time-string named-database-time-string)))
(insert (format-time-string named-database-time-string))))
(when (memq 'resolve-conf-generic-mode generic-extras-enable-list)
(define-generic-mode resolve-conf-generic-mode
;; List of comment characters
@ -1543,12 +1709,14 @@ like an INI file. You can add this hook to `find-file-hook'."
;; List of additional auto-mode-alist expressions
'("/etc/resolve?\\.conf\\'")
;; List of set up functions to call
nil)
nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Modes for spice and common electrical engineering circuit netlist formats
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when (memq 'spice-generic-mode generic-extras-enable-list)
(define-generic-mode spice-generic-mode
nil
'("and"
@ -1584,7 +1752,9 @@ like an INI file. You can add this hook to `find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for SPICE circuit netlist files.")
"Generic mode for SPICE circuit netlist files."))
(when (memq 'ibis-generic-mode generic-extras-enable-list)
(define-generic-mode ibis-generic-mode
'(?|)
@ -1593,7 +1763,9 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[iI][bB][sS]\\'")
'(generic-bracket-support)
"Generic mode for IBIS circuit netlist files.")
"Generic mode for IBIS circuit netlist files."))
(when (memq 'astap-generic-mode generic-extras-enable-list)
(define-generic-mode astap-generic-mode
nil
@ -1627,7 +1799,9 @@ like an INI file. You can add this hook to `find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for ASTAP circuit netlist files.")
"Generic mode for ASTAP circuit netlist files."))
(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
(define-generic-mode etc-modules-conf-generic-mode
;; List of comment characters
@ -1669,98 +1843,7 @@ like an INI file. You can add this hook to `find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/modules\\.conf" "/etc/conf\\.modules")
;; List of set up functions to call
nil)
;; Obsolete
(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3")
(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")
(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4")
(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
#'ini-generic-mode-find-file-hook "28.1")
(defconst generic-default-modes
'(apache-conf-generic-mode
apache-log-generic-mode
hosts-generic-mode
java-manifest-generic-mode
java-properties-generic-mode
javascript-generic-mode
show-tabs-generic-mode
vrml-generic-mode)
"List of generic modes that are defined by default.")
(make-obsolete-variable 'generic-default-modes "no longer used." "28.1")
(defconst generic-mswindows-modes
'(bat-generic-mode
inf-generic-mode
ini-generic-mode
rc-generic-mode
reg-generic-mode
rul-generic-mode)
"List of generic modes that are defined by default on MS-Windows.")
(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1")
(defconst generic-unix-modes
'(alias-generic-mode
ansible-inventory-generic-mode
etc-fstab-generic-mode
etc-modules-conf-generic-mode
etc-passwd-generic-mode
etc-services-generic-mode
etc-sudoers-generic-mode
fvwm-generic-mode
inetd-conf-generic-mode
mailagent-rules-generic-mode
mailrc-generic-mode
named-boot-generic-mode
named-database-generic-mode
prototype-generic-mode
resolve-conf-generic-mode
samba-generic-mode
x-resource-generic-mode
xmodmap-generic-mode)
"List of generic modes that are defined by default on Unix.")
(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1")
(defconst generic-other-modes
'(astap-generic-mode
ibis-generic-mode
pkginfo-generic-mode
spice-generic-mode)
"List of generic modes that are not defined by default.")
(make-obsolete-variable 'generic-other-modes "no longer used." "28.1")
(defcustom generic-extras-enable-list
(append generic-default-modes
(if (memq system-type '(windows-nt ms-dos))
generic-mswindows-modes
generic-unix-modes)
nil)
"List of generic modes to define.
Each entry in the list should be a symbol. If you set this variable
directly, without using customize, you must reload generic-x to put
your changes into effect."
:type (let (list)
(dolist (mode
(sort (append generic-default-modes
generic-mswindows-modes
generic-unix-modes
generic-other-modes
nil)
(lambda (a b)
(string< (symbol-name b)
(symbol-name a))))
(cons 'set list))
(push `(const ,mode) list)))
:set (lambda (s v)
(set-default s v)
(unless load-in-progress
(load "generic-x")))
:version "22.1")
(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1")
nil))
(provide 'generic-x)

4
lisp/gnus/gnus-cite.el
View file

@ -1134,9 +1134,7 @@ Returns nil if there is no such line before LIMIT, t otherwise."
(define-minor-mode gnus-message-citation-mode
"Minor mode providing more font-lock support for nested citations.
When enabled, it automatically turns on `font-lock-mode'."
nil ;; init-value
"" ;; lighter
nil ;; keymap
:lighter ""
(when (derived-mode-p 'message-mode)
;; FIXME: Use font-lock-add-keywords!
(let ((defaults (car font-lock-defaults))

166
lisp/gnus/message.el
View file

@ -120,12 +120,13 @@
:group 'message-buffers
:type 'integer)
(defcustom message-send-rename-function nil
(defcustom message-send-rename-function #'message-default-send-rename-function
"Function called to rename the buffer after sending it."
:group 'message-buffers
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-fcc-handler-function 'message-output
(defcustom message-fcc-handler-function #'message-output
"A function called to save outgoing articles.
This function will be called with the name of the file to store the
article in. The default function is `message-output' which saves in Unix
@ -418,7 +419,7 @@ you can explicitly override this setting by calling
:type 'string
:group 'message-various)
(defcustom message-cross-post-note-function 'message-cross-post-insert-note
(defcustom message-cross-post-note-function #'message-cross-post-insert-note
"Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
@ -756,7 +757,7 @@ See also `send-mail-function'."
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(defcustom message-send-news-function 'message-send-news
(defcustom message-send-news-function #'message-send-news
"Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'."
@ -765,29 +766,32 @@ variable `mail-header-separator'."
:link '(custom-manual "(message)News Variables")
:type 'function)
(defcustom message-reply-to-function nil
(defcustom message-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Reply")
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-wide-reply-to-function nil
(defcustom message-wide-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Wide Reply")
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-followup-to-function nil
(defcustom message-followup-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-extra-wide-headers nil
"If non-nil, a list of additional address headers.
@ -1021,7 +1025,7 @@ the signature is inserted."
:version "22.1"
:group 'message-various)
(defcustom message-citation-line-function 'message-insert-citation-line
(defcustom message-citation-line-function #'message-insert-citation-line
"Function called to insert the \"Whomever writes:\" line.
Predefined functions include `message-insert-citation-line' and
@ -1103,7 +1107,7 @@ Used by `message-yank-original' via `message-yank-cite'."
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
(defcustom message-cite-function 'message-cite-original-without-signature
(defcustom message-cite-function #'message-cite-original-without-signature
"Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
@ -1116,7 +1120,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
:version "22.3" ;; Gnus 5.10.12 (changed default)
:group 'message-insertion)
(defcustom message-indent-citation-function 'message-indent-citation
(defcustom message-indent-citation-function #'message-indent-citation
"Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave
@ -2847,79 +2851,79 @@ Consider adding this function to `message-header-setup-hook'"
(unless message-mode-map
(setq message-mode-map (make-keymap))
(set-keymap-parent message-mode-map text-mode-map)
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c?" #'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
(define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
(define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
(define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
(define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
(define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
(define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to)
(define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from)
(define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc)
(define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc)
(define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject)
(define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to)
(define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution)
(define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to)
(define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-i"
'message-insert-or-toggle-importance)
#'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-f\C-a"
'message-generate-unsubscribed-mail-followup-to)
#'message-generate-unsubscribed-mail-followup-to)
;; modify headers (and insert notes in body)
(define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
(define-key message-mode-map "\C-c\C-fs" #'message-change-subject)
;;
(define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
(define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to)
;; prefix+message-cross-post-followup-to = same w/o cross-post
(define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
(define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
(define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc)
(define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header)
;; mark inserted text
(define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
(define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
(define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region)
(define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file)
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-b" #'message-goto-body)
(define-key message-mode-map "\C-c\C-i" #'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
(define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
(define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
(define-key message-mode-map "\C-c\C-t" #'message-insert-to)
(define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" #'message-to-list-only)
(define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires)
(define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\M-n"
'message-insert-disposition-notification-to)
#'message-insert-disposition-notification-to)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
(define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
(define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
(define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
(define-key message-mode-map "\C-c\C-y" #'message-yank-original)
(define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" #'message-insert-signature)
(define-key message-mode-map "\C-c\M-h" #'message-insert-headers)
(define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body)
(define-key message-mode-map "\C-c\C-o" #'message-sort-headers)
(define-key message-mode-map "\C-c\M-r" #'message-rename-buffer)
(define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
(define-key message-mode-map "\C-c\C-s" 'message-send)
(define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
(define-key message-mode-map "\C-c\C-d" 'message-dont-send)
(define-key message-mode-map "\C-c\n" 'gnus-delay-article)
(define-key message-mode-map "\C-c\C-c" #'message-send-and-exit)
(define-key message-mode-map "\C-c\C-s" #'message-send)
(define-key message-mode-map "\C-c\C-k" #'message-kill-buffer)
(define-key message-mode-map "\C-c\C-d" #'message-dont-send)
(define-key message-mode-map "\C-c\n" #'gnus-delay-article)
(define-key message-mode-map "\C-c\M-k" 'message-kill-address)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region)
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
(define-key message-mode-map [remap split-line] 'message-split-line)
(define-key message-mode-map "\C-c\M-k" #'message-kill-address)
(define-key message-mode-map "\C-c\C-e" #'message-elide-region)
(define-key message-mode-map "\C-c\C-v" #'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature)
(define-key message-mode-map "\M-\r" #'message-newline-and-reformat)
(define-key message-mode-map [remap split-line] #'message-split-line)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
(define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot)
(define-key message-mode-map "\C-c\C-a" #'mml-attach-file)
(define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot)
(define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
(define-key message-mode-map "\C-a" #'message-beginning-of-line)
(define-key message-mode-map "\t" #'message-tab)
(define-key message-mode-map "\M-n" 'message-display-abbrev))
(define-key message-mode-map "\M-n" #'message-display-abbrev))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
@ -3169,14 +3173,13 @@ Like `text-mode', but with these additional commands:
;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts.
;;
(setq-local syntax-propertize-function 'message--syntax-propertize)
(setq-local syntax-propertize-function #'message--syntax-propertize)
(setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables ()
"Setup message fill variables."
(setq-local fill-paragraph-function #'message-fill-paragraph)
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
@ -3287,7 +3290,7 @@ Like `text-mode', but with these additional commands:
(push-mark)
(message-position-on-field "Summary" "Subject"))
(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1")
(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1")
(defun message-goto-body (&optional interactive)
"Move point to the beginning of the message body.
Returns point."
@ -6662,9 +6665,8 @@ moved to the beginning "
(not (buffer-modified-p buffer)))
(kill-buffer buffer))))
;; Rename the buffer.
(if message-send-rename-function
(funcall message-send-rename-function)
(message-default-send-rename-function))
(funcall (or message-send-rename-function
#'message-default-send-rename-function))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
@ -6763,8 +6765,9 @@ are not included."
(defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions)
(condition-case nil
;; FIXME: Use functions rather than expressions!
(add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action)))))
`(apply #',(car action) ',(cdr action)))))
(setq message-return-action return-action)
(setq message-reply-buffer
(if (and (consp yank-action)
@ -6903,7 +6906,7 @@ are not included."
;;;###autoload
(defun message-mail (&optional to subject other-headers continue
switch-function yank-action send-actions
return-action &rest ignored)
return-action &rest _)
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
@ -7127,15 +7130,12 @@ want to get rid of this query permanently.")))
;; specific, and just Cc-in the rest.
(setq follow-to (list
(cons 'To
(mapconcat
(lambda (addr)
(cdr addr)) recipients ", "))))
(mapconcat #'cdr recipients ", "))))
;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc.
(when recipients
(setq recipients (mapconcat
(lambda (addr) (cdr addr)) recipients ", "))
(setq recipients (mapconcat #'cdr recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))))
@ -7862,7 +7862,7 @@ is for the internal use."
(interactive)
(setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function
'message-forward-rmail-make-body))
#'message-forward-rmail-make-body))
;;;###autoload
(defun message-resend (address)

1
lisp/gnus/nnagent.el
View file

@ -1,4 +1,3 @@
;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.

53
lisp/hippie-exp.el
View file

@ -1,4 +1,4 @@
;;; hippie-exp.el --- expand text trying various ways to find its expansion
;;; hippie-exp.el --- expand text trying various ways to find its expansion -*- lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@ -58,7 +58,7 @@
;; The variable `hippie-expand-dabbrev-as-symbol' controls whether
;; characters of syntax '_' is considered part of the words to expand
;; dynamically.
;; See also the macro `make-hippie-expand-function' below.
;; See also the function `make-hippie-expand-function' below.
;;
;; A short description of the current try-functions in this file:
;; `try-complete-file-name' : very convenient to have in any buffer,
@ -215,50 +215,42 @@
"The list of expansion functions tried in order by `hippie-expand'.
To change the behavior of `hippie-expand', remove, change the order of,
or insert functions in this list."
:type '(repeat function)
:group 'hippie-expand)
:type '(repeat function))
(defcustom hippie-expand-verbose t
"Non-nil makes `hippie-expand' output which function it is trying."
:type 'boolean
:group 'hippie-expand)
:type 'boolean)
(defcustom hippie-expand-dabbrev-skip-space nil
"Non-nil means tolerate trailing spaces in the abbreviation to expand."
:group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-dabbrev-as-symbol t
"Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
:group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-no-restriction t
"Non-nil means that narrowed buffers are widened during search."
:group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-max-buffers ()
"The maximum number of buffers (apart from the current) searched.
If nil, all buffers are searched."
:type '(choice (const :tag "All" nil)
integer)
:group 'hippie-expand)
integer))
(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
"A list specifying which buffers not to search (if not current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms)."
:type '(repeat (choice regexp (symbol :tag "Major Mode")))
:group 'hippie-expand)
:type '(repeat (choice regexp (symbol :tag "Major Mode"))))
(defcustom hippie-expand-only-buffers ()
"A list specifying the only buffers to search (in addition to current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms). If non-nil, this variable overrides the variable
`hippie-expand-ignore-buffers'."
:type '(repeat (choice regexp (symbol :tag "Major Mode")))
:group 'hippie-expand)
:type '(repeat (choice regexp (symbol :tag "Major Mode"))))
;;;###autoload
(defun hippie-expand (arg)
@ -407,18 +399,19 @@ undoes the expansion."
;; try-expand-line-all-buffers)))
;;
;;;###autoload
(defmacro make-hippie-expand-function (try-list &optional verbose)
(defun make-hippie-expand-function (try-list &optional verbose)
"Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose."
`(lambda (arg)
,(concat
"Try to expand text before point, using the following functions: \n"
(mapconcat 'prin1-to-string (eval try-list) ", "))
(interactive "P")
(let ((hippie-expand-try-functions-list ,try-list)
(hippie-expand-verbose ,verbose))
(hippie-expand arg))))
(lambda (arg)
(:documentation
(concat
"Try to expand text before point, using the following functions: \n"
(mapconcat #'prin1-to-string try-list ", ")))
(interactive "P")
(let ((hippie-expand-try-functions-list try-list)
(hippie-expand-verbose verbose))
(hippie-expand arg))))
;;; Here follows the try-functions and their requisites:
@ -434,7 +427,8 @@ string). It returns t if a new completion is found, nil otherwise."
(he-init-string (he-file-name-beg) (point))
(let ((name-part (file-name-nondirectory he-search-string))
(dir-part (expand-file-name (or (file-name-directory
he-search-string) ""))))
he-search-string)
""))))
(if (not (he-string-member name-part he-tried-table))
(setq he-tried-table (cons name-part he-tried-table)))
(if (and (not (equal he-search-string ""))
@ -442,7 +436,7 @@ string). It returns t if a new completion is found, nil otherwise."
(setq he-expand-list (sort (file-name-all-completions
name-part
dir-part)
'string-lessp))
#'string-lessp))
(setq he-expand-list ())))))
(while (and he-expand-list
@ -538,7 +532,7 @@ string). It returns t if a new completion is found, nil otherwise."
(or (boundp sym)
(fboundp sym)
(symbol-plist sym))))
'string-lessp)))))
#'string-lessp)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
(setq he-expand-list (cdr he-expand-list)))
@ -822,9 +816,10 @@ string). It returns t if a new expansion is found, nil otherwise."
(setq he-expand-list
(and (not (equal he-search-string ""))
(mapcar (lambda (sym)
(if (and (boundp sym) (vectorp (eval sym)))
(if (and (boundp sym)
(abbrev-table-p (symbol-value sym)))
(abbrev-expansion (downcase he-search-string)
(eval sym))))
(symbol-value sym))))
(append '(local-abbrev-table
global-abbrev-table)
abbrev-table-name-list))))))

152
lisp/ibuf-ext.el
View file

@ -402,7 +402,7 @@ format. See `ibuffer-update-saved-filters-format' and
;;;###autoload
(define-minor-mode ibuffer-auto-mode
"Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)."
nil nil nil
:lighter nil
(unless (derived-mode-p 'ibuffer-mode)
(error "This buffer is not in Ibuffer mode"))
(cond (ibuffer-auto-mode
@ -687,8 +687,8 @@ specifications with the same structure as
`ibuffer-filtering-qualifiers'."
(not
(memq nil ;; a filter will return nil if it failed
(mapcar #'(lambda (filter)
(ibuffer-included-in-filter-p buf filter))
(mapcar (lambda (filter)
(ibuffer-included-in-filter-p buf filter))
filters))))
(defun ibuffer-unary-operand (filter)
@ -724,8 +724,8 @@ specification, with the same structure as an element of the list
;; (dolist (filter-spec (cdr filter) nil)
;; (when (ibuffer-included-in-filter-p buf filter-spec)
;; (throw 'has-match t))))
(memq t (mapcar #'(lambda (x)
(ibuffer-included-in-filter-p buf x))
(memq t (mapcar (lambda (x)
(ibuffer-included-in-filter-p buf x))
(cdr filter))))
('and
(catch 'no-match
@ -1589,8 +1589,8 @@ to move by. The default is `ibuffer-marked-char'."
(message "No buffers marked; use `m' to mark a buffer")
(let ((count
(ibuffer-map-marked-lines
#'(lambda (_buf _mark)
'kill))))
(lambda (_buf _mark)
'kill))))
(message "Killed %s lines" count))))
;;;###autoload
@ -1609,8 +1609,8 @@ a prefix argument reverses the meaning of that variable."
(when current-prefix-arg
(setq only-visible (not only-visible)))
(if only-visible
(let ((table (mapcar #'(lambda (x)
(buffer-name (car x)))
(let ((table (mapcar (lambda (x)
(buffer-name (car x)))
(ibuffer-current-state-list))))
(when (null table)
(error "No buffers!"))
@ -1621,10 +1621,10 @@ a prefix argument reverses the meaning of that variable."
(let (buf-point)
;; Blindly search for our buffer: it is very likely that it is
;; not in a hidden filter group.
(ibuffer-map-lines #'(lambda (buf _marks)
(when (string= (buffer-name buf) name)
(setq buf-point (point))
nil))
(ibuffer-map-lines (lambda (buf _marks)
(when (string= (buffer-name buf) name)
(setq buf-point (point))
nil))
t nil)
(when (and
(null buf-point)
@ -1635,10 +1635,10 @@ a prefix argument reverses the meaning of that variable."
(dolist (group ibuffer-hidden-filter-groups)
(ibuffer-jump-to-filter-group group)
(ibuffer-toggle-filter-group)
(ibuffer-map-lines #'(lambda (buf _marks)
(when (string= (buffer-name buf) name)
(setq buf-point (point))
nil))
(ibuffer-map-lines (lambda (buf _marks)
(when (string= (buffer-name buf) name)
(setq buf-point (point))
nil))
t group)
(if buf-point
(throw 'found nil)
@ -1775,11 +1775,11 @@ You can then feed the file name(s) to other commands with \\[yank]."
(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
(let ((count
(ibuffer-map-lines
#'(lambda (buf _mark)
(when (funcall func buf)
(ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
ibuffer-marked-char))
t))
(lambda (buf _mark)
(when (funcall func buf)
(ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
ibuffer-marked-char))
t))
nil
group)))
(ibuffer-redisplay t)
@ -1791,8 +1791,8 @@ You can then feed the file name(s) to other commands with \\[yank]."
"Mark all buffers whose name matches REGEXP."
(interactive "sMark by name (regexp): ")
(ibuffer-mark-on-buffer
#'(lambda (buf)
(string-match regexp (buffer-name buf)))))
(lambda (buf)
(string-match regexp (buffer-name buf)))))
(defun ibuffer-locked-buffer-p (&optional buf)
"Return non-nil if BUF is locked.
@ -1816,9 +1816,9 @@ When BUF nil, default to the buffer at current line."
"Mark all buffers whose major mode matches REGEXP."
(interactive "sMark by major mode (regexp): ")
(ibuffer-mark-on-buffer
#'(lambda (buf)
(with-current-buffer buf
(string-match regexp (format-mode-line mode-name nil nil buf))))))
(lambda (buf)
(with-current-buffer buf
(string-match regexp (format-mode-line mode-name nil nil buf))))))
;;;###autoload
(defun ibuffer-mark-by-file-name-regexp (regexp)
@ -1840,21 +1840,21 @@ Otherwise buffers whose name matches an element of
(interactive (let ((reg (read-string "Mark by content (regexp): ")))
(list reg current-prefix-arg)))
(ibuffer-mark-on-buffer
#'(lambda (buf)
(let ((mode (with-current-buffer buf major-mode))
res)
(cond ((and (not all-buffers)
(or
(memq mode ibuffer-never-search-content-mode)
(cl-dolist (x ibuffer-never-search-content-name nil)
(when-let ((found (string-match x (buffer-name buf))))
(cl-return found)))))
(setq res nil))
(t
(with-current-buffer buf
(save-mark-and-excursion
(goto-char (point-min))
(setq res (re-search-forward regexp nil t)))))) res))))
(lambda (buf)
(let ((mode (with-current-buffer buf major-mode))
res)
(cond ((and (not all-buffers)
(or
(memq mode ibuffer-never-search-content-mode)
(cl-dolist (x ibuffer-never-search-content-name nil)
(when-let ((found (string-match x (buffer-name buf))))
(cl-return found)))))
(setq res nil))
(t
(with-current-buffer buf
(save-mark-and-excursion
(goto-char (point-min))
(setq res (re-search-forward regexp nil t)))))) res))))
;;;###autoload
(defun ibuffer-mark-by-mode (mode)
@ -1869,92 +1869,92 @@ Otherwise buffers whose name matches an element of
(format-prompt "Mark by major mode" default)
(ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
(eq (buffer-local-value 'major-mode buf) mode))))
(lambda (buf)
(eq (buffer-local-value 'major-mode buf) mode))))
;;;###autoload
(defun ibuffer-mark-modified-buffers ()
"Mark all modified buffers."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf) (buffer-modified-p buf))))
(lambda (buf) (buffer-modified-p buf))))
;;;###autoload
(defun ibuffer-mark-unsaved-buffers ()
"Mark all modified buffers that have an associated file."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
(buffer-modified-p buf)))))
(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
(buffer-modified-p buf)))))
;;;###autoload
(defun ibuffer-mark-dissociated-buffers ()
"Mark all buffers whose associated file does not exist."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf)
(with-current-buffer buf
(or
(and buffer-file-name
(not (file-exists-p buffer-file-name)))
(and (eq major-mode 'dired-mode)
(boundp 'dired-directory)
(stringp dired-directory)
(not (file-exists-p (file-name-directory dired-directory)))))))))
(lambda (buf)
(with-current-buffer buf
(or
(and buffer-file-name
(not (file-exists-p buffer-file-name)))
(and (eq major-mode 'dired-mode)
(boundp 'dired-directory)
(stringp dired-directory)
(not (file-exists-p (file-name-directory dired-directory)))))))))
;;;###autoload
(defun ibuffer-mark-help-buffers ()
"Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf)
(with-current-buffer buf
(memq major-mode ibuffer-help-buffer-modes)))))
(lambda (buf)
(with-current-buffer buf
(memq major-mode ibuffer-help-buffer-modes)))))
;;;###autoload
(defun ibuffer-mark-compressed-file-buffers ()
"Mark buffers whose associated file is compressed."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf)
(with-current-buffer buf
(and buffer-file-name
(string-match ibuffer-compressed-file-name-regexp
buffer-file-name))))))
(lambda (buf)
(with-current-buffer buf
(and buffer-file-name
(string-match ibuffer-compressed-file-name-regexp
buffer-file-name))))))
;;;###autoload
(defun ibuffer-mark-old-buffers ()
"Mark buffers which have not been viewed in `ibuffer-old-time' hours."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf)
(with-current-buffer buf
(when buffer-display-time
(time-less-p
(* 60 60 ibuffer-old-time)
(time-since buffer-display-time)))))))
(lambda (buf)
(with-current-buffer buf
(when buffer-display-time
(time-less-p
(* 60 60 ibuffer-old-time)
(time-since buffer-display-time)))))))
;;;###autoload
(defun ibuffer-mark-special-buffers ()
"Mark all buffers whose name begins and ends with `*'."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf) (string-match "^\\*.+\\*$"
(buffer-name buf)))))
(lambda (buf) (string-match "^\\*.+\\*$"
(buffer-name buf)))))
;;;###autoload
(defun ibuffer-mark-read-only-buffers ()
"Mark all read-only buffers."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
;;;###autoload
(defun ibuffer-mark-dired-buffers ()
"Mark all `dired' buffers."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
;;;###autoload
(defun ibuffer-do-occur (regexp &optional nlines)
@ -1970,8 +1970,8 @@ defaults to one."
(let ((ibuffer-do-occur-bufs nil))
;; Accumulate a list of marked buffers
(ibuffer-map-marked-lines
#'(lambda (buf _mark)
(push buf ibuffer-do-occur-bufs)))
(lambda (buf _mark)
(push buf ibuffer-do-occur-bufs)))
(occur-1 regexp nlines ibuffer-do-occur-bufs)))
(provide 'ibuf-ext)

32
lisp/ibuf-macs.el
View file

@ -66,8 +66,8 @@ During evaluation of body, bind `it' to the value returned by TEST."
(ibuffer-redisplay-engine
;; Get rid of dead buffers
(delq nil
(mapcar #'(lambda (e) (when (buffer-live-p (car e))
e))
(mapcar (lambda (e) (when (buffer-live-p (car e))
e))
ibuffer-save-marks-tmp-mark-list)))
(ibuffer-redisplay t))))))
@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'.
(ibuffer-redisplay t)
(setq ibuffer-last-sorting-mode ',name))
(push (list ',name ,description
#'(lambda (a b)
,@body))
(lambda (a b)
,@body))
ibuffer-sorting-functions-alist)
:autoload-end))
@ -259,18 +259,18 @@ buffer object.
'ibuffer-map-deletion-lines)
(_
'ibuffer-map-marked-lines))
#'(lambda (buf mark)
;; Silence warning for code that doesn't
;; use `mark'.
(ignore mark)
,(if (eq modifier-p :maybe)
`(let ((ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
(prog1 ,inner-body
(when (not (eq ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
(setq ibuffer-did-modification t))))
inner-body)))))
(lambda (buf mark)
;; Silence warning for code that doesn't
;; use `mark'.
(ignore mark)
,(if (eq modifier-p :maybe)
`(let ((ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
(prog1 ,inner-body
(when (not (eq ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
(setq ibuffer-did-modification t))))
inner-body)))))
,finish)))
(if dangerous
`(when (ibuffer-confirm-operation-on ,active-opstring marked-names)

42
lisp/icomplete.el
View file

@ -562,6 +562,37 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(completion--cache-all-sorted-completions beg end (cons comp all))))
finally return all)))
(defvar icomplete-vertical-mode-minibuffer-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-n") 'icomplete-forward-completions)
(define-key map (kbd "C-p") 'icomplete-backward-completions)
map)
"Keymap used by `icomplete-vertical-mode' in the minibuffer.")
(defun icomplete--vertical-minibuffer-setup ()
"Setup the minibuffer for vertical display of completion candidates."
(use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map
(current-local-map)))
(setq-local icomplete-separator "\n"
icomplete-hide-common-prefix nil
;; Ask `icomplete-completions' to return enough completions candidates.
icomplete-prospects-height 25
redisplay-adhoc-scroll-in-resize-mini-windows nil))
;;;###autoload
(define-minor-mode icomplete-vertical-mode
"Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
As many completion candidates as possible are displayed, depending on
the value of `max-mini-window-height', and the way the mini-window is
resized depends on `resize-mini-windows'."
:global t
(remove-hook 'icomplete-minibuffer-setup-hook
#'icomplete--vertical-minibuffer-setup)
(when icomplete-vertical-mode
(add-hook 'icomplete-minibuffer-setup-hook
#'icomplete--vertical-minibuffer-setup)))
@ -784,10 +815,13 @@ matches exist."
(if last (setcdr last base-size))
(if prospects
(concat determ
"{"
(mapconcat 'identity prospects icomplete-separator)
(and limit (concat icomplete-separator ellipsis))
"}")
(if icomplete-vertical-mode " \n" "{")
(mapconcat 'identity prospects (if icomplete-vertical-mode
"\n"
icomplete-separator))
(unless icomplete-vertical-mode
(concat (and limit (concat icomplete-separator ellipsis))
"}")))
(concat determ " [Matched]"))))))
;;; Iswitchb compatibility

3
lisp/image-mode.el
View file

@ -713,8 +713,7 @@ Key bindings:
Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
to switch back to `image-mode' and display an image file as the
actual image."
nil (:eval (if image-type (format " Image[%s]" image-type) " Image"))
image-minor-mode-map
:lighter (:eval (if image-type (format " Image[%s]" image-type) " Image"))
:group 'image
:version "22.1"
(if image-minor-mode

4
lisp/informat.el
View file

@ -1,4 +1,4 @@
;;; informat.el --- info support functions package for Emacs
;;; informat.el --- info support functions package for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc.
@ -140,7 +140,7 @@
(or (bolp)
(newline))
(insert "\^_\f\nTag table:\n")
(if (eq major-mode 'info-mode)
(if (derived-mode-p 'info-mode)
(move-marker Info-tag-table-marker (point)))
(setq tag-list (nreverse tag-list))
(while tag-list

6
lisp/international/ja-dic-cnv.el
View file

@ -323,11 +323,9 @@
(insert ")\n\n")))
(defun skkdic-convert (filename &optional dirname)
"Generate Emacs Lisp file form Japanese dictionary file FILENAME.
"Generate Emacs Lisp file from Japanese dictionary file FILENAME.
The format of the dictionary file should be the same as SKK dictionaries.
Optional argument DIRNAME if specified is the directory name under which
the generated Emacs Lisp is saved.
The name of generated file is specified by the variable `ja-dic-filename'."
Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
(interactive "FSKK dictionary file: ")
(let* ((skkbuf (get-buffer-create " *skkdic-unannotated*"))
(buf (get-buffer-create "*skkdic-work*")))

88
lisp/isearch.el
View file

@ -172,6 +172,29 @@ This allows you to resume earlier Isearch sessions through the
command history."
:type 'boolean)
(defcustom isearch-wrap-pause t
"Define the behavior of wrapping when there are no more matches.
When `t' (by default), signal an error when no more matches are found.
Then after repeating the search, wrap with `isearch-wrap-function'.
When `no', wrap immediately after reaching the last match.
When `no-ding', wrap immediately without flashing the screen.
When `nil', never wrap, just stop at the last match."
:type '(choice (const :tag "Pause before wrapping" t)
(const :tag "No pause before wrapping" no)
(const :tag "No pause and no flashing" no-ding)
(const :tag "Disable wrapping" nil))
:version "28.1")
(defcustom isearch-repeat-on-direction-change nil
"Whether a direction change should move to another match.
When `nil', the default, a direction change moves point to the other
end of the current search match.
When `t', a direction change moves to another search match, if there
is one."
:type '(choice (const :tag "Remain on the same match" nil)
(const :tag "Move to another match" t))
:version "28.1")
(defvar isearch-mode-hook nil
"Function(s) to call after starting up an incremental search.")
@ -1827,14 +1850,15 @@ Use `isearch-exit' to quit without signaling."
;; After taking the last element, adjust ring to previous one.
(isearch-ring-adjust1 nil))
;; If already have what to search for, repeat it.
(or isearch-success
(progn
;; Set isearch-wrapped before calling isearch-wrap-function
(setq isearch-wrapped t)
(if isearch-wrap-function
(funcall isearch-wrap-function)
(goto-char (if isearch-forward (point-min) (point-max)))))))
(unless (or isearch-success (null isearch-wrap-pause))
;; Set isearch-wrapped before calling isearch-wrap-function
(setq isearch-wrapped t)
(if isearch-wrap-function
(funcall isearch-wrap-function)
(goto-char (if isearch-forward (point-min) (point-max))))))
;; C-s in reverse or C-r in forward, change direction.
(if (and isearch-other-end isearch-repeat-on-direction-change)
(goto-char isearch-other-end))
(setq isearch-forward (not isearch-forward)
isearch-success t))
@ -1844,7 +1868,8 @@ Use `isearch-exit' to quit without signaling."
(setq isearch-success t)
;; For the case when count > 1, don't keep intermediate states
;; added to isearch-cmds by isearch-push-state in this loop.
(let ((isearch-cmds isearch-cmds))
(let ((isearch-cmds isearch-cmds)
(was-success isearch-success))
(while (<= 0 (setq count (1- (or count 1))))
(if (and isearch-success
(equal (point) isearch-other-end)
@ -1859,13 +1884,26 @@ Use `isearch-exit' to quit without signaling."
(forward-char (if isearch-forward 1 -1))
(isearch-search))
(isearch-search))
(when (> count 0)
;; Update isearch-cmds, so if isearch-search fails later,
;; it can restore old successful state from isearch-cmds.
(isearch-push-state))
;; Stop looping on failure.
(when (or (not isearch-success) isearch-error)
(setq count 0)))))
(when (> count 0)
;; Update isearch-cmds, so if isearch-search fails later,
;; it can restore old successful state from isearch-cmds.
(isearch-push-state))
(cond
;; Wrap immediately and repeat the search again
((memq isearch-wrap-pause '(no no-ding))
(if isearch-success
(setq was-success isearch-success)
;; If failed this time after succeeding last time
(when was-success
(setq was-success nil)
(setq count (1+ count)) ;; Increment to force repeat
(setq isearch-wrapped t)
(if isearch-wrap-function
(funcall isearch-wrap-function)
(goto-char (if isearch-forward (point-min) (point-max)))))))
;; Stop looping on failure
(t (when (or (not isearch-success) isearch-error)
(setq count 0)))))))
(isearch-push-state)
(isearch-update))
@ -1884,10 +1922,12 @@ of the buffer, type \\[isearch-beginning-of-buffer] with a numeric argument."
(cond ((< count 0)
(isearch-repeat-backward (abs count))
;; Reverse the direction back
(isearch-repeat 'forward))
(let ((isearch-repeat-on-direction-change nil))
(isearch-repeat 'forward)))
(t
;; Take into account one iteration to reverse direction
(when (not isearch-forward) (setq count (1+ count)))
(unless isearch-repeat-on-direction-change
(when (not isearch-forward) (setq count (1+ count))))
(isearch-repeat 'forward count))))
(isearch-repeat 'forward)))
@ -1905,10 +1945,12 @@ of the buffer, type \\[isearch-end-of-buffer] with a numeric argument."
(cond ((< count 0)
(isearch-repeat-forward (abs count))
;; Reverse the direction back
(isearch-repeat 'backward))
(let ((isearch-repeat-on-direction-change nil))
(isearch-repeat 'backward)))
(t
;; Take into account one iteration to reverse direction
(when isearch-forward (setq count (1+ count)))
(unless isearch-repeat-on-direction-change
(when isearch-forward (setq count (1+ count))))
(isearch-repeat 'backward count))))
(isearch-repeat 'backward)))
@ -3012,6 +3054,10 @@ See more for options in `search-exit-option'."
(goto-char isearch-pre-move-point))
(isearch-search-and-update)))
(setq isearch-pre-move-point nil))
;; Terminate the search if point has moved to another buffer.
(unless (eq isearch--current-buffer (current-buffer))
(when (buffer-live-p isearch--current-buffer)
(with-current-buffer isearch--current-buffer (isearch-exit))))
(force-mode-line-update))
(defun isearch-quote-char (&optional count)
@ -3488,10 +3534,10 @@ Optional third argument, if t, means if fail just return nil (no error).
;; stack overflow in regexp search.
(setq isearch-error (format "%s" lossage))))
(if isearch-success
nil
(unless isearch-success
;; Ding if failed this time after succeeding last time.
(and (isearch--state-success (car isearch-cmds))
(not (eq isearch-wrap-pause 'no-ding))
(ding))
(if (functionp (isearch--state-pop-fun (car isearch-cmds)))
(funcall (isearch--state-pop-fun (car isearch-cmds))

27
lisp/jka-compr.el
View file

@ -1,7 +1,6 @@
;;; jka-compr.el --- reading/writing/loading compressed files
;;; jka-compr.el --- reading/writing/loading compressed files -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation,
;; Inc.
;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
;; Author: Jay K. Adams <jka@ece.cmu.edu>
;; Maintainer: emacs-devel@gnu.org
@ -120,7 +119,7 @@ data appears to be compressed already.")
(widen) (erase-buffer)
(insert (format "Error while executing \"%s %s < %s\"\n\n"
prog
(mapconcat 'identity args " ")
(mapconcat #'identity args " ")
infile))
(and errfile
@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning."
(format
"%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s"
prog
(mapconcat 'identity args " ")
(mapconcat #'identity args " ")
err-file
jka-compr-dd-program
jka-compr-dd-blocksize
@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning."
"-c"
(format "%s %s 2> %s %s"
prog
(mapconcat 'identity args " ")
(mapconcat #'identity args " ")
err-file
(if (stringp output)
(concat "> " output)
@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning."
(jka-compr-error prog args infile message err-file))
(delete-file err-file)))
(or (eq 0
(apply 'call-process
(apply #'call-process
prog infile (if (stringp output) temp output)
nil args))
(jka-compr-error prog args infile message))
@ -622,12 +621,12 @@ There should be no more than seven characters after the final `/'."
(substring file 0 (string-match (jka-compr-info-regexp info) file)))
file)))
(put 'write-region 'jka-compr 'jka-compr-write-region)
(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
(put 'load 'jka-compr 'jka-compr-load)
(put 'write-region 'jka-compr #'jka-compr-write-region)
(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents)
(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy)
(put 'load 'jka-compr #'jka-compr-load)
(put 'byte-compiler-base-file-name 'jka-compr
'jka-compr-byte-compiler-base-file-name)
#'jka-compr-byte-compiler-base-file-name)
;;;###autoload
(defvar jka-compr-inhibit nil
@ -649,7 +648,7 @@ It is not recommended to set this variable permanently to anything but nil.")
;; to prevent the primitive from calling our handler again.
(defun jka-compr-run-real-handler (operation args)
(let ((inhibit-file-name-handlers
(cons 'jka-compr-handler
(cons #'jka-compr-handler
(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
@ -674,7 +673,7 @@ by `jka-compr-installed'."
(last fnha))
(while (cdr last)
(if (eq (cdr (car (cdr last))) 'jka-compr-handler)
(if (eq (cdr (car (cdr last))) #'jka-compr-handler)
(setcdr last (cdr (cdr last)))
(setq last (cdr last))))

2
lisp/loadhist.el
View file

@ -1,4 +1,4 @@
;;; loadhist.el --- lisp functions for working with feature groups
;;; loadhist.el --- lisp functions for working with feature groups -*- lexical-binding: t -*-
;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc.

18
lisp/loadup.el
View file

@ -1,4 +1,4 @@
;;; loadup.el --- load up standardly loaded Lisp files for Emacs
;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@ -112,7 +112,7 @@
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
(setq purify-flag (make-hash-table :test 'equal :size 80000)))
(setq purify-flag (make-hash-table :test #'equal :size 80000)))
(message "Using load-path %s" load-path)
@ -134,7 +134,7 @@
;; Do it after subr, since both after-load-functions and add-hook are
;; implemented in subr.el.
(add-hook 'after-load-functions (lambda (f) (garbage-collect)))
(add-hook 'after-load-functions (lambda (_) (garbage-collect)))
(load "version")
@ -151,7 +151,7 @@
;; variable its advertised default value (it starts as nil, see
;; xdisp.c).
(setq resize-mini-windows 'grow-only)
(setq load-source-file-function 'load-with-code-conversion)
(setq load-source-file-function #'load-with-code-conversion)
(load "files")
;; Load-time macro-expansion can only take effect after setting
@ -187,7 +187,7 @@
;; In case loaddefs hasn't been generated yet.
(file-error (load "ldefs-boot.el")))
(let ((new (make-hash-table :test 'equal)))
(let ((new (make-hash-table :test #'equal)))
;; Now that loaddefs has populated definition-prefixes, purify its contents.
(maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
definition-prefixes)
@ -400,7 +400,7 @@ lost after dumping")))
emacs-repository-branch (ignore-errors (emacs-repository-get-branch)))
;; A constant, so we shouldn't change it with `setq'.
(defconst emacs-build-number
(if versions (1+ (apply 'max versions)) 1))))
(if versions (1+ (apply #'max versions)) 1))))
(message "Finding pointers to doc strings...")
@ -430,11 +430,11 @@ lost after dumping")))
;; We keep the load-history data in PURE space.
;; Make sure that the spine of the list is not in pure space because it can
;; be destructively mutated in lread.c:build_load_history.
(setq load-history (mapcar 'purecopy load-history))
(setq load-history (mapcar #'purecopy load-history))
(set-buffer-modified-p nil)
(remove-hook 'after-load-functions (lambda (f) (garbage-collect)))
(remove-hook 'after-load-functions (lambda (_) (garbage-collect)))
(if (boundp 'load--prefer-newer)
(progn
@ -584,7 +584,7 @@ lost after dumping")))
;; (or load-file-name byte-compile-current-file).
(setq load-true-file-name nil)
(setq load-file-name nil)
(eval top-level)
(eval top-level t)
;; Local Variables:

2
lisp/mail/rmailmm.el
View file

@ -1402,7 +1402,7 @@ are handled according to `rmail-mime-media-type-handlers-alist'.
By default, this displays text and multipart messages, and offers to
download attachments as specified by `rmail-mime-attachment-dirs-alist'.
The arguments ARG and STATE have no effect in this case."
(interactive (list current-prefix-arg nil))
(interactive)
(if rmail-enable-mime
(with-current-buffer rmail-buffer
(if (or (rmail-mime-message-p)

40
lisp/mh-e/mh-search.el
View file

@ -274,23 +274,23 @@ folder containing the index search results."
t)))
;; Copy the search results over.
(maphash #'(lambda (folder msgs)
(let ((cur (car (mh-translate-range folder "cur")))
(msgs (sort (cl-loop
for msg being the hash-keys of msgs
collect msg)
#'<)))
(mh-exec-cmd "refile" msgs "-src" folder
"-link" index-folder)
;; Restore cur to old value, that refile changed
(when cur
(mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
"-sequence"
"cur" (format "%s" cur)))
(cl-loop for msg in msgs
do (cl-incf result-count)
(setf (gethash result-count origin-map)
(cons folder msg)))))
(maphash (lambda (folder msgs)
(let ((cur (car (mh-translate-range folder "cur")))
(msgs (sort (cl-loop
for msg being the hash-keys of msgs
collect msg)
#'<)))
(mh-exec-cmd "refile" msgs "-src" folder
"-link" index-folder)
;; Restore cur to old value, that refile changed
(when cur
(mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
"-sequence"
"cur" (format "%s" cur)))
(cl-loop for msg in msgs
do (cl-incf result-count)
(setf (gethash result-count origin-map)
(cons folder msg)))))
folder-results-map)
;; Vist the results folder.
@ -1136,10 +1136,10 @@ REGEXP-LIST is an alist of fields and values."
((atom (cadr expr)) `(or (and ,expr)))
((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
`(or ,@(mapcar #'(lambda (x) `(not ,x))
`(or ,@(mapcar (lambda (x) `(not ,x))
(cdadr expr)))))
((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
`(and ,@(mapcar #'(lambda (x) `(not ,x))
`(and ,@(mapcar (lambda (x) `(not ,x))
(cdadr expr)))))
(t (error "Unreachable: %s" expr))))
@ -1620,7 +1620,7 @@ garbled."
(cl-loop for seq in seq-list
do (apply #'mh-exec-cmd "mark" mh-current-folder
"-sequence" (symbol-name (car seq)) "-add"
(mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
(mapcar (lambda (x) (format "%s" x)) (cdr seq))))))
;;;###mh-autoload
(defun mh-create-sequence-map (seq-list)

36
lisp/mh-e/mh-thread.el
View file

@ -233,7 +233,7 @@ sibling."
(push index msg-list)))
(forward-line))
(mh-scan-folder mh-current-folder
(mapcar #'(lambda (x) (format "%s" x))
(mapcar (lambda (x) (format "%s" x))
(mh-coalesce-msg-list msg-list))
t))
(when mh-index-data
@ -591,7 +591,7 @@ Only information about messages in MSG-LIST are added to the tree."
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
"-width" "10000" "-format"
"%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
folder (mapcar (lambda (x) (format "%s" x)) msg-list)))
(goto-char (point-min))
(let ((roots ())
(case-fold-search t))
@ -635,9 +635,9 @@ Only information about messages in MSG-LIST are added to the tree."
(mh-thread-remove-parent-link id)
(mh-thread-add-link (car ancestors) id)))
(mh-thread-add-link (car ancestors) (cadr ancestors)))))))
(maphash #'(lambda (_k v)
(when (null (mh-container-parent v))
(push v roots)))
(maphash (lambda (_k v)
(when (null (mh-container-parent v))
(push v roots)))
mh-thread-id-table)
(setq roots (mh-thread-prune-containers roots))
(prog1 (setq roots (mh-thread-group-by-subject roots))
@ -720,25 +720,25 @@ For now it will take the last string inside angles."
mh-thread-history)
(mh-thread-remove-parent-link node)))))
(let ((results ()))
(maphash #'(lambda (_k v)
(when (and (null (mh-container-parent v))
(gethash (mh-message-id (mh-container-message v))
mh-thread-id-index-map))
(push v results)))
(maphash (lambda (_k v)
(when (and (null (mh-container-parent v))
(gethash (mh-message-id (mh-container-message v))
mh-thread-id-index-map))
(push v results)))
mh-thread-id-table)
(mh-thread-sort-containers results))))
(defun mh-thread-sort-containers (containers)
"Sort a list of message CONTAINERS to be in ascending order wrt index."
(sort containers
#'(lambda (x y)
(when (and (mh-container-message x) (mh-container-message y))
(let* ((id-x (mh-message-id (mh-container-message x)))
(id-y (mh-message-id (mh-container-message y)))
(index-x (gethash id-x mh-thread-id-index-map))
(index-y (gethash id-y mh-thread-id-index-map)))
(and (integerp index-x) (integerp index-y)
(< index-x index-y)))))))
(lambda (x y)
(when (and (mh-container-message x) (mh-container-message y))
(let* ((id-x (mh-message-id (mh-container-message x)))
(id-y (mh-message-id (mh-container-message y)))
(index-x (gethash id-x mh-thread-id-index-map))
(index-y (gethash id-y mh-thread-id-index-map)))
(and (integerp index-x) (integerp index-y)
(< index-x index-y)))))))
(defvar mh-thread-last-ancestor)

4
lisp/mh-e/mh-utils.el
View file

@ -544,8 +544,8 @@ nested folders within them."
(mh-sub-folders-actual folder)))
(t match))))
(if add-trailing-slash-flag
(mapcar #'(lambda (x)
(if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
(mapcar (lambda (x)
(if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
sub-folders)
sub-folders)))

13
lisp/minibuffer.el
View file

@ -488,8 +488,17 @@ for use at QPOS."
(qsuffix (cdr action))
(ufull (if (zerop (length qsuffix)) ustring
(funcall unquote (concat string qsuffix))))
(_ (cl-assert (string-prefix-p ustring ufull)))
(usuffix (substring ufull (length ustring)))
;; If (not (string-prefix-p ustring ufull)) we have a problem:
;; the unquoting the qfull gives something "unrelated" to ustring.
;; E.g. "~/" and "/" where "~//" gets unquoted to just "/" (see
;; bug#47678).
;; In that case we can't even tell if we're right before the
;; "/" or right after it (aka if this "/" is from qstring or
;; from qsuffix), which which usuffix to use is very unclear.
(usuffix (if (string-prefix-p ustring ufull)
(substring ufull (length ustring))
;; FIXME: Maybe "" is preferable/safer?
qsuffix))
(boundaries (completion-boundaries ustring table pred usuffix))
(qlboundary (car (funcall requote (car boundaries) string)))
(qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.

28
lisp/misearch.el
View file

@ -1,4 +1,4 @@
;;; misearch.el --- isearch extensions for multi-buffer search
;;; misearch.el --- isearch extensions for multi-buffer search -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@ -28,6 +28,8 @@
;;; Code:
(require 'cl-lib)
;;; Search multiple buffers
;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup)
@ -40,8 +42,7 @@
(defcustom multi-isearch-search t
"Non-nil enables searching multiple related buffers, in certain modes."
:type 'boolean
:version "23.1"
:group 'multi-isearch)
:version "23.1")
(defcustom multi-isearch-pause t
"A choice defining where to pause the search.
@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string."
(const :tag "Don't pause" nil)
(const :tag "Only in initial buffer" initial)
(const :tag "All buffers" t))
:version "23.1"
:group 'multi-isearch)
:version "23.1")
;;;###autoload
(defvar multi-isearch-next-buffer-function nil
@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'."
(default-value 'isearch-wrap-function)
multi-isearch-orig-push-state
(default-value 'isearch-push-state-function))
(setq-default isearch-search-fun-function 'multi-isearch-search-fun
isearch-wrap-function 'multi-isearch-wrap
isearch-push-state-function 'multi-isearch-push-state)
(add-hook 'isearch-mode-end-hook 'multi-isearch-end)))
(setq-default isearch-search-fun-function #'multi-isearch-search-fun
isearch-wrap-function #'multi-isearch-wrap
isearch-push-state-function #'multi-isearch-push-state)
(add-hook 'isearch-mode-end-hook #'multi-isearch-end)))
(defun multi-isearch-end ()
"Clean up the multi-buffer search after terminating isearch."
@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'."
(setq-default isearch-search-fun-function multi-isearch-orig-search-fun
isearch-wrap-function multi-isearch-orig-wrap
isearch-push-state-function multi-isearch-orig-push-state)
(remove-hook 'isearch-mode-end-hook 'multi-isearch-end))
(remove-hook 'isearch-mode-end-hook #'multi-isearch-end))
(defun multi-isearch-search-fun ()
"Return the proper search function, for isearch in multiple buffers."
@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
(while (not (string-equal
(setq buf (read-buffer (multi-occur--prompt) nil t))
""))
(add-to-list 'bufs buf)
(cl-pushnew buf bufs :test #'equal)
(setq ido-ignore-item-temp-list bufs))
(nreverse bufs)))
@ -322,7 +322,7 @@ Every next/previous file in the defined sequence is visited by
default-directory
default-directory))
default-directory))
(add-to-list 'files file))
(cl-pushnew file files :test #'equal))
(nreverse files)))
;; A regexp is not the same thing as a file glob - does this matter?
@ -381,7 +381,7 @@ whose file names match the specified wildcard."
(defun multi-isearch-unload-function ()
"Remove autoloaded variables from `unload-function-defs-list'.
Also prevent the feature from being reloaded via `isearch-mode-hook'."
(remove-hook 'isearch-mode-hook 'multi-isearch-setup)
(remove-hook 'isearch-mode-hook #'multi-isearch-setup)
(let ((defs (list (car unload-function-defs-list)))
(auto '(multi-isearch-next-buffer-function
multi-isearch-next-buffer-current-function
@ -395,7 +395,7 @@ Also prevent the feature from being reloaded via `isearch-mode-hook'."
;; .
nil))
(defalias 'misearch-unload-function 'multi-isearch-unload-function)
(defalias 'misearch-unload-function #'multi-isearch-unload-function)
(provide 'multi-isearch)

79
lisp/msb.el
View file

@ -1,4 +1,4 @@
;;; msb.el --- customizable buffer-selection with multiple menus
;;; msb.el --- customizable buffer-selection with multiple menus -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc.
@ -252,14 +252,12 @@ error every time you do \\[msb]."
:type `(choice (const :tag "long" :value ,msb--very-many-menus)
(const :tag "short" :value ,msb--few-menus)
(sexp :tag "user"))
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defcustom msb-modes-key 4000
"The sort key for files sorted by mode."
:type 'integer
:set 'msb-custom-set
:group 'msb
:set #'msb-custom-set
:version "20.3")
(defcustom msb-separator-diff 100
@ -267,8 +265,7 @@ error every time you do \\[msb]."
The separators will appear between all menus that have a sorting key
that differs by this value or more."
:type '(choice integer (const nil))
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defvar msb-files-by-directory-sort-key 0
"The sort key for files sorted by directory.")
@ -278,8 +275,7 @@ that differs by this value or more."
If this variable is set to 15 for instance, then the submenu will be
split up in minor parts, 15 items each. A value of nil means no limit."
:type '(choice integer (const nil))
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defcustom msb-max-file-menu-items 10
"The maximum number of items from different directories.
@ -293,27 +289,23 @@ them together.
If the value is not a number, then the value 10 is used."
:type 'integer
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defcustom msb-most-recently-used-sort-key -1010
"Where should the menu with the most recently used buffers be placed?"
:type 'integer
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defcustom msb-display-most-recently-used 15
"How many buffers should be in the most-recently-used menu.
No buffers at all if less than 1 or nil (or any non-number)."
:type 'integer
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defcustom msb-most-recently-used-title "Most recently used (%d)"
"The title for the most-recently-used menu."
:type 'string
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defvar msb-horizontal-shift-function (lambda () 0)
"Function that specifies how many pixels to shift the top menu leftwards.")
@ -323,8 +315,7 @@ No buffers at all if less than 1 or nil (or any non-number)."
Non-nil means that the buffer menu should include buffers that have
names that starts with a space character."
:type 'boolean
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defvar msb-item-handling-function 'msb-item-handler
"The appearance of a buffer menu.
@ -354,15 +345,13 @@ Set this to nil or t if you don't want any sorting (faster)."
:type '(choice (const msb-sort-by-name)
(const :tag "Newest first" t)
(const :tag "Oldest first" nil))
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(defcustom msb-files-by-directory nil
"Non-nil means that files should be sorted by directory.
This is instead of the groups in `msb-menu-cond'."
:type 'boolean
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(define-obsolete-variable-alias 'msb-after-load-hooks
'msb-after-load-hook "24.1")
@ -370,8 +359,7 @@ This is instead of the groups in `msb-menu-cond'."
(defcustom msb-after-load-hook nil
"Hook run after the msb package has been loaded."
:type 'hook
:set 'msb-custom-set
:group 'msb)
:set #'msb-custom-set)
(make-obsolete-variable 'msb-after-load-hook
"use `with-eval-after-load' instead." "28.1")
@ -458,10 +446,10 @@ An item look like (NAME . BUFFER)."
;;;
;;; msb
;;;
;;; This function can be used instead of (mouse-buffer-menu EVENT)
;;; function in "mouse.el".
;;;
;;
;; This function can be used instead of (mouse-buffer-menu EVENT)
;; function in "mouse.el".
;;
(defun msb (event)
"Pop up several menus of buffers for selection with the mouse.
This command switches buffers in the window that you clicked on, and
@ -707,7 +695,7 @@ See `msb-menu-cond' for a description of its elements."
(cl-loop for fi
across function-info-vector
if (and (setq result
(eval (aref fi 1))) ;Test CONDITION
(eval (aref fi 1) t)) ;Test CONDITION
(not (and (eq result 'no-multi)
multi-flag))
(progn (when (eq result 'multi)
@ -727,12 +715,11 @@ All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
to the buffer-list variable in FUNCTION-INFO."
(let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
;; Here comes the hairy side-effect!
(set list-symbol
(cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER
buffer
max-buffer-name-length)
buffer)
(eval list-symbol)))))
(push (cons (funcall (aref function-info 4) ;ITEM-HANDLER
buffer
max-buffer-name-length)
buffer)
(symbol-value list-symbol))))
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
"Select the appropriate menu for BUFFER."
@ -754,7 +741,7 @@ to the buffer-list variable in FUNCTION-INFO."
(defun msb--create-sort-item (function-info)
"Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
(let ((buffer-list (eval (aref function-info 0))))
(let ((buffer-list (symbol-value (aref function-info 0))))
(when buffer-list
(let ((sorter (aref function-info 5)) ;SORTER
(sort-key (aref function-info 2))) ;MENU-SORT-KEY
@ -925,7 +912,7 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
for value = (msb--create-sort-item elt)
if value collect value))))
(setq menu
(mapcar 'cdr ;Remove the SORT-KEY
(mapcar #'cdr ;Remove the SORT-KEY
;; Sort the menus - not the items.
(msb--add-separators
(sort
@ -1113,8 +1100,8 @@ variable `msb-menu-cond'."
(nconc
(list (frame-parameter frame 'name)
(frame-parameter frame 'name))
`(lambda ()
(interactive) (menu-bar-select-frame ,frame))))
(lambda ()
(interactive) (menu-bar-select-frame frame))))
frames)))))
(setcdr global-buffers-menu-map
(if (and buffers-menu frames-menu)
@ -1128,7 +1115,7 @@ variable `msb-menu-cond'."
;; C-down-mouse-1).
(defvar msb-mode-map
(let ((map (make-sparse-keymap "Msb")))
(define-key map [remap mouse-buffer-menu] 'msb)
(define-key map [remap mouse-buffer-menu] #'msb)
map))
;;;###autoload
@ -1137,14 +1124,14 @@ variable `msb-menu-cond'."
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'."
:global t :group 'msb
:global t
(if msb-mode
(progn
(add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
(remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
(add-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
(remove-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
(msb-menu-bar-update-buffers t))
(remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
(remove-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
(add-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
(menu-bar-update-buffers t)))
(defun msb-unload-function ()

10
lisp/net/eww.el
View file

@ -987,6 +987,7 @@ the like."
(define-key map "F" 'eww-toggle-fonts)
(define-key map "D" 'eww-toggle-paragraph-direction)
(define-key map [(meta C)] 'eww-toggle-colors)
(define-key map [(meta I)] 'eww-toggle-images)
(define-key map "b" 'eww-add-bookmark)
(define-key map "B" 'eww-list-bookmarks)
@ -1015,6 +1016,7 @@ the like."
["List cookies" url-cookie-list t]
["Toggle fonts" eww-toggle-fonts t]
["Toggle colors" eww-toggle-colors t]
["Toggle images" eww-toggle-images t]
["Character Encoding" eww-set-character-encoding]
["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
map))
@ -1893,6 +1895,14 @@ If CHARSET is nil then use UTF-8."
"off"))
(eww-reload))
(defun eww-toggle-images ()
"Toggle whether or not to display images."
(interactive nil eww-mode)
(setq shr-inhibit-images (not shr-inhibit-images))
(eww-reload)
(message "Images are now %s"
(if shr-inhibit-images "off" "on")))
;;; Bookmarks code
(defvar eww-bookmarks nil)

8
lisp/net/goto-addr.el
View file

@ -263,9 +263,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
;;;###autoload
(define-minor-mode goto-address-mode
"Minor mode to buttonize URLs and e-mail addresses in the current buffer."
nil
""
nil
:lighter ""
(if goto-address-mode
(jit-lock-register #'goto-address-fontify-region)
(jit-lock-unregister #'goto-address-fontify-region)
@ -285,9 +283,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
;;;###autoload
(define-minor-mode goto-address-prog-mode
"Like `goto-address-mode', but only for comments and strings."
nil
""
nil
:lighter ""
(if goto-address-prog-mode
(jit-lock-register #'goto-address-fontify-region)
(jit-lock-unregister #'goto-address-fontify-region)

12
lisp/net/net-utils.el
View file

@ -857,9 +857,14 @@ and `network-connection-service-alist', which see."
;; FIXME: modern whois clients include a much better tld <-> whois server
;; list, Emacs should probably avoid specifying the server as the client
;; will DTRT anyway... -rfr
;; I'm not sure about the above FIXME. It seems to me that we should
;; just check the Root Zone Database maintained at:
;; https://www.iana.org/domains/root/db
;; For example: whois -h whois.iana.org .se | grep whois
(defcustom whois-server-tld
'(("rs.internic.net" . "com")
("whois.publicinterestregistry.net" . "org")
'(("whois.verisign-grs.com" . "com")
("whois.verisign-grs.com" . "net")
("whois.pir.org" . "org")
("whois.ripe.net" . "be")
("whois.ripe.net" . "de")
("whois.ripe.net" . "dk")
@ -867,10 +872,13 @@ and `network-connection-service-alist', which see."
("whois.ripe.net" . "fi")
("whois.ripe.net" . "fr")
("whois.ripe.net" . "uk")
("whois.iis.se" . "se")
("whois.iis.nu" . "nu")
("whois.apnic.net" . "au")
("whois.apnic.net" . "ch")
("whois.apnic.net" . "hk")
("whois.apnic.net" . "jp")
("whois.eu" . "eu")
("whois.nic.gov" . "gov")
("whois.nic.mil" . "mil"))
"Alist to map top level domains to whois servers."

7
lisp/net/rcirc.el
View file

@ -196,7 +196,7 @@ If nil, no maximum is applied."
Uninteresting lines are those whose responses are listed in
`rcirc-omit-responses'."
nil " Omit" nil
:lighter " Omit"
(if rcirc-omit-mode
(progn
(add-to-invisibility-spec '(rcirc-omit . nil))
@ -1359,9 +1359,7 @@ Create the buffer if it doesn't exist."
(define-minor-mode rcirc-multiline-minor-mode
"Minor mode for editing multiple lines in rcirc."
:init-value nil
:lighter " rcirc-mline"
:keymap rcirc-multiline-minor-mode-map
:global nil
(setq fill-column rcirc-max-message-length))
@ -1863,9 +1861,6 @@ This function does not alter the INPUT string."
;;;###autoload
(define-minor-mode rcirc-track-minor-mode
"Global minor mode for tracking activity in rcirc buffers."
:init-value nil
:lighter ""
:keymap rcirc-track-minor-mode-map
:global t
(or global-mode-string (setq global-mode-string '("")))
;; toggle the mode-line channel indicator

12
lisp/net/shr.el
View file

@ -183,8 +183,10 @@ temporarily blinks with this face."
"Face for <abbr> elements."
:version "27.1")
(defvar shr-inhibit-images nil
"If non-nil, inhibit loading images.")
(defcustom shr-inhibit-images nil
"If non-nil, inhibit loading images."
:version "28.1"
:type 'boolean)
(defvar shr-external-rendering-functions nil
"Alist of tag/function pairs used to alter how shr renders certain tags.
@ -313,6 +315,12 @@ DOM should be a parse tree as generated by
(* (frame-char-width) 2))
1))))
(max-specpdl-size max-specpdl-size)
;; `bidi-display-reordering' is supposed to be only used for
;; debugging purposes, but Shr's naïve filling algorithm
;; cannot cope with the complexity of RTL text in an LTR
;; paragraph, when a long line has been continued, and for
;; most scripts the character metrics don't change when they
;; are reordered, so... this is the best we could do :-(
bidi-display-reordering)
;; Adjust for max width specification.
(when (and shr-max-width

130
lisp/net/tramp-sh.el
View file

@ -169,7 +169,8 @@ The string is used in `tramp-methods'.")
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("-t" "-t")
("-o" "RemoteCommand='%l'") ("%h")))
("-o" "RemoteCommand=\"%l\"")
("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@ -225,7 +226,8 @@ The string is used in `tramp-methods'.")
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("-t" "-t")
("-o" "RemoteCommand='%l'") ("%h")))
("-o" "RemoteCommand=\"%l\"")
("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@ -389,14 +391,7 @@ The string is used in `tramp-methods'.")
(regexp-opt
'("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
"\\'")
nil ,(user-login-name)))
;; MS Windows Openssh client does not cooperate well with cmdproxy.
(when-let ((encoding-shell
(and (eq system-type 'windows-nt) (executable-find "powershell"))))
(add-to-list 'tramp-connection-properties
`(,(regexp-opt '("/sshx:" "/scpx:"))
"encoding-shell" ,encoding-shell))))
nil ,(user-login-name))))
;;;###tramp-autoload
(defconst tramp-completion-function-alist-rsh
@ -406,16 +401,34 @@ The string is used in `tramp-methods'.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-ssh
'((tramp-parse-rhosts "/etc/hosts.equiv")
`((tramp-parse-rhosts "/etc/hosts.equiv")
(tramp-parse-rhosts "/etc/shosts.equiv")
(tramp-parse-shosts "/etc/ssh_known_hosts")
(tramp-parse-sconfig "/etc/ssh_config")
;; On W32 systems, the ssh directory is located somewhere else.
(tramp-parse-shosts ,(expand-file-name
"ssh/ssh_known_hosts"
(or (and (eq system-type 'windows-nt)
(getenv "ProgramData"))
"/etc/")))
(tramp-parse-sconfig ,(expand-file-name
"ssh/ssh_config"
(or (and (eq system-type 'windows-nt)
(getenv "ProgramData"))
"/etc/")))
(tramp-parse-shostkeys "/etc/ssh2/hostkeys")
(tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
(tramp-parse-rhosts "~/.rhosts")
(tramp-parse-rhosts "~/.shosts")
(tramp-parse-shosts "~/.ssh/known_hosts")
(tramp-parse-sconfig "~/.ssh/config")
;; On W32 systems, the .ssh directory is located somewhere else.
(tramp-parse-shosts ,(expand-file-name
".ssh/known_hosts"
(or (and (eq system-type 'windows-nt)
(getenv "USERPROFILE"))
"~/")))
(tramp-parse-sconfig ,(expand-file-name
".ssh/config"
(or (and (eq system-type 'windows-nt)
(getenv "USERPROFILE"))
"~/")))
(tramp-parse-shostkeys "~/.ssh2/hostkeys")
(tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
"Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
@ -438,7 +451,7 @@ The string is used in `tramp-methods'.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-putty
`((tramp-parse-putty
,(if (memq system-type '(windows-nt))
,(if (eq system-type 'windows-nt)
"HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
"~/.putty/sessions")))
"Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.")
@ -491,7 +504,6 @@ shell from reading its init file."
'((tramp-login-prompt-regexp tramp-action-login)
(tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-no-job-control-regexp tramp-action-permission-denied)
(shell-prompt-pattern tramp-action-succeed)
(tramp-shell-prompt-pattern tramp-action-succeed)
(tramp-yesno-prompt-regexp tramp-action-yesno)
@ -949,7 +961,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p)
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
@ -1557,49 +1569,6 @@ ID-FORMAT valid values are `string' and `integer'."
(or (tramp-check-cached-permissions v ?r)
(tramp-run-test "-r" filename)))))
;; When the remote shell is started, it looks for a shell which groks
;; tilde expansion. Here, we assume that all shells which grok tilde
;; expansion will also provide a `test' command which groks `-nt' (for
;; newer than). If this breaks, tell me about it and I'll try to do
;; something smarter about it.
(defun tramp-sh-handle-file-newer-than-file-p (file1 file2)
"Like `file-newer-than-file-p' for Tramp files."
(cond ((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
(t ;; We are sure both files exist at this point. We try to
;; get the mtime of both files. If they are not equal to
;; the "dont-know" value, then we subtract the times and
;; obtain the result.
(let ((fa1 (file-attributes file1))
(fa2 (file-attributes file2)))
(if (and
(not
(tramp-compat-time-equal-p
(tramp-compat-file-attribute-modification-time fa1)
tramp-time-dont-know))
(not
(tramp-compat-time-equal-p
(tramp-compat-file-attribute-modification-time fa2)
tramp-time-dont-know)))
(time-less-p
(tramp-compat-file-attribute-modification-time fa2)
(tramp-compat-file-attribute-modification-time fa1))
;; If one of them is the dont-know value, then we can
;; still try to run a shell command on the remote host.
;; However, this only works if both files are Tramp
;; files and both have the same method, same user, same
;; host.
(unless (tramp-equal-remote file1 file2)
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p file1) file1 file2) nil
(tramp-error
v 'file-error
"Files %s and %s must have same method, user, host"
file1 file2)))
(with-parsed-tramp-file-name file1 nil
(tramp-run-test2
(tramp-get-test-nt-command v) file1 file2)))))))
;; Functions implemented using the basic functions above.
(defun tramp-sh-handle-file-directory-p (filename)
@ -3959,24 +3928,6 @@ Returns the exit code of the `test' program."
switch
(tramp-shell-quote-argument localname)))))
(defun tramp-run-test2 (format-string file1 file2)
"Run `test'-like program on the remote system, given FILE1, FILE2.
FORMAT-STRING contains the program name, switches, and place holders.
Returns the exit code of the `test' program. Barfs if the methods,
hosts, or files, disagree."
(unless (tramp-equal-remote file1 file2)
(with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
(tramp-error
v 'file-error
"tramp-run-test2 only implemented for same method, user, host")))
(with-parsed-tramp-file-name file1 v1
(with-parsed-tramp-file-name file1 v2
(tramp-send-command-and-check
v1
(format format-string
(tramp-shell-quote-argument v1-localname)
(tramp-shell-quote-argument v2-localname))))))
(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
@ -4865,6 +4816,8 @@ connection if a previous connection has died for some reason."
(setenv "HISTSIZE" "0"))))
(setenv "PROMPT_COMMAND")
(setenv "PS1" tramp-initial-end-of-output)
(unless (stringp tramp-encoding-shell)
(tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
(let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
;; We will apply `tramp-ssh-controlmaster-options'
@ -4876,23 +4829,17 @@ connection if a previous connection has died for some reason."
;; W32 systems.
(process-coding-system-alist nil)
(coding-system-for-read nil)
(encoding-shell
(tramp-get-connection-property
vec "encoding-shell" tramp-encoding-shell))
(extra-args (tramp-get-sh-extra-args encoding-shell))
(extra-args (tramp-get-sh-extra-args tramp-encoding-shell))
;; This must be done in order to avoid our file
;; name handler.
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(unless (stringp encoding-shell)
(tramp-error
vec 'file-error "`tramp-encoding-shell' not set"))
(apply
#'start-process
(tramp-get-connection-name vec)
(tramp-get-connection-buffer vec)
(append
(list encoding-shell)
(list tramp-encoding-shell)
(and extra-args (split-string extra-args))
(and tramp-encoding-command-interactive
(list tramp-encoding-command-interactive)))))))
@ -4911,7 +4858,8 @@ connection if a previous connection has died for some reason."
;; Check whether process is alive.
(tramp-barf-if-no-shell-prompt
p 10 "Couldn't find local shell prompt for %s" encoding-shell)
p 10
"Couldn't find local shell prompt for %s" tramp-encoding-shell)
;; Now do all the connections as specified.
(while target-alist
@ -4986,7 +4934,7 @@ connection if a previous connection has died for some reason."
?c (format-spec options (format-spec-make ?t tmpfile))
?l (concat remote-shell " " extra-args " -i"))
;; A restricted shell does not allow "exec".
(when r-shell '("; exit")))
(when r-shell '("&&" "exit" "||" "exit")))
" "))
;; Send the command.
@ -5834,7 +5782,7 @@ function cell is returned to be applied on a buffer."
;; slashes as directory separators.
(cond
((and (string-match-p "local" prop)
(memq system-type '(windows-nt)))
(eq system-type 'windows-nt))
"(%s | \"%s\")")
((string-match-p "local" prop) "(%s | %s)")
(t "(%s | %s >%%s)"))
@ -5845,7 +5793,7 @@ function cell is returned to be applied on a buffer."
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
(if (and (string-match-p "local" prop)
(memq system-type '(windows-nt)))
(eq system-type 'windows-nt))
"(%s <%%s | \"%s\")"
"(%s <%%s | %s)")
compress coding))

42
lisp/net/tramp.el
View file

@ -488,7 +488,7 @@ interpreted as a regular expression which always matches."
;; either lower case or upper case letters. See
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
(when (memq system-type '(windows-nt))
(when (eq system-type 'windows-nt)
(list (format "\\`\\(%s\\|%s\\)\\'"
(regexp-quote (downcase tramp-system-name))
(regexp-quote (upcase tramp-system-name)))))
@ -558,7 +558,7 @@ usually suffice.")
the remote shell.")
(defcustom tramp-local-end-of-line
(if (memq system-type '(windows-nt)) "\r\n" "\n")
(if (eq system-type 'windows-nt) "\r\n" "\n")
"String used for end of line in local processes."
:version "24.1"
:type 'string)
@ -691,15 +691,6 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
;; Powershell requires "ssh -t -t" for terminal emulation. If it
;; doesn't fit, there is an error.
(defcustom tramp-no-job-control-regexp
(regexp-quote "Thus no job control in this shell.")
"Regular expression matching powershell's job control message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-operation-not-permitted-regexp
(concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
(regexp-opt '("Operation not permitted") t))
@ -1087,7 +1078,13 @@ initial value is overwritten by the car of `tramp-file-name-structure'.")
(defconst tramp-completion-file-name-regexp-default
(concat
"\\`/\\("
"\\`"
;; `file-name-completion' uses absolute paths for matching. This
;; means that on W32 systems, something like "/ssh:host:~/path"
;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'.
(when (eq system-type 'windows-nt)
"\\(?:[[:alpha:]]:\\)?")
"/\\("
;; Optional multi hop.
"\\([^/|:]+:[^/|:]*|\\)*"
;; Last hop.
@ -1106,7 +1103,13 @@ On W32 systems, the volume letter must be ignored.")
(defconst tramp-completion-file-name-regexp-simplified
(concat
"\\`/\\("
"\\`"
;; Allow the volume letter at the beginning of the path. See the
;; comment in `tramp-completion-file-name-regexp-default' for more
;; details.
(when (eq system-type 'windows-nt)
"\\(?:[[:alpha:]]:\\)?")
"/\\("
;; Optional multi hop.
"\\([^/|:]*|\\)*"
;; Last hop.
@ -1122,7 +1125,14 @@ See `tramp-file-name-structure' for more explanations.
On W32 systems, the volume letter must be ignored.")
(defconst tramp-completion-file-name-regexp-separate
"\\`/\\(\\[[^]]*\\)?\\'"
(concat
"\\`"
;; Allow the volume letter at the beginning of the path. See the
;; comment in `tramp-completion-file-name-regexp-default' for more
;; details.
(when (eq system-type 'windows-nt)
"\\(?:[[:alpha:]]:\\)?")
"/\\(\\[[^]]*\\)?\\'")
"Value for `tramp-completion-file-name-regexp' for separate remoting.
See `tramp-file-name-structure' for more explanations.")
@ -3128,7 +3138,7 @@ User may be nil."
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
(if (memq system-type '(windows-nt))
(if (eq system-type 'windows-nt)
(with-tramp-connection-property nil "parse-putty"
(with-temp-buffer
(when (zerop (tramp-call-process
@ -4980,7 +4990,7 @@ VEC is used for tracing."
(let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
locale)
(with-temp-buffer
(unless (or (memq system-type '(windows-nt))
(unless (or (eq system-type 'windows-nt)
(not (zerop (tramp-call-process
nil "locale" nil t nil "-a"))))
(while candidates

2
lisp/obsolete/iswitchb.el
View file

@ -1336,7 +1336,7 @@ See the variable `iswitchb-case' for details."
Iswitchb mode is a global minor mode that enables switching
between buffers using substrings. See `iswitchb' for details."
nil nil iswitchb-global-map :global t
:keymap iswitchb-global-map :global t
(if iswitchb-mode
(add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)
(remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))

2
lisp/obsolete/pc-select.el
View file

@ -314,8 +314,6 @@ but before calling PC Selection mode):
C-BACKSPACE backward-kill-word
M-BACKSPACE undo"
;; FIXME: bring pc-bindings-mode here ?
nil nil nil
:global t
(if pc-selection-mode

2
lisp/org/org-capture.el
View file

@ -521,7 +521,7 @@ for a capture buffer.")
"Minor mode for special key bindings in a capture buffer.
Turning on this mode runs the normal hook `org-capture-mode-hook'."
nil " Cap" org-capture-mode-map
:lighter " Cap"
(setq-local
header-line-format
(substitute-command-keys

2
lisp/org/org-indent.el
View file

@ -167,7 +167,7 @@ properties, after each buffer modification, on the modified zone.
The process is synchronous. Though, initial indentation of
buffer, which can take a few seconds on large buffers, is done
during idle time."
nil " Ind" nil
:lighter " Ind"
(cond
(org-indent-mode
;; mode was turned on.

2
lisp/org/org-list.el
View file

@ -2304,7 +2304,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
;;;###autoload
(define-minor-mode org-list-checkbox-radio-mode
"When turned on, use list checkboxes as radio buttons."
nil " CheckBoxRadio" nil
:lighter " CheckBoxRadio"
(unless (eq major-mode 'org-mode)
(user-error "Cannot turn this mode outside org-mode buffers")))

2
lisp/org/org-src.el
View file

@ -682,7 +682,7 @@ This minor mode is turned on in two situations:
\\{org-src-mode-map}
See also `org-src-mode-hook'."
nil " OrgSrc" nil
:lighter " OrgSrc"
(when org-edit-src-persistent-message
(setq header-line-format
(substitute-command-keys

6
lisp/org/org-table.el
View file

@ -495,7 +495,7 @@ This may be useful when columns have been shrunk."
;;;###autoload
(define-minor-mode org-table-header-line-mode
"Display the first row of the table at point in the header line."
nil " TblHeader" nil
:lighter " TblHeader"
(unless (eq major-mode 'org-mode)
(user-error "Cannot turn org table header mode outside org-mode buffers"))
(if org-table-header-line-mode
@ -1976,7 +1976,7 @@ lines."
When this mode is active, the field editor window will always show the
current field. The mode exits automatically when the cursor leaves the
table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
nil " TblFollow" nil
:lighter " TblFollow"
(if org-table-follow-field-mode
(add-hook 'post-command-hook 'org-table-follow-fields-with-editor
'append 'local)
@ -5149,7 +5149,7 @@ When LOCAL is non-nil, show references for the table at point."
;;;###autoload
(define-minor-mode orgtbl-mode
"The Org mode table editor as a minor mode for use in other modes."
:lighter " OrgTbl" :keymap orgtbl-mode-map
:lighter " OrgTbl"
(org-load-modules-maybe)
(cond
((derived-mode-p 'org-mode)

2
lisp/org/org.el
View file

@ -15584,7 +15584,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
This mode supports entering LaTeX environment and math in LaTeX fragments
in Org mode.
\\{org-cdlatex-mode-map}"
nil " OCDL" nil
:lighter " OCDL"
(when org-cdlatex-mode
(require 'cdlatex)
(run-hooks 'cdlatex-mode-hook)

8
lisp/org/ox-beamer.el
View file

@ -895,14 +895,16 @@ holding export options."
;;; Minor Mode
(defvar org-beamer-mode-map (make-sparse-keymap)
(defvar org-beamer-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-b" 'org-beamer-select-environment)
map)
"The keymap for `org-beamer-mode'.")
(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
;;;###autoload
(define-minor-mode org-beamer-mode
"Support for editing Beamer oriented Org mode files."
nil " Bm" 'org-beamer-mode-map)
:lighter " Bm")
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords

5
lisp/outline.el
View file

@ -374,8 +374,9 @@ faces to major mode's faces."
"Toggle Outline minor mode.
See the command `outline-mode' for more information on this mode."
nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
(cons outline-minor-mode-prefix outline-mode-prefix-map))
:lighter " Outl"
:keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
(cons outline-minor-mode-prefix outline-mode-prefix-map))
(if outline-minor-mode
(progn
(when (or outline-minor-mode-cycle outline-minor-mode-highlight)

6
lisp/progmodes/bug-reference.el
View file

@ -440,9 +440,6 @@ and set it if applicable."
;;;###autoload
(define-minor-mode bug-reference-mode
"Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
nil
""
nil
:after-hook (bug-reference--run-auto-setup)
(if bug-reference-mode
(jit-lock-register #'bug-reference-fontify)
@ -454,9 +451,6 @@ and set it if applicable."
;;;###autoload
(define-minor-mode bug-reference-prog-mode
"Like `bug-reference-mode', but only buttonize in comments and strings."
nil
""
nil
:after-hook (bug-reference--run-auto-setup)
(if bug-reference-prog-mode
(jit-lock-register #'bug-reference-fontify)

Some files were not shown because too many files have changed in this diff Show more