procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk

Browse source
This commit is contained in:
Yuuki Harano 2021-04-18 15:30:29 +09:00
commit de46c7796e
265 changed files with 4707 additions and 3183 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/
@ -188,6 +189,7 @@ lib-src/make-docfile
lib-src/make-fingerprint
lib-src/movemail
lib-src/profile
lib-src/seccomp-filter
lib-src/test-distrib
lib-src/update-game-score
nextstep/Cocoa/Emacs.base/Contents/Info.plist
@ -302,5 +304,11 @@ nt/emacsclient.rc
src/gdb.ini
/var/
# Seccomp filter files.
lib-src/seccomp-filter.bpf
lib-src/seccomp-filter.pfc
lib-src/seccomp-filter-exec.bpf
lib-src/seccomp-filter-exec.pfc
# gsettings schema
/etc/*.gschema.valid

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"

27
configure.ac
View file

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

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/mini.texi
View file

@ -64,10 +64,10 @@ minibuffer-electric-default-mode}.
Since the minibuffer appears in the echo area, it can conflict with
other uses of the echo area. If an error message or an informative
message is emitted while the minibuffer is active, the message hides
the minibuffer for a few seconds, or until you type something; then
the minibuffer comes back. While the minibuffer is in use, Emacs does
not echo keystrokes.
message is emitted while the minibuffer is active, the message is
displayed in brackets after the minibuffer text for a few seconds, or
until you type something; then the message disappears. While the
minibuffer is in use, Emacs does not echo keystrokes.
@vindex minibuffer-follows-selected-frame
While using the minibuffer, you can switch to a different frame,

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

9
doc/lispref/control.texi
View file

@ -2012,7 +2012,8 @@ that can be handled).
This special form establishes the error handlers @var{handlers} around
the execution of @var{protected-form}. If @var{protected-form} executes
without error, the value it returns becomes the value of the
@code{condition-case} form; in this case, the @code{condition-case} has
@code{condition-case} form (in the absence of a success handler; see below).
In this case, the @code{condition-case} has
no effect. The @code{condition-case} form makes a difference when an
error occurs during @var{protected-form}.
@ -2062,6 +2063,12 @@ error description.
If @var{var} is @code{nil}, that means no variable is bound. Then the
error symbol and associated data are not available to the handler.
@cindex success handler
As a special case, one of the @var{handlers} can be a list of the
form @code{(:success @var{body}@dots{})}, where @var{body} is executed
with @var{var} (if non-@code{nil}) bound to the return value of
@var{protected-form} when that expression terminates without error.
@cindex rethrow a signal
Sometimes it is necessary to re-throw a signal caught by
@code{condition-case}, for some outer-level handler to catch. Here's

26
doc/lispref/display.texi
View file

@ -1965,9 +1965,18 @@ Tables}). The width of a tab character is usually @code{tab-width}
(@pxref{Usual Display}).
@end defun
@defun string-width string
@defun string-width string &optional from to
This function returns the width in columns of the string @var{string},
if it were displayed in the current buffer and the selected window.
Optional arguments @var{from} and @var{to} specify the substring of
@var{string} to consider, and are interpreted as in @code{substring}
(@pxref{Creating Strings}).
The return value is an approximation: it only considers the values
returned by @code{char-width} for the constituent characters, always
takes a tab character as taking @code{tab-width} columns, ignores
display properties and fonts, etc. For these reasons, we recommend
using @code{window-text-pixel-size}, described below, instead.
@end defun
@defun truncate-string-to-width string width &optional start-column padding ellipsis ellipsis-text-property
@ -4752,6 +4761,7 @@ window on a minibuffer-less frame.
@node Display Property
@section The @code{display} Property
@cindex display specification
@cindex display property
@kindex display @r{(text property)}
The @code{display} text property (or overlay property) is used to
@ -5289,6 +5299,16 @@ where @var{props} is a property list of alternating keyword symbols
and values, including at least the pair @code{:type @var{type}} that
specifies the image type.
Image descriptors which define image dimensions, @code{:width},
@code{:height}, @code{:max-width} and @code{:max-height}, may take
either an integer, which represents the dimension in pixels, or a pair
@code{(@var{value} . em)}, where @var{value} is the dimension's
length in @dfn{ems}@footnote{In typography an em is a distance
equivalent to the height of the type. For example when using 12 point
type 1 em is equal to 12 points. Its use ensures distances and type
remain proportional.}. One em is equivalent to the height of the font
and @var{value} may be an integer or a float.
The following is a list of properties that are meaningful for all
image types (there are also properties which are meaningful only for
certain image types, as documented in the following subsections):
@ -5758,13 +5778,13 @@ properties:
@item :foreground @var{foreground}
@var{foreground}, if non-@code{nil}, should be a string specifying a
color, which is used as the image's foreground color. If the value is
@code{nil}, it defaults to the faces's foreground color.
@code{nil}, it defaults to the current face's foreground color.
@item :background @var{background}
@var{background}, if non-@code{nil}, should be a string specifying a
color, which is used as the image's background color if the image
supports transparency. If the value is @code{nil}, it defaults to the
faces's background color.
current face's background color.
@item :css @var{css}
@var{css}, if non-@code{nil}, should be a string specifying the CSS to

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

2
doc/lispref/keymaps.texi
View file

@ -1686,7 +1686,7 @@ presence of such a binding can still prevent translation from taking place.
For example, let us return to our VT100 example above and add a binding for
@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c
@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c
@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}},
@key{PF1}} because it will stop reading keys right after @kbd{C-c @key{ESC}},
leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c
@key{ESC}}, in which case Emacs should not sit there waiting for the next key
to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}.

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

2
doc/lispref/objects.texi
View file

@ -2411,7 +2411,7 @@ that is evaluated. For example:
@noindent
Although the list @code{(0.5)} was mutable when it was created, it should not
have been changed via @code{setcar} because it given to @code{eval}. The
have been changed via @code{setcar} because it was given to @code{eval}. The
reverse does not occur: an object that should not be changed never
becomes mutable afterwards.

7
doc/lispref/processes.texi
View file

@ -1325,7 +1325,7 @@ the numeric ID of the foreground process group of @var{process}; it
returns @code{nil} if Emacs can be certain that this is not so. The
value is @code{t} if Emacs cannot tell whether this is true. This
function signals an error if @var{process} is a network, serial, or
pipe connection, or is the subprocess is not active.
pipe connection, or if the subprocess is not active.
@end defun
@node Signals to Processes
@ -3410,8 +3410,9 @@ Unsigned integer in little endian order, with @var{bitlen} bits.
@item str @var{len}
String of bytes of length @var{len}.
@item strz @var{len}
Zero-terminated string of bytes, in a fixed-size field with length @var{len}.
@item strz &optional @var{len}
Zero-terminated string of bytes, can be of arbitrary length or in a fixed-size
field with length @var{len}.
@item vec @var{len} [@var{type}]
Vector of @var{len} elements. The type of the elements is given by

4
doc/misc/eshell.texi
View file

@ -515,8 +515,8 @@ below the @code{completion-cycle-threshold}), press @kbd{M-?}.
@subsection pcomplete
Pcomplete, short for programmable completion, is the completion
library originally written for Eshell, but usable for command
completion@footnote{Command completion as opposed to code completion,
which is a beyond the scope of pcomplete.} in other modes.
completion@footnote{Command completion, as opposed to code completion,
which is beyond the scope of pcomplete.} in other modes.
Completions are defined as functions (with @code{defun}) named
@code{pcomplete/COMMAND}, where @code{COMMAND} is the name of the

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

163
doc/misc/message.texi
View file

@ -1792,8 +1792,89 @@ member list with elements @code{CC} and @code{To}, then
@code{message-carefully-insert-headers} will not insert a @code{To}
header when the message is already @code{CC}ed to the recipient.
@item message-syntax-checks
@vindex message-syntax-checks
Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
@lisp
(signature . disabled)
@end lisp
to this list.
Valid checks are:
@table @code
@item approved
@cindex approved
Check whether the article has an @code{Approved} header, which is
something only moderators should include.
@item continuation-headers
Check whether there are continuation header lines that don't begin with
whitespace.
@item control-chars
Check for invalid characters.
@item empty
Check whether the article is empty.
@item existing-newsgroups
Check whether the newsgroups mentioned in the @code{Newsgroups} and
@code{Followup-To} headers exist.
@item from
Check whether the @code{From} header seems nice.
@item illegible-text
Check whether there is any non-printable character in the body.
@item invisible-text
Check whether there is any invisible text in the buffer.
@item long-header-lines
Check for too long header lines.
@item long-lines
@cindex long lines
Check for too long lines in the body.
@item message-id
Check whether the @code{Message-ID} looks syntactically ok.
@item multiple-headers
Check for the existence of multiple equal headers.
@item new-text
Check whether there is any new text in the messages.
@item newsgroups
Check whether the @code{Newsgroups} header exists and is not empty.
@item quoting-style
Check whether text follows last quoted portion.
@item repeated-newsgroups
Check whether the @code{Newsgroups} and @code{Followup-To} headers
contains repeated group names.
@item reply-to
Check whether the @code{Reply-To} header looks ok.
@item sender
@cindex Sender
Insert a new @code{Sender} header if the @code{From} header looks odd.
@item sendsys
@cindex sendsys
Check for the existence of version and sendsys commands.
@item shoot
Check whether the domain part of the @code{Message-ID} header looks ok.
@item shorten-followup-to
Check whether to add a @code{Followup-To} header to shorten the number
of groups to post to.
@item signature
Check the length of the signature.
@item size
Check for excessive size.
@item subject
Check whether the @code{Subject} header exists and is not empty.
@item subject-cmsg
Check the subject for commands.
@item valid-newsgroups
Check whether the @code{Newsgroups} and @code{Followup-To} headers
are valid syntactically.
@end table
All these conditions are checked by default, except for @code{sender}
for which the check is disabled by default if
@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
@end table
@node Mail Headers
@section Mail Headers
@ -2072,88 +2153,6 @@ Other variables for customizing outgoing news articles:
@table @code
@item message-syntax-checks
@vindex message-syntax-checks
Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
@lisp
(signature . disabled)
@end lisp
to this list.
Valid checks are:
@table @code
@item approved
@cindex approved
Check whether the article has an @code{Approved} header, which is
something only moderators should include.
@item continuation-headers
Check whether there are continuation header lines that don't begin with
whitespace.
@item control-chars
Check for invalid characters.
@item empty
Check whether the article is empty.
@item existing-newsgroups
Check whether the newsgroups mentioned in the @code{Newsgroups} and
@code{Followup-To} headers exist.
@item from
Check whether the @code{From} header seems nice.
@item illegible-text
Check whether there is any non-printable character in the body.
@item invisible-text
Check whether there is any invisible text in the buffer.
@item long-header-lines
Check for too long header lines.
@item long-lines
@cindex long lines
Check for too long lines in the body.
@item message-id
Check whether the @code{Message-ID} looks syntactically ok.
@item multiple-headers
Check for the existence of multiple equal headers.
@item new-text
Check whether there is any new text in the messages.
@item newsgroups
Check whether the @code{Newsgroups} header exists and is not empty.
@item quoting-style
Check whether text follows last quoted portion.
@item repeated-newsgroups
Check whether the @code{Newsgroups} and @code{Followup-To} headers
contains repeated group names.
@item reply-to
Check whether the @code{Reply-To} header looks ok.
@item sender
@cindex Sender
Insert a new @code{Sender} header if the @code{From} header looks odd.
@item sendsys
@cindex sendsys
Check for the existence of version and sendsys commands.
@item shoot
Check whether the domain part of the @code{Message-ID} header looks ok.
@item shorten-followup-to
Check whether to add a @code{Followup-To} header to shorten the number
of groups to post to.
@item signature
Check the length of the signature.
@item size
Check for excessive size.
@item subject
Check whether the @code{Subject} header exists and is not empty.
@item subject-cmsg
Check the subject for commands.
@item valid-newsgroups
Check whether the @code{Newsgroups} and @code{Followup-To} headers
are valid syntactically.
@end table
All these conditions are checked by default, except for @code{sender}
for which the check is disabled by default if
@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
@item message-ignored-news-headers
@vindex message-ignored-news-headers
Regexp of headers to be removed before posting. The default is@*

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}

73
etc/NEWS
View file

@ -90,6 +90,17 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit
true color by setting 'COLORTERM=truecolor' in the environment. This is
useful on systems such as FreeBSD which ships only with "etc/termcap".
** Emacs now supports loading a Secure Computing filter.
This is supported only on capable GNU/Linux systems. To activate,
invoke Emacs with the '--seccomp=FILE' command-line option. FILE must
name a binary file containing an array of 'struct sock_filter'
structures. Emacs will then install that list of Secure Computing
filters into its own process early during the startup process. You
can use this functionality to put an Emacs process in a sandbox to
avoid security issues when executing untrusted code. See the manual
page for 'seccomp' system call, for details about Secure Computing
filters.
* Changes in Emacs 28.1
@ -264,6 +275,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
@ -367,6 +381,12 @@ trying to be non-destructive.
This command opens a new buffer called "*Memory Report*" and gives a
summary of where Emacs is using memory currently.
+++
** New user option 'isearch-repeat-on-direction-change'.
When this option is set, direction changes in Isearch move to another
search match, if there is one, instead of moving point to the other
end of the current match.
** Outline
+++
@ -477,6 +497,13 @@ documented.
SMIE is now always enabled and 'ruby-use-smie' only controls whether
indentation is done using SMIE or with the old ad-hoc code.
** Icomplete
+++
*** New minor mode Icomplete-Vertical mode.
This mode is intended to be used with Icomplete or Fido, to display the
list of completions candidates vertically instead of horizontally.
---
** Specific warnings can now be disabled from the warning buffer.
When a warning is displayed to the user, the resulting buffer now has
@ -929,6 +956,14 @@ take the actual screenshot, and defaults to "ImageMagick import".
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
** Search and Replace
*** New user option 'isearch-wrap-pause' defines how to wrap the search.
There are choices to disable wrapping completely and to wrap immediately.
When wrapping immediately, it consistently handles the numeric arguments
of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
continuing with the remaining count after wrapping.
** Grep
+++
@ -1524,6 +1559,13 @@ will match the font size in use where it is embedded.
This feature relies on librsvg 2.48 or above being available.
+++
*** Image properties support 'em' sizes.
Size image properties, for example ':height', ':max-height', etc., can
be given a cons of the form '(SIZE . em)', where SIZE is an integer or
float which is multiplied by the font size to calculate the image
size, and em is a symbol.
** EWW
+++
@ -2251,6 +2293,10 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
'M-g n n p p' to navigate next-error matches. Any other key exits
transient mode and then is executed normally. 'repeat-exit-key'
defines an additional key to exit mode like 'isearch-exit' ('RET').
With 'repeat-keep-prefix' you can keep the prefix arg of the previous command.
For example, this can help to reverse the window navigation direction
with e.g. 'C-x o M-- o o'. Also it can help to set a new step with
e.g. 'C-x { C-5 { { {' will set the window resizing step to 5 columns.
* New Modes and Packages in Emacs 28.1
@ -2327,6 +2373,11 @@ This is to keep the same behavior as Eshell.
* Incompatible Lisp Changes in Emacs 28.1
+++
** The use of positional arguments in 'define-minor-mode' is obsolete.
These were actually rendered obsolete in Emacs-21 but were never
marked as such.
** 'facemenu-color-alist' is now obsolete, and is not used.
** 'facemenu.el' is no longer preloaded.
@ -2390,11 +2441,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
@ -2511,6 +2557,12 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete',
** The 'values' variable is now obsolete.
+++
** The '&define' keyword in an Edebug specification now disables backtracking.
The implementation was buggy, and multiple &define forms in an &or
form should be exceedingly rare. See the Info node 'Backtracking' in
the Emacs Lisp reference manual for background.
* Lisp Changes in Emacs 28.1
@ -2619,6 +2671,11 @@ Modes that use 'truncate-string-to-width' with non-nil, non-string
argument ELLIPSIS, will now indicate truncation using '…' when
the selected frame can display it, and using "..." otherwise.
+++
** 'string-width' now accepts two optional arguments FROM and TO.
This allows calculating the width of a substring without consing a
new string.
+++
** New command 'make-directory-autoloads'.
This does the same as the old command 'update-directory-autoloads',
@ -2885,6 +2942,12 @@ arrays nor objects.
The special events 'dbus-event' and 'file-notify' are now ignored in
'while-no-input' when added to this variable.
+++
** 'condition-case' now allows for a success handler.
It is written as (:success BODY...) where BODY is executed whenever
the protected form terminates without error, with the specified
variable bound to the the value of the protected form.
* Changes in Emacs 28.1 on Non-Free Operating Systems

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);
}

2
lisp/align.el
View file

@ -1587,8 +1587,6 @@ aligner would have dealt with are."
(if report
(message "Aligning...done"))))
;; Provide:
(provide 'align)
(run-hooks 'align-load-hook)

1
lisp/allout-widgets.el
View file

@ -2290,7 +2290,6 @@ The elements of LIST are not copied, just the list structure itself."
(define-obsolete-function-alias 'allout-frame-property #'frame-parameter "28.1")
;;;_ : provide
(provide 'allout-widgets)
;;;_ . Local emacs vars.

1
lisp/allout.el
View file

@ -6457,7 +6457,6 @@ If BEG is bigger than END we return 0."
(isearch-repeat 'forward)
(isearch-mode t)))
;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.

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))))

5
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."
@ -937,7 +937,6 @@ the timer when no buffers need to be checked."
(cancel-timer auto-revert-timer))
(setq auto-revert-timer nil)))))
;; The end:
(provide 'autorevert)
(run-hooks 'auto-revert-load-hook)

1
lisp/bs.el
View file

@ -1504,7 +1504,6 @@ name of buffer configuration."
;; continue standard unloading
nil)
;; Now provide feature bs
(provide 'bs)
;;; bs.el ends here

12
lisp/calc/calc-alg.el
View file

@ -444,12 +444,12 @@ Code can refer to the expression to simplify via lexical variable `expr'
and should return the simplified expression to use (or nil)."
(declare (indent 1) (debug (sexp body)))
(cons 'progn
(mapcar #'(lambda (func)
`(put ',func 'math-simplify
(nconc
(get ',func 'math-simplify)
(list
#'(lambda (expr) ,@code)))))
(mapcar (lambda (func)
`(put ',func 'math-simplify
(nconc
(get ',func 'math-simplify)
(list
(lambda (expr) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(math-defsimplify (+ -)

22
lisp/calc/calc-ext.el
View file

@ -2784,23 +2784,23 @@ If X is not an error form, return 1."
(declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
(mapcar #'(lambda (func)
`(put ',func 'math-integral
(nconc
(get ',func 'math-integral)
(list
#'(lambda (u) ,@code)))))
(mapcar (lambda (func)
`(put ',func 'math-integral
(nconc
(get ',func 'math-integral)
(list
(lambda (u) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(defmacro math-defintegral-2 (funcs &rest code)
(declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
(mapcar #'(lambda (func)
`(put ',func 'math-integral-2
(nconc
(get ',func 'math-integral-2)
(list #'(lambda (u v) ,@code)))))
(mapcar (lambda (func)
`(put ',func 'math-integral-2
(nconc
(get ',func 'math-integral-2)
(list (lambda (u v) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(defvar var-IntegAfterRules 'calc-IntegAfterRules)

12
lisp/calc/calc-prog.el
View file

@ -1881,9 +1881,9 @@ Redefine the corresponding command."
(if (fboundp (setq chk (intern (concat "math-" qual-name))))
(append rest
(if is-rest
`((mapcar #'(lambda (x)
(or (,chk x)
(math-reject-arg x ',qual)))
`((mapcar (lambda (x)
(or (,chk x)
(math-reject-arg x ',qual)))
,var))
`((or (,chk ,var)
(math-reject-arg ,var ',qual)))))
@ -1894,9 +1894,9 @@ Redefine the corresponding command."
qual-name 1))))))
(append rest
(if is-rest
`((mapcar #'(lambda (x)
(and (,chk x)
(math-reject-arg x ',qual)))
`((mapcar (lambda (x)
(and (,chk x)
(math-reject-arg x ',qual)))
,var))
`((and
(,chk ,var)

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/bovine/el.el
View file

@ -585,7 +585,7 @@ Overrides `semantic-nonterminal-static'."
;;; Context parsing
;;
;; Emacs lisp is very different from C,C++ which most context parsing
;; Emacs Lisp is very different from C,C++ which most context parsing
;; functions are written. Support them here.
(define-mode-local-override semantic-up-context emacs-lisp-mode
(&optional _point _bounds-type)

2
lisp/cedet/semantic/db-ebrowse.el
View file

@ -222,7 +222,7 @@ warn instead."
;JAVE this just instantiates a default empty ebrowse struct?
; how would new instances wind up here?
; the ebrowse class isn't singleton, unlike the emacs lisp one
; the ebrowse class isn't singleton, unlike the Emacs Lisp one
(defvar-mode-local c++-mode semanticdb-project-system-databases
()
"Search Ebrowse for symbols.")

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.
;;
@ -131,7 +131,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
(eval expr))
(eval expr t))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
;; in the file (we haven't loaded the file).
@ -163,7 +163,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(let ((members (get symbol 'custom-group))
where found)
(when members
(dolist (member (mapcar 'car members))
(dolist (member (mapcar #'car members))
(setq where (get member 'custom-where))
(unless (or (null where)
(member where found))

2
lisp/cus-edit.el
View file

@ -5159,8 +5159,6 @@ if that value is non-nil."
(put 'Custom-mode 'mode-class 'special)
;;; The End.
(provide 'cus-edit)
;;; cus-edit.el ends here

2
lisp/cus-face.el
View file

@ -395,8 +395,6 @@ This means reset FACE to its value in FROM-THEME."
(define-obsolete-function-alias 'custom-facep #'facep "28.1")
;;; The End.
(provide 'cus-face)
;;; cus-face.el ends here

2
lisp/custom.el
View file

@ -1623,8 +1623,6 @@ If a choice with the same tag already exists, no action is taken."
(put variable 'custom-type
(append choices (list choice))))))
;;; The End.
(provide 'custom)
;;; custom.el ends here

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))))

33
lisp/emacs-lisp/bindat.el
View file

@ -167,7 +167,7 @@
(defun bindat--unpack-strz (len)
(let ((i 0) s)
(while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
(setq bindat-idx (+ bindat-idx len))
@ -439,6 +439,12 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(aset bindat-raw (+ bindat-idx i) (aref v i)))
(setq bindat-idx (+ bindat-idx len)))
(defun bindat--pack-strz (v)
(let ((len (length v)))
(dotimes (i len)
(aset bindat-raw (+ bindat-idx i) (aref v i)))
(setq bindat-idx (+ bindat-idx len 1))))
(defun bindat--pack-bits (len v)
(let ((bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
@ -677,14 +683,23 @@ is the name of a variable that will hold the value we need to pack.")
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
(cl-defmethod bindat--type (op (_ (eql strz)) len)
(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
;; Here we don't add the terminating zero because we rely
;; on the fact that `bindat-raw' was presumably initialized with
;; all-zeroes before we started.
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
(`(length ,val)
`(cl-incf bindat-idx ,(cond
((null len) `(length ,val))
((numberp len) len)
(t `(or ,len (length ,val))))))
(`(pack . ,args)
(macroexp-let2 nil len len
`(if ,len
;; Same as non-zero terminated strings since we don't actually add
;; the terminating zero anyway (because we rely on the fact that
;; `bindat-raw' was presumably initialized with all-zeroes before
;; we started).
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
(cl-defmethod bindat--type (op (_ (eql bits)) len)
(bindat--pcase op
@ -812,7 +827,7 @@ is the name of a variable that will hold the value we need to pack.")
'(&or ["uint" def-form]
["uintr" def-form]
["str" def-form]
["strz" def-form]
["strz" &optional def-form]
["bits" def-form]
["fill" def-form]
["align" def-form]
@ -832,7 +847,7 @@ TYPE is a Bindat type expression. It can take the following forms:
uint BITLEN - Big-endian unsigned integer
uintr BITLEN - Little-endian unsigned integer
str LEN - Byte string
strz LEN - Zero-terminated byte-string
strz [LEN] - Zero-terminated byte-string
bits LEN - Bit vector (LEN is counted in bytes)
fill LEN - Just a filler
align LEN - Fill up to the next multiple of LEN bytes

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)

61
lisp/emacs-lisp/bytecomp.el
View file

@ -4621,10 +4621,15 @@ binding slots have been popped."
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
(handlers (nthcdr 3 form))
(depth byte-compile-depth)
(success-handler (assq :success handlers))
(failure-handlers (if success-handler
(remq success-handler handlers)
handlers))
(clauses (mapcar (lambda (clause)
(cons (byte-compile-make-tag) clause))
(nthcdr 3 form)))
failure-handlers))
(endtag (byte-compile-make-tag)))
(byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
@ -4650,30 +4655,40 @@ binding slots have been popped."
(byte-compile-form body) ;; byte-compile--for-effect
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(byte-compile-goto 'byte-goto endtag)
(while clauses
(let ((clause (pop clauses))
(byte-compile-bound-variables byte-compile-bound-variables)
(byte-compile--lexical-environment
byte-compile--lexical-environment))
(setq byte-compile-depth (1+ depth))
(byte-compile-out-tag (pop clause))
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(cond
((null var) (byte-compile-discard))
(lexical-binding
(push (cons var (1- byte-compile-depth))
byte-compile--lexical-environment))
(t (byte-compile-dynamic-variable-bind var)))
(byte-compile-body (cdr clause)) ;; byte-compile--for-effect
(cond
((null var) nil)
(lexical-binding (byte-compile-discard 1 'preserve-tos))
(t (byte-compile-out 'byte-unbind 1)))
(byte-compile-goto 'byte-goto endtag)))
(let ((compile-handler-body
(lambda (body)
(let ((byte-compile-bound-variables byte-compile-bound-variables)
(byte-compile--lexical-environment
byte-compile--lexical-environment))
(cond
((null var) (byte-compile-discard))
(lexical-binding
(push (cons var (1- byte-compile-depth))
byte-compile--lexical-environment))
(t (byte-compile-dynamic-variable-bind var)))
(byte-compile-out-tag endtag)))
(byte-compile-body body) ;; byte-compile--for-effect
(cond
((null var))
(lexical-binding (byte-compile-discard 1 'preserve-tos))
(t (byte-compile-out 'byte-unbind 1)))))))
(when success-handler
(funcall compile-handler-body (cdr success-handler)))
(byte-compile-goto 'byte-goto endtag)
(while clauses
(let ((clause (pop clauses)))
(setq byte-compile-depth (1+ depth))
(byte-compile-out-tag (pop clause))
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(funcall compile-handler-body (cdr clause))
(byte-compile-goto 'byte-goto endtag)))
(byte-compile-out-tag endtag))))
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))

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

@ -1,4 +1,4 @@
;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
;;; cconv.el --- Closure conversion for statically scoped Emacs Lisp. -*- lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@ -498,7 +498,7 @@ places where they originally did not directly appear."
(let* ((class (and var (cconv--var-classification (list var) form)))
(newenv
(cond ((eq class :captured+mutated)
(cons `(,var . (car-save ,var)) env))
(cons `(,var . (car-safe ,var)) env))
((assq var env) (cons `(,var) env))
(t env)))
(msg (when (eq class :unused)

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

2
lisp/emacs-lisp/cl-indent.el
View file

@ -27,7 +27,7 @@
;; This package supplies a single entry point, common-lisp-indent-function,
;; which performs indentation in the preferred style for Common Lisp code.
;; It is also a suitable function for indenting Emacs lisp code.
;; It is also a suitable function for indenting Emacs Lisp code.
;;
;; To enable it:
;;

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

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

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

@ -213,7 +213,7 @@ the debugger will not be entered."
last-input-event last-command-event last-nonmenu-event
last-event-frame
overriding-local-map
load-read-function
(load-read-function #'read)
;; If we are inside a minibuffer, allow nesting
;; so that we don't get an error from the `e' command.
(enable-recursive-minibuffers

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

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

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.

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

@ -459,6 +459,9 @@ invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
just FUNCTION is printed."
;; Re-install our advice, in case `debug' re-bound `load-read-function' to
;; its default value.
(add-function :around load-read-function #'edebug--read)
(let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs))))
(edebug-all-defs edebug-all-forms))
(funcall orig-fun nil)))
@ -1942,14 +1945,16 @@ a sequence of elements."
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
;; of the current list. e.g. ("lambda" &define args def-body)
(edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
;; Find the last offset in the list.
(let ((offsets (edebug-cursor-offsets cursor)))
(while (consp offsets) (setq offsets (cdr offsets)))
offsets)
specs))
(prog1 (edebug-make-form-wrapper
cursor
(edebug-before-offset cursor)
;; Find the last offset in the list.
(let ((offsets (edebug-cursor-offsets cursor)))
(while (consp offsets) (setq offsets (cdr offsets)))
offsets)
specs)
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
@ -4114,12 +4119,12 @@ This should be a list of `edebug---frame' objects.")
"Stack frames of the current Edebug Backtrace buffer with instrumentation.
This should be a list of `edebug---frame' objects.")
;; Data structure for backtrace frames with information
;; from Edebug instrumentation found in the backtrace.
(cl-defstruct
(edebug--frame
(:constructor edebug--make-frame)
(:include backtrace-frame))
"Data structure for backtrace frames with information
from Edebug instrumentation found in the backtrace."
def-name before-index after-index)
(defun edebug-pop-to-backtrace ()

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

12
lisp/emacs-lisp/eieio-core.el
View file

@ -169,7 +169,7 @@ Return nil if that option doesn't exist."
(and (recordp obj)
(eieio--class-p (eieio--object-class obj))))
(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
(defun class-abstract-p (class)
"Return non-nil if CLASS is abstract.
@ -242,9 +242,9 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
(cl-deftype list-of (elem-type)
`(and list
(satisfies (lambda (list)
(cl-every (lambda (elem) (cl-typep elem ',elem-type))
list)))))
(satisfies ,(lambda (list)
(cl-every (lambda (elem) (cl-typep elem elem-type))
list)))))
(defun eieio-make-class-predicate (class)
@ -787,7 +787,7 @@ Fills in OBJ's SLOT with its default value."
(cond
;; Is it a function call? If so, evaluate it.
((eieio-eval-default-p val)
(eval val))
(eval val t))
;;;; check for quoted things, and unquote them
;;((and (consp val) (eq (car val) 'quote))
;; (car (cdr val)))
@ -1029,7 +1029,7 @@ method invocation orders of the involved classes."
(eieio--class-precedence-c3 class))))))
(define-obsolete-function-alias
'class-precedence-list 'eieio--class-precedence-list "24.4")
'class-precedence-list #'eieio--class-precedence-list "24.4")
;;; Here are some special types of errors

5
lisp/emacs-lisp/faceup.el
View file

@ -1170,11 +1170,6 @@ Intended to be called when a file is loaded."
;; File is being evaluated using, for example, `eval-buffer'.
default-directory)))
;; ----------------------------------------------------------------------
;; The end
;;
(provide 'faceup)
;;; faceup.el ends here

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...).")

5
lisp/emacs-lisp/lisp-mnt.el
View file

@ -109,11 +109,6 @@
;; * Footer line --- marks end-of-file so it can be distinguished from
;; an expanded formfeed or the results of truncation.
;;; Change Log:
;; Tue Jul 14 23:44:17 1992 ESR
;; * Created.
;;; Code:
;;; Variables:

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))

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

@ -248,8 +248,6 @@ If SEQ is already a ring, return it."
(ring-insert-at-beginning ring (elt seq count))))
ring)))
;;; provide ourself:
(provide 'ring)
;;; ring.el ends here

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)

2
lisp/emulation/edt-mapper.el
View file

@ -26,7 +26,7 @@
;; [Part of the GNU Emacs EDT Emulation.]
;; This emacs lisp program can be used to create an emacs lisp file
;; This Emacs Lisp program can be used to create an Emacs Lisp file
;; that defines the mapping of the user's keyboard to the LK-201
;; keyboard function keys and keypad keys (around which EDT has been
;; designed). Please read the "Usage" AND "Known Problems" sections

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

5
lisp/eshell/em-script.el
View file

@ -60,8 +60,9 @@ This includes when running `eshell-command'."
"Initialize the script parsing code."
(setq-local eshell-interpreter-alist
(cons (cons (lambda (file _args)
(string= (file-name-nondirectory file)
"eshell"))
(and (file-regular-p file)
(string= (file-name-nondirectory file)
"eshell")))
'eshell/source)
eshell-interpreter-alist))
(setq-local eshell-complex-commands

44
lisp/eshell/em-xtra.el
View file

@ -23,13 +23,10 @@
;;; Code:
(require 'cl-lib)
(require 'esh-util)
(eval-when-compile
(require 'eshell))
;; Strictly speaking, should only be needed at compile time.
;; Require at run-time too to silence compiler.
(require 'pcomplete)
(require 'compile)
;; There are no items in this custom group, but eshell modules (ab)use
;; custom groups.
@ -49,50 +46,45 @@ naturally accessible within Emacs."
(defun eshell/expr (&rest args)
"Implementation of expr, using the calc package."
(if (not (fboundp 'calc-eval))
(throw 'eshell-replace-command
(eshell-parse-command "*expr" (flatten-tree args)))
;; to fool the byte-compiler...
(let ((func 'calc-eval))
(funcall func (eshell-flatten-and-stringify args)))))
(calc-eval (eshell-flatten-and-stringify args)))
(defun eshell/substitute (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'substitute (car args) (cadr args) :test 'equal
"Easy front-end to `cl-substitute', for comparing lists of strings."
(apply #'cl-substitute (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/count (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'count (car args) (cadr args) :test 'equal
"Easy front-end to `cl-count', for comparing lists of strings."
(apply #'cl-count (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/mismatch (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'mismatch (car args) (cadr args) :test 'equal
"Easy front-end to `cl-mismatch', for comparing lists of strings."
(apply #'cl-mismatch (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/union (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'union (car args) (cadr args) :test 'equal
"Easy front-end to `cl-union', for comparing lists of strings."
(apply #'cl-union (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/intersection (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'intersection (car args) (cadr args) :test 'equal
"Easy front-end to `cl-intersection', for comparing lists of strings."
(apply #'cl-intersection (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/set-difference (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'set-difference (car args) (cadr args) :test 'equal
"Easy front-end to `cl-set-difference', for comparing lists of strings."
(apply #'cl-set-difference (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/set-exclusive-or (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'set-exclusive-or (car args) (cadr args) :test 'equal
"Easy front-end to `cl-set-exclusive-or', for comparing lists of strings."
(apply #'cl-set-exclusive-or (car args) (cadr args) :test #'equal
(cddr args)))
(defalias 'eshell/ff 'find-name-dired)
(defalias 'eshell/gf 'find-grep-dired)
(defalias 'eshell/ff #'find-name-dired)
(defalias 'eshell/gf #'find-grep-dired)
(provide 'em-xtra)

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/expand.el
View file

@ -484,7 +484,6 @@ This is used only in conjunction with `expand-add-abbrevs'."
(provide 'expand)
;; run load hooks
(run-hooks 'expand-load-hook)
;;; expand.el ends here

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/filecache.el
View file

@ -674,10 +674,6 @@ match REGEXP."
(insert (nth 1 item) (nth 0 item) "\n"))
(pop-to-buffer buf))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keybindings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'filecache)
;;; filecache.el ends here

1
lisp/filenotify.el
View file

@ -505,7 +505,6 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
;; due to the way events are propagated during idle time. Note: This
;; may be perfectly acceptable.
;; The end:
(provide 'filenotify)
;;; filenotify.el ends here

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

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

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.
@ -2009,9 +2028,9 @@ frame's display)."
(fboundp 'image-mask-p)
(fboundp 'image-size)))
(defalias 'display-blink-cursor-p 'display-graphic-p)
(defalias 'display-multi-frame-p 'display-graphic-p)
(defalias 'display-multi-font-p 'display-graphic-p)
(defalias 'display-blink-cursor-p #'display-graphic-p)
(defalias 'display-multi-frame-p #'display-graphic-p)
(defalias 'display-multi-font-p #'display-graphic-p)
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
@ -2363,13 +2382,15 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to
the opposite frame edge from the edge indicated in the input spec."
(cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
(defun delete-other-frames (&optional frame)
(defun delete-other-frames (&optional frame iconify)
"Delete all frames on FRAME's terminal, except FRAME.
If FRAME uses another frame's minibuffer, the minibuffer frame is
left untouched. Do not delete any of FRAME's child frames. If
FRAME is a child frame, delete its siblings only. FRAME must be
a live frame and defaults to the selected one."
(interactive)
a live frame and defaults to the selected one.
If the prefix arg ICONIFY is non-nil, just iconify the frames rather than
deleting them."
(interactive "i\nP")
(setq frame (window-normalize-frame frame))
(let ((minibuffer-frame (window-frame (minibuffer-window frame)))
(this (next-frame frame t))
@ -2384,7 +2405,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
(delete-frame this))
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))
;; In a second round consider all remaining frames.
(setq this (next-frame frame t))
@ -2396,7 +2417,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
(delete-frame this))
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))))
@ -2422,7 +2443,7 @@ parameters `bottom-divider-width' and `right-divider-width'."
:type '(choice (const :tag "Bottom only" bottom-only)
(const :tag "Right only" right-only)
(const :tag "Bottom and right" t))
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@ -2443,7 +2464,7 @@ parameter `bottom-divider-width'."
:type '(restricted-sexp
:tag "Default width of bottom dividers"
:match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@ -2460,7 +2481,7 @@ parameter `right-divider-width'."
:type '(restricted-sexp
:tag "Default width of right dividers"
:match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@ -2737,14 +2758,14 @@ See also `toggle-frame-maximized'."
;;;; Key bindings
(define-key ctl-x-5-map "2" 'make-frame-command)
(define-key ctl-x-5-map "1" 'delete-other-frames)
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
(define-key ctl-x-5-map "5" 'other-frame-prefix)
(define-key global-map [f11] 'toggle-frame-fullscreen)
(define-key global-map [(meta f10)] 'toggle-frame-maximized)
(define-key esc-map [f10] 'toggle-frame-maximized)
(define-key ctl-x-5-map "2" #'make-frame-command)
(define-key ctl-x-5-map "1" #'delete-other-frames)
(define-key ctl-x-5-map "0" #'delete-frame)
(define-key ctl-x-5-map "o" #'other-frame)
(define-key ctl-x-5-map "5" #'other-frame-prefix)
(define-key global-map [f11] #'toggle-frame-fullscreen)
(define-key global-map [(meta f10)] #'toggle-frame-maximized)
(define-key esc-map [f10] #'toggle-frame-maximized)
;; Misc.

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))

2
lisp/gnus/gnus-cus.el
View file

@ -1102,8 +1102,6 @@ articles in the thread.
(widget-setup)
(buffer-enable-undo))))
;;; The End:
(provide 'gnus-cus)
;;; gnus-cus.el ends here

5
lisp/gnus/gnus-diary.el
View file

@ -32,11 +32,6 @@
;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is
;; now fully documented in the Gnus manual.
;; Bugs / Todo:
;; ===========
;;; Code:
(require 'nndiary)

2
lisp/gnus/gnus-registry.el
View file

@ -1298,8 +1298,6 @@ from your existing entries."
(gnus-registry-insert db k newv)))
(registry-reindex db))))
;; TODO: a few things
(provide 'gnus-registry)
;;; gnus-registry.el ends here

190
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
@ -186,22 +187,26 @@ Otherwise, most addresses look like `angles', but they look like
(defcustom message-syntax-checks
(if message-insert-canlock '((sender . disabled)) nil)
;; Guess this one shouldn't be easy to customize...
"Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
`(signature . disabled)' to this list.
Don't touch this variable unless you really know what you're doing.
Checks include `approved', `bogus-recipient', `continuation-headers',
`control-chars', `empty', `existing-newsgroups', `from', `illegible-text',
`invisible-text', `long-header-lines', `long-lines', `message-id',
`multiple-headers', `new-text', `newsgroups', `quoting-style',
`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
`shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
and `valid-newsgroups'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
See the Message manual for the meanings of the valid syntax check
types."
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(alist
:key-type symbol
:value-type (const disabled)
:options (approved bogus-recipient continuation-headers
control-chars empty existing-newsgroups from illegible-text
invisible-text long-header-lines long-lines message-id
multiple-headers new-text newgroups quoting-style
repeated-newsgroups reply-to sender sendsys shoot
shorten-followup-to signature size subject subject-cmsg
valid-newsgroups)))
(defcustom message-required-headers '((optional . References)
From)
@ -418,7 +423,7 @@ you can explicitly override this setting by calling
:type 'string
:group 'message-various)
(defcustom message-cross-post-note-function 'message-cross-post-insert-note
(defcustom message-cross-post-note-function #'message-cross-post-insert-note
"Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
@ -756,7 +761,7 @@ See also `send-mail-function'."
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(defcustom message-send-news-function 'message-send-news
(defcustom message-send-news-function #'message-send-news
"Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'."
@ -765,29 +770,32 @@ variable `mail-header-separator'."
:link '(custom-manual "(message)News Variables")
:type 'function)
(defcustom message-reply-to-function nil
(defcustom message-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Reply")
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-wide-reply-to-function nil
(defcustom message-wide-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Wide Reply")
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-followup-to-function nil
(defcustom message-followup-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
:version "28.1"
:type 'function)
(defcustom message-extra-wide-headers nil
"If non-nil, a list of additional address headers.
@ -1021,7 +1029,7 @@ the signature is inserted."
:version "22.1"
:group 'message-various)
(defcustom message-citation-line-function 'message-insert-citation-line
(defcustom message-citation-line-function #'message-insert-citation-line
"Function called to insert the \"Whomever writes:\" line.
Predefined functions include `message-insert-citation-line' and
@ -1103,7 +1111,7 @@ Used by `message-yank-original' via `message-yank-cite'."
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
(defcustom message-cite-function 'message-cite-original-without-signature
(defcustom message-cite-function #'message-cite-original-without-signature
"Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
@ -1116,7 +1124,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
:version "22.3" ;; Gnus 5.10.12 (changed default)
:group 'message-insertion)
(defcustom message-indent-citation-function 'message-indent-citation
(defcustom message-indent-citation-function #'message-indent-citation
"Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave
@ -2847,79 +2855,79 @@ Consider adding this function to `message-header-setup-hook'"
(unless message-mode-map
(setq message-mode-map (make-keymap))
(set-keymap-parent message-mode-map text-mode-map)
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c?" #'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 +3177,13 @@ Like `text-mode', but with these additional commands:
;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts.
;;
(setq-local syntax-propertize-function 'message--syntax-propertize)
(setq-local syntax-propertize-function #'message--syntax-propertize)
(setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables ()
"Setup message fill variables."
(setq-local fill-paragraph-function #'message-fill-paragraph)
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
@ -3287,7 +3294,7 @@ Like `text-mode', but with these additional commands:
(push-mark)
(message-position-on-field "Summary" "Subject"))
(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1")
(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1")
(defun message-goto-body (&optional interactive)
"Move point to the beginning of the message body.
Returns point."
@ -6662,9 +6669,8 @@ moved to the beginning "
(not (buffer-modified-p buffer)))
(kill-buffer buffer))))
;; Rename the buffer.
(if message-send-rename-function
(funcall message-send-rename-function)
(message-default-send-rename-function))
(funcall (or message-send-rename-function
#'message-default-send-rename-function))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
@ -6763,8 +6769,9 @@ are not included."
(defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions)
(condition-case nil
;; FIXME: Use functions rather than expressions!
(add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action)))))
`(apply #',(car action) ',(cdr action)))))
(setq message-return-action return-action)
(setq message-reply-buffer
(if (and (consp yank-action)
@ -6903,7 +6910,7 @@ are not included."
;;;###autoload
(defun message-mail (&optional to subject other-headers continue
switch-function yank-action send-actions
return-action &rest ignored)
return-action &rest _)
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
@ -7127,15 +7134,12 @@ want to get rid of this query permanently.")))
;; specific, and just Cc-in the rest.
(setq follow-to (list
(cons 'To
(mapconcat
(lambda (addr)
(cdr addr)) recipients ", "))))
(mapconcat #'cdr recipients ", "))))
;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc.
(when recipients
(setq recipients (mapconcat
(lambda (addr) (cdr addr)) recipients ", "))
(setq recipients (mapconcat #'cdr recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))))
@ -7862,7 +7866,7 @@ is for the internal use."
(interactive)
(setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function
'message-forward-rmail-make-body))
#'message-forward-rmail-make-body))
;;;###autoload
(defun message-resend (address)

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