Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-22 12:57:34 +00:00
Code Issues Projects Releases Packages Wiki Activity

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

Browse source
This commit is contained in:
Yuuki Harano 2021-02-20 18:00:36 +09:00
commit be2e47362b
461 changed files with 8312 additions and 6221 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
CONTRIBUTE
View file

@ -66,11 +66,15 @@ more reliably, and makes the job of applying the patches easier and less
error-prone. It also allows sending patches whose author is someone
other than the email sender.
Once the cumulative amount of your submissions exceeds about 15 lines
of non-trivial changes, we will need you to assign to the FSF the
copyright for your contributions. Ask on emacs-devel@gnu.org, and we
will send you the necessary form together with the instructions to
fill and email it, in order to start this legal paperwork.
Once the cumulative amount of your submissions exceeds a dozen or so
lines of non-trivial changes, we will need you to assign to the FSF
the copyright for your contributions. (To see how many lines were
non-trivially changed, count only added and modified lines in the
patched code. Consider an added or changed line non-trivial if it
includes at least one identifier, string, or substantial comment.)
Ask on emacs-devel@gnu.org, and we will send you the necessary form
together with the instructions to fill and email it, in order to start
this legal paperwork.
** Issue tracker (a.k.a. "bug tracker")

45
admin/CPP-DEFINES
View file

@ -81,7 +81,6 @@ anymore, so they can be removed.
AMPERSAND_FULL_NAME
BROKEN_DATAGRAM_SOCKETS
BROKEN_FIONREAD
BROKEN_GET_CURRENT_DIR_NAME
BROKEN_PTY_READ_AFTER_EAGAIN
DEFAULT_SOUND_DEVICE
@ -94,16 +93,12 @@ EMACS_CONFIG_OPTIONS
EMACS_INT
EMACS_UINT
GC_MARK_SECONDARY_STACK
GC_MARK_STACK
GC_SETJMP_WORKS
GNU_MALLOC
HAVE_AIX_SMT_EXP
HAVE_ALARM
HAVE_ALLOCA
HAVE_ALLOCA_H
HAVE_ALSA
HAVE_BDFFONT
HAVE_BOXES
HAVE_CFMAKERAW
HAVE_CFSETSPEED
HAVE_CLOCK_GETTIME
@ -117,7 +112,6 @@ HAVE_DBUS_VALIDATE_INTERFACE
HAVE_DBUS_VALIDATE_MEMBER
HAVE_DBUS_VALIDATE_PATH
HAVE_DBUS_WATCH_GET_UNIX_FD
HAVE_DECL_GETENV
HAVE_DECL_LOCALTIME_R
HAVE_DECL_STRMODE
HAVE_DECL_STRTOIMAX
@ -126,8 +120,6 @@ HAVE_DECL_STRTOULL
HAVE_DECL_STRTOUMAX
HAVE_DECL_TZNAME
HAVE_DIALOGS
HAVE_DIFFTIME
HAVE_DUP2
HAVE_ENDGRENT
HAVE_ENDPWENT
HAVE_ENVIRON_DECL
@ -141,11 +133,9 @@ HAVE_FUTIMES
HAVE_FUTIMESAT
HAVE_GAI_STRERROR
HAVE_GCONF
HAVE_GETDELIM
HAVE_GETGRENT
HAVE_GETHOSTNAME
HAVE_GETIFADDRS
HAVE_GETLINE
HAVE_GETLOADAVG
HAVE_GETOPT_H
HAVE_GETOPT_LONG_ONLY
@ -164,18 +154,8 @@ HAVE_GPM
HAVE_GRANTPT
HAVE_GSETTINGS
HAVE_GTK3
HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE
HAVE_GTK_DIALOG_GET_ACTION_AREA
HAVE_GTK_FILE_SELECTION_NEW
HAVE_GTK_MAIN
HAVE_GTK_MULTIDISPLAY
HAVE_GTK_ORIENTABLE_SET_ORIENTATION
HAVE_GTK_WIDGET_GET_MAPPED
HAVE_GTK_WIDGET_GET_SENSITIVE
HAVE_GTK_WIDGET_GET_WINDOW
HAVE_GTK_WIDGET_SET_HAS_WINDOW
HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP
HAVE_G_TYPE_INIT
HAVE_IFADDRS_H
HAVE_IMAGEMAGICK
HAVE_INTTYPES_H
@ -193,10 +173,8 @@ HAVE_LIBLOCKFILE
HAVE_LIBMAIL
HAVE_LIBOTF
HAVE_LIBPERFSTAT
HAVE_LIBPNG_PNG_H
HAVE_LIBSELINUX
HAVE_LIBXML2
HAVE_LIBXMU
HAVE_LOCALTIME_R
HAVE_LOCAL_SOCKETS
HAVE_LRAND48
@ -209,24 +187,18 @@ HAVE_MAGICKEXPORTIMAGEPIXELS
HAVE_MAGICKMERGEIMAGELAYERS
HAVE_MAILLOCK_H
HAVE_MALLOC_MALLOC_H
HAVE_MATHERR
HAVE_MBSTATE_T
HAVE_MEMCMP
HAVE_MEMMOVE
HAVE_MEMORY_H
HAVE_MEMSET
HAVE_MENUS
HAVE_MKSTEMP
HAVE_MMAP
HAVE_MULTILINGUAL_MENU
HAVE_NANOTIME
HAVE_NET_IF_DL_H
HAVE_NET_IF_H
HAVE_NLIST_H
HAVE_OTF_GET_VARIATION_GLYPHS
HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
HAVE_PNG
HAVE_PNG_H
HAVE_POSIX_MEMALIGN
HAVE_PROCFS
HAVE_PSELECT
@ -263,15 +235,12 @@ HAVE_SOUNDCARD_H
HAVE_STDINT_H
HAVE_STDIO_EXT_H
HAVE_STDLIB_H
HAVE_STLIB_H_1
HAVE_STRINGS_H
HAVE_STRING_H
HAVE_STRNCASECMP
HAVE_STRSIGNAL
HAVE_STRTOIMAX
HAVE_STRTOLL
HAVE_STRTOULL
HAVE_STRTOUMAX
HAVE_STRUCT_ERA_ENTRY
HAVE_STRUCT_IFREQ_IFR_ADDR
HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
@ -287,9 +256,7 @@ HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
HAVE_STRUCT_TIMEZONE
HAVE_STRUCT_TM_TM_ZONE
HAVE_STRUCT_UTIMBUF
HAVE_ST_DM_MODE
HAVE_SYMLINK
HAVE_SYNC
@ -303,26 +270,20 @@ HAVE_SYS_SOCKET_H
HAVE_SYS_SOUNDCARD_H
HAVE_SYS_STAT_H
HAVE_SYS_SYSTEMINFO_H
HAVE_SYS_TIMEB_H
HAVE_SYS_TIME_H
HAVE_SYS_TYPES_H
HAVE_SYS_UN_H
HAVE_SYS_UTSNAME_H
HAVE_SYS_VLIMIT_H
HAVE_SYS_WAIT_H
HAVE_TCATTR
HAVE_TERM_H
HAVE_TIFF
HAVE_TIMEVAL
HAVE_TM_GMTOFF
HAVE_TM_ZONE
HAVE_TOUCHLOCK
HAVE_TZNAME
HAVE_TZSET
HAVE_UTIL_H
HAVE_UTIMENSAT
HAVE_UTIMES
HAVE_UTIME_H
HAVE_UTMP_H
HAVE_VFORK
HAVE_VFORK_H
@ -342,14 +303,10 @@ HAVE_XRMSETDATABASE
HAVE_XSCREENNUMBEROFSCREEN
HAVE_XSCREENRESOURCESTRING
HAVE_X_I18N
HAVE_X_MENU
HAVE_X_SM
HAVE_X_WINDOWS
HAVE__BOOL
HAVE__FTIME
HAVE___BUILTIN_UNWIND_INIT
HAVE___EXECUTABLE_START
HAVE___FPENDING
INTERNAL_TERMINAL
IS_ANY_SEP
IS_DIRECTORY_SEP
@ -359,7 +316,6 @@ MAIL_USE_POP
MAIL_USE_SYSTEM_LOCK
MAXPATHLEN
NLIST_STRUCT
NO_EDITRES
NSIG
NSIG_MINIMUM
NULL_DEVICE
@ -378,7 +334,6 @@ SYSTEM_MALLOC
TAB3
TABDLY
TERM
TIME_WITH_SYS_TIME
TIOCSIGSEND
TM_IN_SYS_TIME
UNIX98_PTYS

57
admin/check-doc-strings
View file

@ -59,7 +59,7 @@ sub Check_texi_function {
$arglist_parm{$parm} = 1;
}
foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) {
foreach my $parm ($docstring =~ /\@var\{([^{}]+)\}/g) {
$docstring_parm{$parm} = 1;
}
@ -111,7 +111,9 @@ sub Check_function {
# $arglist_parm{$parm} = 1;
#}
foreach my $parm (@parms) {
next if $parm eq '&optional' || $parm eq '&rest';
next if $parm eq '&optional'
|| $parm eq '&rest'
|| $parm eq 'Lisp-Object';
$arglist_parm{$parm} = 1;
}
my $doc_tmp = $docstring;
@ -150,6 +152,22 @@ sub Check_function {
next if $parm eq 'primary';
next if $parm eq 'secondary';
next if $parm eq 'clipboard';
next if $parm eq 'bbdb';
next if $parm eq 'dos';
next if $parm eq 'erc';
next if $parm eq 'exif';
next if $parm eq 'ldap';
next if $parm eq 'ime';
next if $parm eq 'rfc';
next if $parm eq 'ms-dos';
next if $parm eq 'url';
next if $parm eq 'w32';
next if $parm eq 'todo'; # org-mode
next if $parm eq 'done'; # org-mode
next if $parm eq 'waiting'; #org-mode
next if $parm eq 'ordered'; #org-mode
next if $parm eq 'deadline'; #org-mode
next if $parm eq 'scheduled'; #org-mode
next if length $parm < 3;
if (! exists $arglist_parm{$parm}) {
print "bogus parm: $function: $parm\n";
@ -228,20 +246,43 @@ open (FIND, "find src -name '*.c' -print |") or die;
while (my $file = <FIND>) {
my @matches =
((FileContents $file) =~
/\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
/\b
DEFUN\s*\(\s*
## $function
\"((?:[^\\\"]|\\.)+)\"\s*,
\s*\S+\s*, \s*\S+\s*,
## $minargs
\s*(\S+)\s*,
## $maxargs
\s*(\S+)\s*,
## $interactive
\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,
## $docstring
\s*doc:\s*\/\*\s*(.*?)\s*\*\/
# attributes -- skip
(?:\s*attributes:\s*
(?:noreturn|const)
\s*)?
\s*\)
### $parms
\s*\(
([^()]*)
\)
/sgox);
while (@matches) {
my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6);
$docstring =~ s/^\n+//s;
$docstring =~ s/\n+$//s;
$parms =~ s/,/ /g;
my @parms = split (' ',$parms);
my @parms = $parms eq 'void' ? () : split (' ', $parms);
for (@parms) { tr/_/-/; s/-$//; }
if ($parms !~ /Lisp_Object/) {
if ($minargs < @parms) {
if ($maxargs =~ /^\d+$/) {
die unless $maxargs eq @parms;
splice (@parms, $minargs, 0, '&optional');
}
if ($maxargs =~ /^\d+$/) {
die "$function: $maxargs"
unless $maxargs eq @parms;
splice (@parms, $minargs, 0, '&optional');
}
}
}
my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');

5
admin/cus-test.el
View file

@ -320,7 +320,8 @@ If it is \"all\", load all Lisp files."
(lambda (file)
(condition-case alpha
(unless (member file cus-test-libs-noloads)
(load (file-name-sans-extension (expand-file-name file lispdir)))
(load (file-name-sans-extension (expand-file-name file lispdir))
nil t)
(push file cus-test-libs-loaded))
(error
(push (cons file alpha) cus-test-libs-errors)
@ -349,6 +350,8 @@ Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
(mapcar (lambda (e) (substring e 2))
(apply #'process-lines find-program
"." "-name" "obsolete" "-prune" "-o"
"-name" "ldefs-boot.el" "-prune" "-o"
"-name" "*loaddefs.el" "-prune" "-o"
"-name" "[^.]*.el" ; ignore .dir-locals.el
(if all
'("-print")

2
admin/gitmerge.el
View file

@ -7,6 +7,8 @@
;; Keywords: maint
;; 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

21
configure.ac
View file

@ -409,19 +409,18 @@ dnl This should be the last --with option, because --with-x is
dnl added later on when we find the file name of X, and it's best to
dnl keep them together visually.
AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT],
[use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, motif, no)])],
[use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, no)])],
[ case "${withval}" in
y | ye | yes ) val=gtk ;;
n | no ) val=no ;;
l | lu | luc | luci | lucid ) val=lucid ;;
a | at | ath | athe | athen | athena ) val=athena ;;
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
AC_MSG_ERROR(['--with-x-toolkit=$withval' is invalid;
this option's value should be 'yes', 'no', 'lucid', 'athena', 'motif', 'gtk',
this option's value should be 'yes', 'no', 'lucid', 'athena', 'gtk',
'gtk2' or 'gtk3'. 'yes' and 'gtk' are synonyms.
'athena' and 'lucid' are synonyms.])
;;
@ -460,7 +459,7 @@ OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping])
OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping])
OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif/Xaw3d/GTK toolkit scroll bars])
OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Xaw3d/GTK toolkit scroll bars])
OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d])
OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off])
OPTION_DEFAULT_ON([xdbe],[don't use X11 double buffering support])
@ -1769,8 +1768,8 @@ fi
dnl On Solaris 8 there's a compilation warning for term.h because
dnl it doesn't define 'bool'.
AC_CHECK_HEADERS(term.h, , , -)
AC_HEADER_TIME
AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[#include <term.h>]],[[]])],
AC_DEFINE(HAVE_TERM_H, 1, [Define to 1 if you have the <term.h> header file.]))
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS_ONCE(sys/socket.h)
@ -2264,7 +2263,7 @@ if test "$window_system" = none && test "X$with_x" != "Xno"; then
then
AC_MSG_ERROR([You seem to be running X, but no X development libraries
were found. You should install the relevant development files for X
and for the toolkit you want, such as Gtk+ or Motif. Also make
and for the toolkit you want, such as Gtk+. Also make
sure you have development files for image handling, i.e.
tiff, gif, jpeg, png and xpm.
If you are sure you want Emacs compiled without X window support, pass
@ -4792,10 +4791,10 @@ if test "$USE_X_TOOLKIT" != "none"; then
else
OTHERLIBS="-lXt -$LIBXMU"
fi
AC_TRY_LINK(
[#include <X11/Intrinsic.h>
#include <X11/Xmu/Editres.h>],
[_XEditResCheckMessages (0, 0, 0, 0);],
AC_LINK_IFELSE([AC_LANG_PROGRAM(
[[#include <X11/Intrinsic.h>
#include <X11/Xmu/Editres.h>]],
[[_XEditResCheckMessages (0, 0, 0, 0);]])],
[AC_DEFINE([X_TOOLKIT_EDITRES], 1,
[Define to 1 if we should use XEditRes.])])
LIBS=$OLDLIBS

16
doc/emacs/basic.texi
View file

@ -331,6 +331,11 @@ a plain prefix argument. Alternatively, you can use the command
@code{goto-line-relative} to move point to the line relative to the
accessible portion of the narrowed buffer.
@code{goto-line} has its own history list (@pxref{Minibuffer
History}). You can have either a single list shared between all
buffers (the default) or a separate list for each buffer, by
customizing the user option @code{goto-line-history-local}.
@item M-g @key{TAB}
@kindex M-g TAB
@findex move-to-column
@ -880,3 +885,14 @@ characters. You can repeat that command (including its argument) three
additional times, to delete a total of 80 characters, by typing @kbd{C-x
z z z}. The first @kbd{C-x z} repeats the command once, and each
subsequent @kbd{z} repeats it once again.
@findex repeat-mode
Also you can activate @code{repeat-mode} that temporarily enables
a transient mode with short keys after a limited number of commands.
Currently supported shorter key sequences are @kbd{C-x u u} instead of
@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of
@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^
v v} to resize the selected window interactively, @kbd{M-g n n p p} to
navigate @code{next-error} matches. Any other key exits transient mode
and then is executed normally. The user option @code{repeat-exit-key}
defines an additional key to exit this transient mode.

32
doc/emacs/buffers.texi
View file

@ -232,9 +232,9 @@ unless they visit files: such buffers are used internally by Emacs.
@table @kbd
@item C-x C-q
Toggle read-only status of buffer (@code{read-only-mode}).
@item M-x rename-buffer @key{RET} @var{buffer} @key{RET}
@item C-x x r @key{RET} @var{buffer} @key{RET}
Change the name of the current buffer.
@item M-x rename-uniquely
@item C-x x u
Rename the current buffer by adding @samp{<@var{number}>} to the end.
@item M-x view-buffer @key{RET} @var{buffer} @key{RET}
Scroll through buffer @var{buffer}. @xref{View Mode}.
@ -263,28 +263,28 @@ non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q}
also enables View mode in the buffer (@pxref{View Mode}).
@findex rename-buffer
@kbd{M-x rename-buffer} changes the name of the current buffer. You
specify the new name as a minibuffer argument; there is no default.
If you specify a name that is in use for some other buffer, an error
happens and no renaming is done.
@kbd{C-x x r} (@code{rename-buffer} changes the name of the current
buffer. You specify the new name as a minibuffer argument; there is
no default. If you specify a name that is in use for some other
buffer, an error happens and no renaming is done.
@findex rename-uniquely
@kbd{M-x rename-uniquely} renames the current buffer to a similar
name with a numeric suffix added to make it both different and unique.
This command does not need an argument. It is useful for creating
multiple shell buffers: if you rename the @file{*shell*} buffer, then
do @kbd{M-x shell} again, it makes a new shell buffer named
@file{*shell*}; meanwhile, the old shell buffer continues to exist
under its new name. This method is also good for mail buffers,
@kbd{C-x x u} (@code{rename-uniquely}) renames the current buffer to
a similar name with a numeric suffix added to make it both different
and unique. This command does not need an argument. It is useful for
creating multiple shell buffers: if you rename the @file{*shell*}
buffer, then do @kbd{M-x shell} again, it makes a new shell buffer
named @file{*shell*}; meanwhile, the old shell buffer continues to
exist under its new name. This method is also good for mail buffers,
compilation buffers, and most Emacs features that create special
buffers with particular names. (With some of these features, such as
@kbd{M-x compile}, @kbd{M-x grep}, you need to switch to some other
buffer before using the command again, otherwise it will reuse the
current buffer despite the name change.)
The commands @kbd{M-x append-to-buffer} and @kbd{M-x insert-buffer}
can also be used to copy text from one buffer to another.
@xref{Accumulating Text}.
The commands @kbd{M-x append-to-buffer} and @kbd{C-x x i}
(@code{insert-buffer}) can also be used to copy text from one buffer
to another. @xref{Accumulating Text}.
@node Kill Buffer
@section Killing Buffers

9
doc/emacs/custom.texi
View file

@ -519,12 +519,9 @@ Set up a customization buffer for all the settings and groups that
match @var{regexp}.
@item M-x customize-changed @key{RET} @var{version} @key{RET}
Set up a customization buffer with all the settings and groups
whose meaning has changed since Emacs version @var{version}.
@item M-x customize-changed-options @key{RET} @var{version} @key{RET}
Set up a customization buffer with all the options whose meaning or
default values have changed since Emacs version @var{version}.
Set up a customization buffer with all the user options, faces and
groups whose meaning has changed since (or been added after) Emacs
version @var{version}.
@item M-x customize-saved
Set up a customization buffer containing all settings that you

18
doc/emacs/display.texi
View file

@ -173,6 +173,10 @@ line; on subsequent consecutive invocations, make the current line the
top line, the bottom line, and so on in cyclic order. Possibly
redisplay the screen too (@code{recenter-top-bottom}).
@item C-M-S-l
Scroll the other window; this is equivalent to @kbd{C-l} acting on the
other window.
@item M-x recenter
Scroll the selected window so the current line is the center-most text
line. Possibly redisplay the screen too.
@ -1755,13 +1759,13 @@ and/or leftmost columns.
@findex toggle-truncate-lines
Horizontal scrolling automatically causes line truncation
(@pxref{Horizontal Scrolling}). You can explicitly enable line
truncation for a particular buffer with the command @kbd{M-x
toggle-truncate-lines}. This works by locally changing the variable
@code{truncate-lines}. If that variable is non-@code{nil}, long lines
are truncated; if it is @code{nil}, they are continued onto multiple
screen lines. Setting the variable @code{truncate-lines} in any way
makes it local to the current buffer; until that time, the default
value, which is normally @code{nil}, is in effect.
truncation for a particular buffer with the command @kbd{C-x x t}
(@code{toggle-truncate-lines}). This works by locally changing the
variable @code{truncate-lines}. If that variable is non-@code{nil},
long lines are truncated; if it is @code{nil}, they are continued onto
multiple screen lines. Setting the variable @code{truncate-lines} in
any way makes it local to the current buffer; until that time, the
default value, which is normally @code{nil}, is in effect.
If a split window becomes too narrow, Emacs may automatically enable
line truncation. @xref{Split Window}, for the variable

2
doc/emacs/files.texi
View file

@ -927,7 +927,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}.
If you have made extensive changes to a file-visiting buffer and
then change your mind, you can @dfn{revert} the changes and go back to
the saved version of the file. To do this, type @kbd{C-x g}. Since
the saved version of the file. To do this, type @kbd{C-x x g}. Since
reverting unintentionally could lose a lot of work, Emacs asks for
confirmation first.

4
doc/emacs/indent.texi
View file

@ -136,8 +136,8 @@ this transient mode is active, typing @kbd{@key{LEFT}} or
@kbd{@key{RIGHT}} indents leftward and rightward, respectively, by one
space. You can also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to
indent leftward or rightward to the next tab stop (@pxref{Tab Stops}).
Typing any other key disables the transient mode, and resumes normal
editing.
Typing any other key disables the transient mode, and this key is then
acted upon as normally.
If called with a prefix argument @var{n}, this command indents the
lines forward by @var{n} spaces (without enabling the transient mode).

14
doc/emacs/killing.texi
View file

@ -703,13 +703,13 @@ copy-to-buffer} is similar, except that any existing text in the other
buffer is deleted, so the buffer is left containing just the text newly
copied into it.
The command @kbd{M-x insert-buffer} can be used to retrieve the
accumulated text from another buffer. This prompts for the name of a
buffer, and inserts a copy of all the text in that buffer into the
current buffer at point, leaving point at the beginning of the
inserted text. It also adds the position of the end of the inserted
text to the mark ring, without activating the mark. @xref{Buffers},
for background information on buffers.
The command @kbd{C-x x i} (@code{insert-buffer}) can be used to
retrieve the accumulated text from another buffer. This prompts for
the name of a buffer, and inserts a copy of all the text in that
buffer into the current buffer at point, leaving point at the
beginning of the inserted text. It also adds the position of the end
of the inserted text to the mark ring, without activating the mark.
@xref{Buffers}, for background information on buffers.
Instead of accumulating text in a buffer, you can append text
directly into a file with @kbd{M-x append-to-file}. This prompts for

12
doc/emacs/m-x.texi
View file

@ -46,9 +46,17 @@ from running the command by name.
@cindex obsolete command
When @kbd{M-x} completes on commands, it ignores the commands that
are declared @dfn{obsolete}; for these, you will have to type their
full name. Obsolete commands are those for which newer, better
full name. (Obsolete commands are those for which newer, better
alternatives exist, and which are slated for removal in some future
Emacs release.
Emacs release.)
@vindex read-extended-command-predicate
In addition, @kbd{M-x} completion can exclude commands that are not
relevant to, and generally cannot work with, the current buffer's
major mode (@pxref{Major Modes}) and minor modes (@pxref{Minor
Modes}). By default, no commands are excluded, but you can customize
the option @code{read-extended-command-predicate} to exclude those
irrelevant commands from completion results.
To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead
of entering the command name. This takes you back to command level.

8
doc/emacs/windows.texi
View file

@ -161,6 +161,8 @@ Select another window (@code{other-window}).
Scroll the next window upward (@code{scroll-other-window}).
@item C-M-S-v
Scroll the next window downward (@code{scroll-other-window-down}).
@item C-M-S-l
Recenter the next window (@code{recenter-other-window}).
@item mouse-1
@kbd{mouse-1}, in the text area of a window, selects the window and
moves point to the position clicked. Clicking in the mode line
@ -194,6 +196,8 @@ rebind a command.)
@findex scroll-other-window
@kindex C-M-S-v
@findex scroll-other-window-down
@kindex C-M-S-l
@findex recenter-other-window
The usual scrolling commands (@pxref{Display}) apply to the selected
window only, but there are also commands to scroll the next window.
@kbd{C-M-v} (@code{scroll-other-window}) scrolls the window that
@ -203,7 +207,9 @@ take positive and negative arguments. (In the minibuffer, @kbd{C-M-v}
scrolls the help window associated with the minibuffer, if any, rather
than the next window in the standard cyclic order; @pxref{Minibuffer
Edit}.) @kbd{C-M-S-v} (@code{scroll-other-window-down}) scrolls the
next window downward in a similar way.
next window downward in a similar way. Likewise, @kbd{C-M-S-l}
(@code{recenter-other-window}) behaves like @kbd{C-l}
(@code{recenter-top-bottom}) in the next window.
@vindex mouse-autoselect-window
If you set @code{mouse-autoselect-window} to a non-@code{nil} value,

97
doc/lispref/commands.texi
View file

@ -144,6 +144,7 @@ commands by adding the @code{interactive} form to them.
* Interactive Codes:: The standard letter-codes for reading arguments
in various ways.
* Interactive Examples:: Examples of how to read interactive arguments.
* Command Modes:: Specifying that commands are for a specific mode.
* Generic Commands:: Select among command alternatives.
@end menu
@ -156,7 +157,7 @@ commands by adding the @code{interactive} form to them.
makes a Lisp function an interactively-callable command, and how to
examine a command's @code{interactive} form.
@defspec interactive arg-descriptor
@defspec interactive &optional arg-descriptor &rest modes
This special form declares that a function is a command, and that it
may therefore be called interactively (via @kbd{M-x} or by entering a
key sequence bound to it). The argument @var{arg-descriptor} declares
@ -177,6 +178,10 @@ forms are executed; at this time, if the @code{interactive} form
occurs within the body, the form simply returns @code{nil} without
even evaluating its argument.
The @var{modes} list allows specifying which modes the command is
meant to be used in. See @ref{Command Modes} for more details about
the effect of specifying @var{modes}, and when to use it.
By convention, you should put the @code{interactive} form in the
function body, as the first top-level form. If there is an
@code{interactive} form in both the @code{interactive-form} symbol
@ -488,7 +493,10 @@ I/O.
Point and the mark, as two numeric arguments, smallest first. This is
the only code letter that specifies two successive arguments rather than
one. This will signal an error if the mark is not set in the buffer
which is current when the command is invoked. No I/O.
which is current when the command is invoked. If Transient Mark mode
is turned on (@pxref{The Mark}) --- as it is by default --- and user
option @code{mark-even-if-inactive} is @code{nil}, Emacs will signal
an error even if the mark @emph{is} set, but is inactive. No I/O.
@item s
Arbitrary text, read in the minibuffer and returned as a string
@ -588,6 +596,77 @@ Put them into three windows, selecting the last one."
@end group
@end example
@node Command Modes
@subsection Specifying Modes For Commands
Many commands in Emacs are general, and not tied to any specific mode.
For instance, @kbd{M-x kill-region} can be used in pretty much any
mode that has editable text, and commands that display information
(like @kbd{M-x list-buffers}) can be used in pretty much any context.
Many other commands, however, are specifically tied to a mode, and
make no sense outside of that context. For instance, @code{M-x
dired-diff} will just signal an error if used outside of a Dired
buffer.
Emacs therefore has a mechanism for specifying what mode (or modes) a
command ``belongs'' to:
@lisp
(defun dired-diff (...)
...
(interactive "p" dired-mode)
...)
@end lisp
This will mark the command as applicable to @code{dired-mode} only (or
any modes that are derived from @code{dired-mode}). Any number of
modes can be added to the @code{interactive} form.
@vindex read-extended-command-predicate
Specifying modes may affect completion in @kbd{M-x}, depending on the
value of @code{read-extended-command-predicate}.
For instance, when using the
@code{command-completion-default-include-p} predicate, @kbd{M-x} won't
list commands that have been marked as being applicable to a specific
mode (unless you are in a buffer that uses that mode, of course).
This goes for both major and minor modes.
Marking commands this way will also make @kbd{C-h m} list these
commands (if they aren't bound to any keys).
If using this extended @code{interactive} form isn't convenient
(because the code is supposed to work in older versions of Emacs that
don't support the extended @code{interactive} form), the following
equivalent declaration (@pxref{Declare Form}) can be used instead:
@lisp
(declare (modes dired-mode))
@end lisp
Which commands to tag with modes is to some degree a matter of taste,
but commands that clearly do not work outside of the mode should be
tagged. This includes commands that will signal an error if called
from somewhere else, but also commands that are destructive when
called from an unexpected mode. (This usually includes most of the
commands that are written for special (i.e., non-editing) modes.)
Some commands may be harmless, and ``work'' when called from other
modes, but should still be tagged with a mode if they don't actually
make much sense to use elsewhere. For instance, many special modes
have commands to exit the buffer bound to @kbd{q}, and may not do
anything but issue a message like "Goodbye from this mode" and then
call @code{kill-buffer}. This command will ``work'' from any mode,
but it is highly unlikely that anybody would actually want to use the
command outside the context of this special mode.
Many modes have a set of different commands that start the mode in
different ways (e.g., @code{eww-open-in-new-buffer} and
@code{eww-open-file}). Commands like that should never be tagged as
mode-specific, as they can be issued by the user from pretty much any
context.
@node Generic Commands
@subsection Select among Command Alternatives
@cindex generic commands
@ -756,6 +835,20 @@ part of the prompt.
@result{} t
@end group
@end example
@vindex read-extended-command-predicate
@findex command-completion-default-include-p
This command heeds the @code{read-extended-command-predicate}
variable, which can filter out commands that are not applicable to the
current major mode (or enabled minor modes). By default, the value of
this variable is @code{nil}, and no commands are filtered out.
However, customizing it to invoke the function
@code{command-completion-default-include-p} will perform
mode-dependent filtering. @code{read-extended-command-predicate} can
be any predicate function; it will be called with two parameters: the
command's symbol and the current buffer. If should return
non-@code{nil} if the command is to be included when completing in
that buffer.
@end deffn
@node Distinguish Interactive

2
doc/lispref/display.texi
View file

@ -1997,7 +1997,7 @@ the beginning of the result if a multi-column character in
If @var{ellipsis} is non-@code{nil}, it should be a string which will
replace the end of @var{string} when it is truncated. In this case,
more charcaters will be removed from @var{string} to free enough space
more characters will be removed from @var{string} to free enough space
for @var{ellipsis} to fit within @var{width} columns. However, if
the display width of @var{string} is less than the display width of
@var{ellipsis}, @var{ellipsis} will not be appended to the result. If

92
doc/lispref/edebug.texi
View file

@ -1203,7 +1203,7 @@ define Edebug specifications for special forms implemented in C.
@defmac def-edebug-spec macro specification
Specify which expressions of a call to macro @var{macro} are forms to be
evaluated. @var{specification} should be the edebug specification.
evaluated. @var{specification} should be the Edebug specification.
Neither argument is evaluated.
The @var{macro} argument can actually be any symbol, not just a macro
@ -1290,14 +1290,6 @@ Short for @code{&rest form}. See @code{&rest} below. If your macro
wraps its body of code with @code{lambda} before it is evaluated, use
@code{def-body} instead. See @code{def-body} below.
@item function-form
A function form: either a quoted function symbol, a quoted lambda
expression, or a form (that should evaluate to a function symbol or
lambda expression). This is useful when an argument that's a lambda
expression might be quoted with @code{quote} rather than
@code{function}, since it instruments the body of the lambda expression
either way.
@item lambda-expr
A lambda expression with no quoting.
@ -1370,6 +1362,21 @@ is primarily used to generate more specific syntax error messages. See
edebug-spec; it aborts the instrumentation, displaying the message in
the minibuffer.
@item &interpose
Lets a function control the parsing of the remaining code.
It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}}
and means that Edebug will first match @var{spec} against the code and
then call @var{fun} with the code that matched @code{spec}, a parsing
function @var{pf}, and finally @var{args...}. The parsing
function expects a single argument indicating the specification list
to use to parse the remaining code. It should be called exactly once
and returns the instrumented code that @var{fun} is expected to return.
For example @code{(&interpose symbolp pcase--match-pat-args)} matches
sexps whose first element is a symbol and then lets
@code{pcase--match-pat-args} lookup the specs associated
with that head symbol according to @code{pcase--match-pat-args} and
pass them to the @var{pf} it received as argument.
@item @var{other-symbol}
@cindex indirect specifications
Any other symbol in a specification list may be a predicate or an
@ -1378,8 +1385,13 @@ indirect specification.
If the symbol has an Edebug specification, this @dfn{indirect
specification} should be either a list specification that is used in
place of the symbol, or a function that is called to process the
arguments. The specification may be defined with @code{def-edebug-spec}
just as for macros. See the @code{defun} example.
arguments. The specification may be defined with
@code{def-edebug-elem-spec}:
@defun def-edebug-elem-spec element specification
Define the @var{specification} to use in place of the symbol @var{element}.
@var{specification} has to be a list.
@end defun
Otherwise, the symbol should be a predicate. The predicate is called
with the argument, and if the predicate returns @code{nil}, the
@ -1428,29 +1440,23 @@ Here is a list of additional specifications that may appear only after
@code{&define}. See the @code{defun} example.
@table @code
@item &name
Extracts the name of the current defining form from the code.
It takes the form @code{&name [@var{prestring}] @var{spec}
[@var{poststring}] @var{fun} @var{args...}} and means that Edebug will
match @var{spec} against the code and then call @var{fun} with the
concatenation of the current name, @var{args...}, @var{prestring},
the code that matched @code{spec}, and @var{poststring}. If @var{fun}
is absent, it defaults to a function that concatenates the arguments
(with an @code{@@} between the previous name and the new).
@item name
The argument, a symbol, is the name of the defining form.
Shorthand for @code{[&name symbolp]}.
A defining form is not required to have a name field; and it may have
multiple name fields.
@item :name
This construct does not actually match an argument. The element
following @code{:name} should be a symbol; it is used as an additional
name component for the definition. You can use this to add a unique,
static component to the name of the definition. It may be used more
than once.
@item :unique
This construct is like @code{:name}, but generates unique names. It
does not match an argument. The element following @code{:unique}
should be a string; it is used as the prefix for an additional name
component for the definition. You can use this to add a unique,
dynamic component to the name of the definition. This is useful for
macros that can define the same symbol multiple times in different
scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may
be used more than once.
@item arg
The argument, a symbol, is the name of an argument of the defining form.
However, lambda-list keywords (symbols starting with @samp{&})
@ -1557,14 +1563,14 @@ specification for @code{defmacro} is very similar to that for
[&optional ("interactive" interactive)]
def-body))
(def-edebug-spec lambda-list
(([&rest arg]
[&optional ["&optional" arg &rest arg]]
&optional ["&rest" arg]
)))
(def-edebug-elem-spec 'lambda-list
'(([&rest arg]
[&optional ["&optional" arg &rest arg]]
&optional ["&rest" arg]
)))
(def-edebug-spec interactive
(&optional &or stringp def-form)) ; @r{Notice: @code{def-form}}
(def-edebug-elem-spec 'interactive
'(&optional &or stringp def-form)) ; @r{Notice: @code{def-form}}
@end smallexample
The specification for backquote below illustrates how to match
@ -1577,11 +1583,11 @@ could fail.)
@smallexample
(def-edebug-spec \` (backquote-form)) ; @r{Alias just for clarity.}
(def-edebug-spec backquote-form
(&or ([&or "," ",@@"] &or ("quote" backquote-form) form)
(backquote-form . [&or nil backquote-form])
(vector &rest backquote-form)
sexp))
(def-edebug-elem-spec 'backquote-form
'(&or ([&or "," ",@@"] &or ("quote" backquote-form) form)
(backquote-form . [&or nil backquote-form])
(vector &rest backquote-form)
sexp))
@end smallexample
@ -1624,10 +1630,10 @@ option. @xref{Instrumenting}.
@defopt edebug-eval-macro-args
When this is non-@code{nil}, all macro arguments will be instrumented
in the generated code. For any macro, an @code{edebug-form-spec}
in the generated code. For any macro, the @code{debug} declaration
overrides this option. So to specify exceptions for macros that have
some arguments evaluated and some not, use @code{def-edebug-spec} to
specify an @code{edebug-form-spec}.
some arguments evaluated and some not, use the @code{debug} declaration
specify an Edebug form specification.
@end defopt
@defopt edebug-save-windows

2
doc/lispref/frames.texi
View file

@ -1802,6 +1802,8 @@ Geometry}).
@item child-frame-border-width
The width in pixels of the frame's internal border (@pxref{Frame
Geometry}) if the given frame is a child frame (@pxref{Child Frames}).
If this is @code{nil}, the value specified by the
@code{internal-border-width} parameter is used instead.
@vindex vertical-scroll-bars@r{, a frame parameter}
@item vertical-scroll-bars

10
doc/lispref/functions.texi
View file

@ -2309,6 +2309,16 @@ form @code{(lambda (@var{arg}) @var{body})} in which case that function will
additionally have access to the macro (or function)'s arguments and it will
be passed to @code{gv-define-setter}.
@item (completion @var{completion-predicate})
Declare @var{completion-predicate} as a function to determine whether
to include the symbol in the list of functions when asking for
completions in @kbd{M-x}. @var{completion-predicate} is called with
two parameters: The first parameter is the symbol, and the second is
the current buffer.
@item (modes @var{modes})
Specify that this command is meant to be applicable for @var{modes}
only.
@end table
@end defmac

9
doc/lispref/hash.texi
View file

@ -150,11 +150,11 @@ multiplied by an approximation to this value. The default for
@end table
@end defun
You can also create a new hash table using the printed representation
You can also create a hash table using the printed representation
for hash tables. The Lisp reader can read this printed
representation, provided each element in the specified hash table has
a valid read syntax (@pxref{Printed Representation}). For instance,
the following specifies a new hash table containing the keys
the following specifies a hash table containing the keys
@code{key1} and @code{key2} (both symbols) associated with @code{val1}
(a symbol) and @code{300} (a number) respectively.
@ -162,6 +162,11 @@ the following specifies a new hash table containing the keys
#s(hash-table size 30 data (key1 val1 key2 300))
@end example
Note, however, that when using this in Emacs Lisp code, it's
undefined whether this creates a new hash table or not. If you want
to create a new hash table, you should always use
@code{make-hash-table} (@pxref{Self-Evaluating Forms}).
@noindent
The printed representation for a hash table consists of @samp{#s}
followed by a list beginning with @samp{hash-table}. The rest of the

6
doc/lispref/keymaps.texi
View file

@ -573,12 +573,6 @@ key.
@code{search-map} is the global keymap used for the @kbd{M-s} prefix
key.
@item
@cindex @kbd{M-o}
@vindex facemenu-keymap
@code{facemenu-keymap} is the global keymap used for the @kbd{M-o}
prefix key.
@item
The other Emacs prefix keys are @kbd{C-x @@}, @kbd{C-x a i}, @kbd{C-x
@key{ESC}} and @kbd{@key{ESC} @key{ESC}}. They use keymaps that have

13
doc/lispref/lists.texi
View file

@ -1168,13 +1168,14 @@ x
@end group
@end example
However, the other arguments (all but the last) should be mutable lists.
However, the other arguments (all but the last) should be mutable
lists.
A common pitfall is to use a constant list as a non-last
argument to @code{nconc}. If you do this, the resulting behavior
is undefined. It is possible that your program will change
each time you run it! Here is what might happen (though this
is not guaranteed to happen):
A common pitfall is to use a constant list as a non-last argument to
@code{nconc}. If you do this, the resulting behavior is undefined
(@pxref{Self-Evaluating Forms}). It is possible that your program
will change each time you run it! Here is what might happen (though
this is not guaranteed to happen):
@smallexample
@group

5
doc/lispref/loading.texi
View file

@ -510,6 +510,9 @@ specification is not given here; it's not needed unless the user
actually calls @var{function}, and when that happens, it's time to load
the real definition.
If @var{interactive} is a list, it is interpreted as a list of modes
this command is applicable for.
You can autoload macros and keymaps as well as ordinary functions.
Specify @var{type} as @code{macro} if @var{function} is really a macro.
Specify @var{type} as @code{keymap} if @var{function} is really a
@ -1125,7 +1128,7 @@ You don't need to give a directory or extension in the file name
@var{library}. Normally, you just give a bare file name, like this:
@example
(with-eval-after-load "edebug" (def-edebug-spec c-point t))
(with-eval-after-load "js" (define-key js-mode-map "\C-c\C-c" 'js-eval))
@end example
To restrict which files can trigger the evaluation, include a

3
doc/lispref/maps.texi
View file

@ -53,9 +53,6 @@ A sparse keymap for subcommands of the prefix @kbd{C-x r}.@*
@item esc-map
A full keymap for @key{ESC} (or @key{Meta}) commands.
@item facemenu-keymap
A sparse keymap used for the @kbd{M-o} prefix key.
@item function-key-map
The parent keymap of all @code{local-function-key-map} (q.v.@:) instances.

4
doc/lispref/markers.texi
View file

@ -609,8 +609,8 @@ the function @code{use-region-p} for that (@pxref{The Region}).
@defvarx deactivate-mark-hook
These normal hooks are run, respectively, when the mark becomes active
and when it becomes inactive. The hook @code{activate-mark-hook} is
also run at the end of the command loop if the mark is active and it
is possible that the region may have changed.
also run when the region is reactivated, for instance after using a
command that switches back to a buffer that has an active mark.
@ignore
This piece of command_loop_1, run unless deactivating the mark:
if (current_buffer != prev_buffer || MODIFF != prev_modiff)

2
doc/lispref/minibuf.texi
View file

@ -2393,7 +2393,7 @@ minibuffer.
@deffn Command exit-minibuffer
This command exits the active minibuffer. It is normally bound to
keys in minibuffer local keymaps. The command throws an error if the
current buffer is not the active minibuffer.
current buffer is a minibuffer, but not the active minibuffer.
@end deffn
@deffn Command self-insert-and-exit

22
doc/lispref/modes.texi
View file

@ -861,6 +861,13 @@ abbrev table as @var{parent}, or @code{fundamental-mode-abbrev-table}
if @var{parent} is @code{nil}. (Again, a @code{nil} value is
@emph{not} equivalent to not specifying this keyword.)
@item :interactive
Modes are interactive commands by default. If you specify a
@code{nil} value, the mode defined here won't be interactive. This is
useful for modes that are never meant to be activated by users
manually, but are only supposed to be used in some specially-formatted
buffer.
@item :group
If this is specified, the value should be the customization group for
this mode. (Not all major modes have one.) The command
@ -1454,6 +1461,16 @@ used only with Diff mode.
other minor modes in effect. It should be possible to activate and
deactivate minor modes in any order.
@defvar local-minor-modes
This buffer-local variable lists the currently enabled minor modes in
the current buffer, and is a list of symbols.
@end defvar
@defvar global-minor-modes
This variable lists the currently enabled global minor modes, and is a
list of symbols.
@end defvar
@defvar minor-mode-list
The value of this variable is a list of all minor mode commands.
@end defvar
@ -1730,6 +1747,11 @@ and @var{set} is a function of one argument (a state) that sets it.
@item :after-hook @var{after-hook}
This defines a single Lisp form which is evaluated after the mode hooks
have run. It should not be quoted.
@item :interactive @var{value}
Minor modes are interactive commands by default. If @var{value} is
@code{nil}, this is inhibited. If @var{value} is a list of symbols,
it's used to say which major modes this minor mode is useful in.
@end table
Any other keyword arguments are passed directly to the

35
doc/lispref/processes.texi
View file

@ -3368,6 +3368,11 @@ processed, and how to pack or unpack it. We normally keep bindat specs
in variables whose names end in @samp{-bindat-spec}; that kind of name
is automatically recognized as risky.
@defmac bindat-spec &rest specs
Creates a Bindat spec object according to the data layout
specification @var{specs}.
@end defmac
@cindex endianness
@cindex big endian
@cindex little endian
@ -3398,12 +3403,16 @@ Unsigned integer in network byte order, with length 3.
@itemx dword
@itemx long
Unsigned integer in network byte order, with length 4.
Note: These values may be limited by Emacs's integer implementation limits.
@item u64
Unsigned integer in network byte order, with length 8.
@item u16r
@itemx u24r
@itemx u32r
Unsigned integer in little endian order, with length 2, 3 and 4, respectively.
@itemx u64r
Unsigned integer in little endian order, with length 2, 3, 4, and
8, respectively.
@item str @var{len}
String of length @var{len}.
@ -3534,16 +3543,16 @@ repetition has completed.
@node Bindat Functions
@subsection Functions to Unpack and Pack Bytes
In the following documentation, @var{spec} refers to a data layout
specification, @code{bindat-raw} to a byte array, and @var{struct} to an
alist representing unpacked field data.
In the following documentation, @var{spec} refers to a Bindat spec
object as returned from @code{bindat-spec}, @code{raw} to a byte
array, and @var{struct} to an alist representing unpacked field data.
@defun bindat-unpack spec bindat-raw &optional bindat-idx
@defun bindat-unpack spec raw &optional idx
@c FIXME? Again, no multibyte?
This function unpacks data from the unibyte string or byte
array @code{bindat-raw}
array @var{raw}
according to @var{spec}. Normally, this starts unpacking at the
beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it
beginning of the byte array, but if @var{idx} is non-@code{nil}, it
specifies a zero-based starting position to use instead.
The value is an alist or nested alist in which each element describes
@ -3576,15 +3585,15 @@ This function returns the total length of the data in @var{struct},
according to @var{spec}.
@end defun
@defun bindat-pack spec struct &optional bindat-raw bindat-idx
@defun bindat-pack spec struct &optional raw idx
This function returns a byte array packed according to @var{spec} from
the data in the alist @var{struct}. It normally creates and fills a
new byte array starting at the beginning. However, if @var{bindat-raw}
new byte array starting at the beginning. However, if @var{raw}
is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to
pack into. If @var{bindat-idx} is non-@code{nil}, it specifies the starting
offset for packing into @code{bindat-raw}.
pack into. If @var{idx} is non-@code{nil}, it specifies the starting
offset for packing into @var{raw}.
When pre-allocating, you should make sure @code{(length @var{bindat-raw})}
When pre-allocating, you should make sure @code{(length @var{raw})}
meets or exceeds the total length to avoid an out-of-range error.
@end defun

2
doc/lispref/sequences.texi
View file

@ -609,7 +609,7 @@ returned value is a list.
(seq-map-indexed (lambda (elt idx)
(list idx elt))
'(a b c))
@result{} ((0 a) (b 1) (c 2))
@result{} ((0 a) (1 b) (2 c))
@end group
@end example
@end defun

9
doc/lispref/syntax.texi
View file

@ -573,10 +573,11 @@ and by Font Lock mode during syntactic fontification (@pxref{Syntactic
Font Lock}). It is called with two arguments, @var{start} and
@var{end}, which are the starting and ending positions of the text on
which it should act. It is allowed to call @code{syntax-ppss} on any
position before @var{end}, but if it calls @code{syntax-ppss} on some
position and later modifies the buffer on some earlier position,
then it is its responsibility to call @code{syntax-ppss-flush-cache}
to flush the now obsolete info from the cache.
position before @var{end}, but if a Lisp program calls
@code{syntax-ppss} on some position and later modifies the buffer at
some earlier position, then it is that program's responsibility to
call @code{syntax-ppss-flush-cache} to flush the now obsolete info
from the cache.
@strong{Caution:} When this variable is non-@code{nil}, Emacs removes
@code{syntax-table} text properties arbitrarily and relies on

7
doc/lispref/text.texi
View file

@ -5288,10 +5288,9 @@ object parsed.
Signaled when encountering invalid JSON syntax.
@end table
Only top-level values (arrays and objects) can be serialized to
JSON@. The subobjects within these top-level values can be of any
type. Likewise, the parsing functions will only return vectors,
hashtables, alists, and plists.
Top-level values and the subobjects within these top-level values
can be serialized to JSON@. Likewise, the parsing functions will
return any of the possible types described above.
@defun json-serialize object &rest args
This function returns a new Lisp string which contains the JSON

2
doc/lispref/windows.texi
View file

@ -2557,7 +2557,7 @@ frame visible and, unless @var{alist} contains an
This function tries to display @var{buffer} by finding a window
that is displaying a buffer in a given mode.
If @var{alist} contains a @code{mode} entry, its value specifes a
If @var{alist} contains a @code{mode} entry, its value specifies a
major mode (a symbol) or a list of major modes. If @var{alist}
contains no @code{mode} entry, the current major mode of @var{buffer}
is used instead. A window is a candidate if it displays a buffer

5
doc/misc/efaq.texi
View file

@ -388,6 +388,11 @@ posting a followup that recommends such software.
@uref{news:gnu.emacs.bug} is a place where bug reports appear, but avoid
posting bug reports to this newsgroup directly (@pxref{Reporting bugs}).
Finally, we recommend reading the
@url{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind
Communications Guidelines} before posting to any GNU lists or
newsgroups.
@node Newsgroup archives
@section Where can I get old postings to @uref{news:gnu.emacs.help} and other GNU groups?
@cindex Archived postings from @code{gnu.emacs.help}

3
doc/misc/forms.texi
View file

@ -6,6 +6,7 @@
@setfilename ../../info/forms.info
@settitle Forms Mode User's Manual
@include docstyle.texi
@include emacsver.texi
@syncodeindex vr cp
@syncodeindex fn cp
@syncodeindex ky cp
@ -47,7 +48,7 @@ modify this GNU manual.''
@sp 4
@center Forms-Mode version 2
@sp 1
@center for GNU Emacs 22.1
@center for GNU Emacs @value{EMACSVER}
@sp 1
@center April 2007
@sp 5

3
doc/misc/gnus.texi
View file

@ -19357,6 +19357,9 @@ and dormant. If @code{nil} (which is the default), only read articles
are eligible for expiry, and unread, ticked and dormant articles will
be kept indefinitely.
The last (i.e., newest) article in a group will normally not be
expired (due to internal book-keeping reasons).
If you find that some articles eligible for expiry are never expired,
perhaps some Gnus Agent files are corrupted. There's are special
commands, @code{gnus-agent-regenerate} and

5
doc/misc/octave-mode.texi
View file

@ -83,9 +83,12 @@ addition to the standard Emacs commands.
@kindex C-M-j
@findex octave-indent-new-comment-line
@vindex octave-continuation-string
@vindex octave-string-continuation-marker
Break Octave line at point, continuing comment if within one. Insert
@code{octave-continuation-string} before breaking the line unless
inside a list. Signal an error if within a single-quoted string.
inside a list. If within a double-quoted string, insert
@code{octave-string-continuation-marker} instead. Signal an error if
within a single-quoted string.
@item C-c ;
@kindex C-c ;

3
doc/misc/remember.texi
View file

@ -3,11 +3,12 @@
@setfilename ../../info/remember.info
@settitle Remember Manual
@include docstyle.texi
@include emacsver.texi
@syncodeindex fn cp
@c %**end of header
@copying
This manual is for Remember Mode, version 2.0
This manual is for Remember Mode, as distributed with Emacs @value{EMACSVER}.
Copyright @copyright{} 2001, 2004--2005, 2007--2021 Free Software
Foundation, Inc.

6
doc/misc/tramp.texi
View file

@ -2083,10 +2083,12 @@ there is no effect of this property.
@item @t{"mount-args"}@*
@t{"copyto-args"}@*
@t{"moveto-args"}
@t{"moveto-args"}@*
@t{"about-args"}
These properties keep optional flags to the different @option{rclone}
operations. Their default value is @code{nil}.
operations. See their default values in @code{tramp-methods} if you
want to change their values.
@end itemize

187
etc/NEWS
View file

@ -24,6 +24,9 @@ applies, and please also update docstrings as needed.
* Installation Changes in Emacs 28.1
--
** Support for building with Motif has been removed.
** Cairo graphics library is now used by default if found.
'--with-cairo' is now the default, if the appropriate development files
are found by 'configure'. Note that building with Cairo means using
@ -87,6 +90,10 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+++
** New command 'recenter-other-window', bound to 'S-M-C-l'.
Like 'recenter-top-bottom' acting in the other window.
** Minibuffer scrolling is now conservative by default.
This is controlled by the new variable 'scroll-minibuffer-conservatively'.
@ -234,11 +241,25 @@ still applies for shorter search strings, which avoids flicker in the
search buffer due to too many matches being highlighted.
+++
** 'revert-buffer' is now bound to 'C-x g' globally.
** A new keymap for buffer actions has been added.
The 'C-x x' keymap now holds keystrokes for various buffer-oriented
commands. The new keystrokes are 'C-x x g' ('revert-buffer'),
'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t'
('toggle-truncate-lines').
* Editing Changes in Emacs 28.1
+++
** New user option 'read-extended-command-predicate'.
This option controls how 'M-x' performs completion of commands when
you type TAB. By default, any command that matches what you have
typed is considered a completion candidate, but you can customize this
option to exclude commands that are not applicable to the current
buffer's major and minor modes, and respect the command's completion
predicate (if any).
---
** 'eval-expression' now no longer signals an error on incomplete expressions.
Previously, typing 'M-: ( RET' would result in Emacs saying "End of
@ -324,6 +345,11 @@ 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.
+++
** The history list for the 'goto-line' command is now a single list
for all buffers by default. You can configure a separate list for
each buffer by customizing the user option 'goto-line-history-local'.
** Outline
+++
@ -340,6 +366,11 @@ the buffer cycles the whole buffer between "only top-level headings",
It used to be enabled when Emacs is started in GUI mode but not when started
in text mode. The cursor still only actually blinks in GUI frames.
** Bindat
+++
*** New types 'u64' and 'u64r'
+++
*** New macro 'bindat-spec' to define specs, with Edebug support
** pcase
+++
@ -445,6 +476,9 @@ value of 'tab-bar-show'.
It can be used to enable/disable the tab bar individually on each frame
independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
---
*** New command 'tab-duplicate'.
---
*** New user option 'tab-bar-tab-name-format-function'.
@ -465,9 +499,14 @@ applied when the option 'tab-line-tab-face-functions' is
so-configured. That option may also be used to customize tab-line
faces in other ways.
** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
** Occur mode
*** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
'previous-error-no-select' bound to 'p'.
*** The new command 'recenter-current-error', bound to 'l' in Occur or
compilation buffers, recenters the current displayed occurrence/error.
** EIEIO
+++
@ -587,6 +626,13 @@ their 'default-directory' under VC.
This is used when expanding commit messages from 'vc-print-root-log'
and similar commands.
---
*** New faces for 'vc-dir' buffers.
Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
'vc-dir-status-edited', 'vc-dir-status-up-to-date',
'vc-dir-status-ignored'.
---
*** The responsible VC backend is now the most specific one.
'vc-responsible-backend' loops over the backends in
@ -851,6 +897,14 @@ iso-transl RET', it supports the same key sequences as 'C-x 8',
so e.g. like 'C-x 8 [' inserts a left single quotation mark,
'C-x \ [' does the same.
---
*** New user options 'read-char-by-name-sort' and 'read-char-by-name-group'.
'read-char-by-name-sort' defines the sorting order of characters for
completion of 'C-x 8 RET TAB' and can be customized to sort them
by codepoints instead of character names by default. The 't' value of
'read-char-by-name-group' groups the characters for completion of
'C-x 8 RET TAB' by Unicode blocks.
---
*** Improved language transliteration in Malayalam input methods.
Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
@ -896,21 +950,42 @@ To revert to the previous behavior,
*** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and
'customize-changed-options'.
'customize-changed'.
To customize obsolete user options, use 'customize-option' or
'customize-saved'.
** Edebug
+++
*** Edebug specification lists can use the new keyword '&error', which
unconditionally aborts the current edebug instrumentation with the
supplied error message.
---
*** Obsoletions
**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
*** Edebug specification lists can use the new keyword ':unique',
which appends a unique suffix to the Edebug name of the current
definition.
+++
**** The spec operator ':name NAME' is obsolete, use '&name' instead.
+++
**** The spec element 'function-form' is obsolete, use 'form' instead.
+++
*** New function 'def-edebug-elem-spec' to define Edebug spec elements.
These used to be defined with 'def-edebug-spec' thus conflating the
two name spaces, which lead to name collisions.
The use of 'def-edebug-spec' to define Edebug spec elements is
declared obsolete.
*** Edebug specification lists can use some new keywords:
+++
**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC.
More specifically, FUN is called with 'HEAD PF ARGS..' where
PF is a parsing function that expects a single argument (the specs to
use) and HEAD is the code that matched SPEC.
+++
**** '&error MSG' unconditionally aborts the current edebug instrumentation.
+++
**** '&name SPEC FUN' extracts the current name from the code matching SPEC.
** ElDoc
@ -940,7 +1015,7 @@ separate buffer, or a tooltip.
*** New user option 'eldoc-documentation-strategy'.
The built-in choices available for this user option let users compose
the results of 'eldoc-documentation-functions' in various ways, even
if some of those functions are sychronous and some asynchchronous.
if some of those functions are synchronous and some asynchronous.
The user option replaces 'eldoc-documentation-function', which is now
obsolete.
@ -1600,6 +1675,13 @@ that makes it a valid button.
*** New variable 'thing-at-point-provider-alist'.
This allows mode-specific alterations to how 'thing-at-point' works.
** Enriched mode
---
*** 'C-a' is by default no longer bound to 'beginning-of-line-text'.
This is so 'C-a' works as in other modes, and in particular holding
Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
** Miscellaneous
+++
@ -1982,6 +2064,26 @@ could have saved enough typing by using an abbrev, a hint will be
displayed in the echo area, mentioning the abbrev that could have been
used instead.
** Octave Mode
+++
*** Line continuations in double-quoted strings now use a backslash.
Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows
the behavior introduced in Octave 3.8 of using a backslash as a line
continuation marker within double-quoted strings, and an ellipsis
everywhere else.
** Repeat
+++
*** New transient mode 'repeat-mode' to allow shorter key sequences.
You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
'C-x o o' instead of 'C-x o C-x o' to switch several windows,
'C-x { { } } ^ ^ v v' to resize the selected window interactively,
'M-g n n p p' to navigate next-error matches. Any other key exits
transient mode and then is executed normally. 'repeat-exit-key'
defines an additional key to exit mode like 'isearch-exit' (RET).
* New Modes and Packages in Emacs 28.1
@ -2012,6 +2114,14 @@ first).
* Incompatible Editing Changes in Emacs 28.1
** The 'M-o' ('facemenu-keymap') global binding has been removed.
** The 'M-o M-s' and 'M-o M-S' global bindings have been removed.
Use 'M-x center-line' and 'M-x center-paragraph' instead.
** The 'M-o M-o' global binding have been removed.
Use 'M-x font-lock-fontify-block' instead.
** In 'f90-mode', the backslash character ('\') no longer escapes.
For about a decade, the backslash character has no longer had a
special escape syntax in Fortran F90. To get the old behaviour back,
@ -2029,6 +2139,8 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'.
** 'completions-annotations' face is not used when the caller puts own face.
This affects the suffix specified by completion 'annotation-function'.
@ -2084,6 +2196,11 @@ 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
@ -2188,6 +2305,48 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete',
* Lisp Changes in Emacs 28.1
+++
** New forms to declare how completion should happen has been added.
'(declare (completion PREDICATE))' can be used as a general predicate
to say whether the command should be present when completing with
'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand
way of saying that the command should be present when completing from
buffers in major modes derived from MODE..., or, if it's a minor mode,
whether that minor mode is enabled in the current buffer.
+++
** The 'interactive' syntax has been extended to allow listing applicable modes.
Forms like '(interactive "p" dired-mode)' can be used to annotate the
commands as being applicable for modes derived from 'dired-mode',
or if the mode is a minor mode, that the current buffer has that
minor mode activated. Note that using this form will create byte code
that is not compatible with byte code in previous Emacs versions.
+++
** New buffer-local variable 'local-minor-modes'.
This permanently buffer-local variable holds a list of currently
enabled non-global minor modes in the current buffer (as a list of
symbols).
+++
** New variable 'global-minor-modes'.
This variable holds a list of currently enabled global minor modes (as
a list of symbols).
+++
** 'define-minor-mode' now takes an :interactive argument.
This can be used for specifying which modes this minor mode is meant
for, or to make the new minor mode non-interactive. The default value
is t.
+++
** 'define-derived-mode' now takes an :interactive argument.
This can be used to control whether the defined mode is a command
or not, and is useful when defining commands that aren't meant to be
used by users directly.
** The 'values' variable is now obsolete.
---
** New variable 'indent-line-ignored-functions'.
This allows modes to cycle through a set of indentation functions
@ -2482,6 +2641,12 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g.,
'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
support these coding-systems.
** The JSON functions 'json-serialize', 'json-insert',
'json-parse-string', and 'json-parse-buffer' now implement some of the
semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
these functions now accept top-level JSON values that are neither
arrays nor objects.
* Changes in Emacs 28.1 on Non-Free Operating Systems

2
etc/ORG-NEWS
View file

@ -747,7 +747,7 @@ removed.
For those who hate breaking changes, even though the changes are made
to clean things up; fear not. ATTACH_DIR will still continue to work.
It's just not documented any longer. When you get the chance, run the
code above to clean things up anyways!
code above to clean things up anyway!
**** New hooks
Two hooks are added to org-attach:

20
etc/facemenu-removal.txt Normal file
View file

@ -0,0 +1,20 @@
`facemenu-keymap' (normally bound to `M-o') has been disabled.
==============================================================
We've disabled the normal `M-o' keymap for a month (until March the
10th, 2021) in the development version of Emacs to see whether anybody
uses this feature.
If the removal of this key binding doesn't annoy too many people, the
plan is to then leave the it unbound, for usage by third-party
packages and users.
If you wish to restore the binding during the trial period, you can
put the following in your .emacs file:
(facemenu-keymap-restore)
After the trial period is over, the function will be removed.
If you wish to protest the removal of the `M-o' key binding, please
send your thoughts to the emacs-devel@gnu.org mailing list.

10
etc/themes/modus-operandi-theme.el
View file

@ -10,18 +10,18 @@
;; This file is part of GNU Emacs.
;; This program is free software; you can redistribute it and/or
;; 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.
;;
;; This program is distributed in the hope that it will be useful,
;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;

10
etc/themes/modus-vivendi-theme.el
View file

@ -10,18 +10,18 @@
;; This file is part of GNU Emacs.
;; This program is free software; you can redistribute it and/or
;; 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.
;;
;; This program is distributed in the hope that it will be useful,
;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;

77
lisp/auth-source.el
View file

@ -581,14 +581,15 @@ default value. If the user, host, or port are missing, the alist
`auth-source-creation-prompts' will be used to look up the
prompts IN THAT ORDER (so the `user' prompt will be queried first,
then `host', then `port', and finally `secret'). Each prompt string
can use %u, %h, and %p to show the user, host, and port.
can use %u, %h, and %p to show the user, host, and port. The prompt
is formatted with `format-prompt', a trailing \": \" is removed.
Here's an example:
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
\\='((secret . \"Enter IMAP password for %h:%p: \"))))
\\='((secret . \"Enter IMAP password for %h:%p\"))))
(auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
:P \"pppp\" :Q \"qqqq\"
:create \\='(A B Q)))
@ -860,7 +861,9 @@ while \(:host t) would find all host entries."
secret)))
(defun auth-source-format-prompt (prompt alist)
"Format PROMPT using %x (for any character x) specifiers in ALIST."
"Format PROMPT using %x (for any character x) specifiers in ALIST.
Remove trailing \": \"."
(setq prompt (replace-regexp-in-string ":\\s-*$" "" prompt))
(dolist (cell alist)
(let ((c (nth 0 cell))
(v (nth 1 cell)))
@ -1344,11 +1347,11 @@ See `auth-source-search' for details on SPEC."
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
(host "%p host name for user %u: ")
(port "%p port for %u@%h: "))
(format "Enter %s (%%u@%%h:%%p): " r)))
(secret "%p password for %u@%h")
(user "%p user name for %h")
(host "%p host name for user %u")
(port "%p port for %u@%h"))
(format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@ -1378,7 +1381,9 @@ See `auth-source-search' for details on SPEC."
(setq check nil)))
ret))
(t 'never)))
(plain (or (eval default) (read-passwd prompt))))
(plain
(or (eval default)
(read-passwd (format-prompt prompt nil)))))
;; ask if we don't know what to do (in which case
;; auth-source-netrc-use-gpg-tokens must be a list)
(unless gpg-encrypt
@ -1390,12 +1395,9 @@ See `auth-source-search' for details on SPEC."
(if (eq gpg-encrypt 'gpg)
(auth-source-epa-make-gpg-token plain file)
plain))
(if (stringp default)
(read-string (if (string-match ": *\\'" prompt)
(concat (substring prompt 0 (match-beginning 0))
" (default " default "): ")
(concat prompt "(default " default ") "))
nil nil default)
(if (and (stringp default) auth-source-save-behavior)
(read-string
(format-prompt prompt default) nil nil default)
(eval default)))))
(when data
@ -1745,12 +1747,12 @@ authentication tokens:
"[any label]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
(host "%p host name for user %u: ")
(port "%p port for %u@%h: ")
(label "Enter label for %u@%h: "))
(format "Enter %s (%%u@%%h:%%p): " r)))
(secret "%p password for %u@%h")
(user "%p user name for %h")
(host "%p host name for user %u")
(port "%p port for %u@%h")
(label "Enter label for %u@%h"))
(format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@ -1760,13 +1762,11 @@ authentication tokens:
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
(or (eval default) (read-passwd prompt))
(if (stringp default)
(read-string (if (string-match ": *\\'" prompt)
(concat (substring prompt 0 (match-beginning 0))
" (default " default "): ")
(concat prompt "(default " default ") "))
nil nil default)
(or (eval default)
(read-passwd (format-prompt prompt nil)))
(if (and (stringp default) auth-source-save-behavior)
(read-string
(format-prompt prompt default) nil nil default)
(eval default)))))
(when data
@ -2190,11 +2190,11 @@ entries for git.gnus.org:
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
(host "%p host name for user %u: ")
(port "%p port for %u@%h: "))
(format "Enter %s (%%u@%%h:%%p): " r)))
(secret "%p password for %u@%h")
(user "%p user name for %h")
(host "%p host name for user %u")
(port "%p port for %u@%h"))
(format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@ -2204,14 +2204,11 @@ entries for git.gnus.org:
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
(or (eval default) (read-passwd prompt))
(if (stringp default)
(or (eval default)
(read-passwd (format-prompt prompt nil)))
(if (and (stringp default) auth-source-save-behavior)
(read-string
(if (string-match ": *\\'" prompt)
(concat (substring prompt 0 (match-beginning 0))
" (default " default "): ")
(concat prompt "(default " default ") "))
nil nil default)
(format-prompt prompt default) nil nil default)
(eval default)))))
(when data

21
lisp/avoid.el
View file

@ -25,8 +25,10 @@
;; For those who are annoyed by the mouse pointer obscuring text,
;; this mode moves the mouse pointer - either just a little out of
;; the way, or all the way to the corner of the frame.
;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
;; To set up permanently, put the following in your .emacs:
;;
;; To use, type `M-x mouse-avoidance-mode'.
;;
;; To set up permanently, put this in your .emacs:
;;
;; (if (display-mouse-p) (mouse-avoidance-mode 'animate))
;;
@ -47,11 +49,6 @@
;;
;; For completely random pointer shape, replace the setq above with:
;; (setq x-pointer-shape (mouse-avoidance-random-shape))
;;
;; Bugs / Warnings / To-Do:
;;
;; - Using this code does slow Emacs down. "banish" mode shouldn't
;; be too bad, and on my workstation even "animate" is reasonable.
;; Credits:
;; This code was helped by all those who contributed suggestions,
@ -76,7 +73,7 @@
"Activate Mouse Avoidance mode.
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
use either \\[customize] or the function `mouse-avoidance-mode'."
use either \\[customize] or \\[mouse-avoidance-mode]."
:set (lambda (_symbol value)
;; 'none below prevents toggling when value is nil.
(mouse-avoidance-mode (or value 'none)))
@ -261,9 +258,9 @@ If you want the mouse banished to a different corner set
(t 0))))
(defun mouse-avoidance-nudge-mouse ()
;; Push the mouse a little way away, possibly animating the move.
;; For these modes, state keeps track of the total offset that we've
;; accumulated, and tries to keep it close to zero.
"Push the mouse a little way away, possibly animating the move.
For these modes, state keeps track of the total offset that we've
accumulated, and tries to keep it close to zero."
(let* ((cur (mouse-position))
(cur-pos (cdr cur))
(pos (window-edges))
@ -375,7 +372,7 @@ redefine this function to suit your own tastes."
(setq mouse-avoidance-state nil))))))
(defun mouse-avoidance-fancy ()
;; Used for the "fancy" modes, ie jump et al.
;; Used for the "fancy" modes, i.e. jump et al.
(if (and (not mouse-avoidance-animating-pointer)
(not (mouse-avoidance-ignore-p))
(mouse-avoidance-too-close-p (mouse-position)))

4
lisp/battery.el
View file

@ -246,7 +246,7 @@ seconds."
(add-to-list 'global-mode-string 'battery-mode-line-string t)
(and (eq battery-status-function #'battery-upower)
battery-upower-subscribe
(battery--upower-subsribe))
(battery--upower-subscribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
#'battery-update-handler))
(battery-update))
@ -634,7 +634,7 @@ Intended as a UPower PropertiesChanged signal handler."
(mapc #'dbus-unregister-object battery--upower-signals)
(setq battery--upower-signals ()))
(defun battery--upower-subsribe ()
(defun battery--upower-subscribe ()
"Subscribe to UPower device change signals."
(push (dbus-register-signal :system battery-upower-service
battery-upower-path

29
lisp/bindings.el
View file

@ -950,6 +950,12 @@ if `inhibit-field-text-motion' is non-nil."
;; Richard said that we should not use C-x <uppercase letter> and I have
;; no idea whereas to bind it. Any suggestion welcome. -stef
;; (define-key ctl-x-map "U" 'undo-only)
(defvar undo-repeat-map
(let ((map (make-sparse-keymap)))
(define-key map "u" 'undo)
map)
"Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.")
(put 'undo 'repeat-map 'undo-repeat-map)
(define-key esc-map "!" 'shell-command)
(define-key esc-map "|" 'shell-command-on-region)
@ -1036,6 +1042,17 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "`" 'next-error)
(defvar next-error-repeat-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'next-error)
(define-key map "\M-n" 'next-error)
(define-key map "p" 'previous-error)
(define-key map "\M-p" 'previous-error)
map)
"Keymap to repeat next-error key sequences. Used in `repeat-mode'.")
(put 'next-error 'repeat-map 'next-error-repeat-map)
(put 'previous-error 'repeat-map 'next-error-repeat-map)
(defvar goto-map (make-sparse-keymap)
"Keymap for navigation commands.")
(define-key esc-map "g" goto-map)
@ -1413,7 +1430,17 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "z" 'repeat)
(define-key ctl-x-map "g" #'revert-buffer)
(defvar ctl-x-x-map
(let ((map (make-sparse-keymap)))
(define-key map "g" #'revert-buffer)
(define-key map "r" #'rename-buffer)
(define-key map "u" #'rename-uniquely)
(define-key map "n" #'clone-buffer)
(define-key map "i" #'insert-buffer)
(define-key map "t" #'toggle-truncate-lines)
map)
"Keymap for subcommands of C-x x.")
(define-key ctl-x-map "x" ctl-x-x-map)
(define-key esc-map "\C-l" 'reposition-window)

80
lisp/bookmark.el
View file

@ -953,7 +953,7 @@ When you have finished composing, type \\[bookmark-send-edited-annotation].
(defun bookmark-send-edited-annotation ()
"Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
(interactive)
(interactive nil bookmark-edit-annotation-mode)
(if (not (derived-mode-p 'bookmark-edit-annotation-mode))
(error "Not in bookmark-edit-annotation-mode"))
(goto-char (point-min))
@ -1040,6 +1040,14 @@ it to the name of the bookmark currently being set, advancing
(car dired-directory)))
(t (error "Buffer not visiting a file or directory")))))
(defvar bookmark--watch-already-asked-mtime nil
"Mtime for which we already queried about reloading.")
(defun bookmark--watch-file-already-queried-p (new-mtime)
;; Don't ask repeatedly if user already said "no" to reloading a
;; file with this mtime:
(prog1 (equal new-mtime bookmark--watch-already-asked-mtime)
(setq bookmark--watch-already-asked-mtime new-mtime)))
(defun bookmark-maybe-load-default-file ()
"If bookmarks have not been loaded from the default place, load them."
@ -1048,13 +1056,15 @@ it to the name of the bookmark currently being set, advancing
(file-readable-p bookmark-default-file)
(bookmark-load bookmark-default-file t t)))
((and bookmark-watch-bookmark-file
(not (equal (nth 5 (file-attributes
(car bookmark-bookmarks-timestamp)))
(cdr bookmark-bookmarks-timestamp)))
(or (eq 'silent bookmark-watch-bookmark-file)
(yes-or-no-p
(format "Bookmarks %s changed on disk. Reload? "
(car bookmark-bookmarks-timestamp)))))
(let ((new-mtime (nth 5 (file-attributes
(car bookmark-bookmarks-timestamp))))
(old-mtime (cdr bookmark-bookmarks-timestamp)))
(and (not (equal new-mtime old-mtime))
(not (bookmark--watch-file-already-queried-p new-mtime))
(or (eq 'silent bookmark-watch-bookmark-file)
(yes-or-no-p
(format "Bookmarks %s changed on disk. Reload? "
(car bookmark-bookmarks-timestamp)))))))
(bookmark-load (car bookmark-bookmarks-timestamp) t t))))
(defun bookmark-maybe-sort-alist ()
@ -1827,7 +1837,7 @@ This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
(defun bookmark-bmenu-toggle-filenames (&optional show)
"Toggle whether filenames are shown in the bookmark list.
Optional argument SHOW means show them unconditionally."
(interactive)
(interactive nil bookmark-bmenu-mode)
(cond
(show
(setq bookmark-bmenu-toggle-filenames t))
@ -1912,14 +1922,14 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(tabulated-list-put-tag ">" t))
(defun bookmark-bmenu-mark-all ()
"Mark all listed bookmarks to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
(interactive)
(interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@ -1930,7 +1940,7 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-select ()
"Select this line's bookmark; also display bookmarks marked with `>'.
You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(others ())
@ -1975,7 +1985,7 @@ You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mar
(defun bookmark-bmenu-save ()
"Save the current list into a bookmark file.
With a prefix arg, prompts for a file to save them in."
(interactive)
(interactive nil bookmark-bmenu-mode)
(save-excursion
(save-window-excursion
(call-interactively 'bookmark-save)
@ -1984,7 +1994,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-load ()
"Load the bookmark file and rebuild the bookmark menu-buffer."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(save-excursion
(save-window-excursion
@ -1994,7 +2004,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-1-window ()
"Select this line's bookmark, alone, in full frame."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-jump (bookmark-bmenu-bookmark))
(bury-buffer (other-buffer))
(delete-other-windows))
@ -2002,7 +2012,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-2-window ()
"Select this line's bookmark, with previous buffer in second window."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(pop-up-windows t))
@ -2014,20 +2024,20 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-this-window ()
"Select this line's bookmark in this window."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-jump (bookmark-bmenu-bookmark)))
(defun bookmark-bmenu-other-window ()
"Select this line's bookmark in other window, leaving bookmark menu visible."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark--jump-via bookmark 'switch-to-buffer-other-window)))
(defun bookmark-bmenu-other-frame ()
"Select this line's bookmark in other frame."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark))
(pop-up-frames t))
(bookmark-jump-other-window bookmark)))
@ -2035,7 +2045,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-switch-other-window ()
"Make the other window select this line's bookmark.
The current window remains selected."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark))
(fun (lambda (b) (display-buffer b t))))
(bookmark--jump-via bookmark fun)))
@ -2044,7 +2054,7 @@ The current window remains selected."
"Jump to bookmark at mouse EVENT position in other window.
Move point in menu buffer to the position of EVENT and leave
bookmark menu visible."
(interactive "e")
(interactive "e" bookmark-bmenu-mode)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
@ -2053,20 +2063,20 @@ bookmark menu visible."
(defun bookmark-bmenu-show-annotation ()
"Show the annotation for the current bookmark in another window."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark-show-annotation bookmark)))
(defun bookmark-bmenu-show-all-annotations ()
"Show the annotation for all bookmarks in another window."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-show-all-annotations))
(defun bookmark-bmenu-edit-annotation ()
"Edit the annotation for the current bookmark in another window."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark-edit-annotation bookmark t)))
@ -2074,7 +2084,7 @@ bookmark menu visible."
(defun bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
(interactive "P")
(interactive "P" bookmark-bmenu-mode)
;; any flags to reset according to circumstances? How about a
;; flag indicating whether this bookmark is being visited?
;; well, we don't have this now, so maybe later.
@ -2085,7 +2095,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-backup-unmark ()
"Move up and cancel all requested operations on bookmark on line above."
(interactive)
(interactive nil bookmark-bmenu-mode)
(forward-line -1)
(bookmark-bmenu-ensure-position)
(bookmark-bmenu-unmark)
@ -2095,7 +2105,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-unmark-all ()
"Cancel all requested operations on all listed bookmarks."
(interactive)
(interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@ -2106,7 +2116,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-delete ()
"Mark bookmark on this line to be deleted.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(tabulated-list-put-tag "D" t))
@ -2114,7 +2124,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-delete-backwards ()
"Mark bookmark on this line to be deleted, then move up one line.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
(interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-delete)
(forward-line -2))
@ -2123,7 +2133,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
"Mark all listed bookmarks as to be deleted.
To remove all deletion marks, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all].
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
(interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@ -2133,7 +2143,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-execute-deletions ()
"Delete bookmarks flagged `D'."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((reporter (make-progress-reporter "Deleting bookmarks..."))
(o-point (point))
(o-str (save-excursion
@ -2160,7 +2170,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-rename ()
"Rename bookmark on current line. Prompts for a new name."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-rename bmrk)
@ -2169,14 +2179,14 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-locate ()
"Display location of this bookmark. Displays in the minibuffer."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark)))
(message "%s" (bookmark-location bmrk))))
(defun bookmark-bmenu-relocate ()
"Change the absolute file name of the bookmark on the current line.
Prompt with completion for the new path."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-relocate bmrk)
@ -2196,7 +2206,7 @@ Prompt with completion for the new path."
;;;###autoload
(defun bookmark-bmenu-search ()
"Incremental search of bookmarks, hiding the non-matches as we go."
(interactive)
(interactive nil bookmark-bmenu-mode)
(let ((bmk (bookmark-bmenu-bookmark))
(timer nil))
(unwind-protect

56
lisp/buff-menu.el
View file

@ -268,6 +268,7 @@ In Buffer Menu mode, the following commands are defined:
\\[revert-buffer] Update the list of buffers.
\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers.
\\[Buffer-menu-bury] Bury the buffer listed on this line."
:interactive nil
(setq-local buffer-stale-function
(lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
@ -328,7 +329,7 @@ ARG, show only buffers that are visiting files."
"Toggle whether the current buffer-menu displays only file buffers.
With a positive ARG, display only file buffers. With zero or
negative ARG, display other buffers as well."
(interactive "P")
(interactive "P" Buffer-menu-mode)
(setq Buffer-menu-files-only
(cond ((not arg) (not Buffer-menu-files-only))
((> (prefix-numeric-value arg) 0) t)))
@ -337,7 +338,8 @@ negative ARG, display other buffers as well."
"Showing all non-internal buffers."))
(revert-buffer))
(defalias 'Buffer-menu-sort 'tabulated-list-sort)
(define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort
"28.1")
(defun Buffer-menu-buffer (&optional error-if-non-existent-p)
@ -373,14 +375,14 @@ is nil or omitted, and signal an error otherwise."
(defun Buffer-menu-mark ()
"Mark the Buffer menu entry at point for later display.
It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
(interactive)
(interactive nil Buffer-menu-mode)
(tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t)
(forward-line))
(defun Buffer-menu-unmark (&optional backup)
"Cancel all requested operations on buffer on this line and move down.
Optional prefix arg means move up."
(interactive "P")
(interactive "P" Buffer-menu-mode)
(Buffer-menu--unmark)
(forward-line (if backup -1 1)))
@ -388,7 +390,7 @@ Optional prefix arg means move up."
"Cancel a requested operation on all buffers.
MARK is the character to flag the operation on the buffers.
When called interactively prompt for MARK; RET remove all marks."
(interactive "cRemove marks (RET means all):")
(interactive "cRemove marks (RET means all):" Buffer-menu-mode)
(save-excursion
(goto-char (point-min))
(when (tabulated-list-header-overlay-p)
@ -403,12 +405,12 @@ When called interactively prompt for MARK; RET remove all marks."
(defun Buffer-menu-unmark-all ()
"Cancel all requested operations on buffers."
(interactive)
(interactive nil Buffer-menu-mode)
(Buffer-menu-unmark-all-buffers ?\r))
(defun Buffer-menu-backup-unmark ()
"Move up and cancel all requested operations on buffer on line above."
(interactive)
(interactive nil Buffer-menu-mode)
(forward-line -1)
(Buffer-menu--unmark))
@ -427,7 +429,7 @@ will delete it.
If prefix argument ARG is non-nil, it specifies the number of
buffers to delete; a negative ARG means to delete backwards."
(interactive "p")
(interactive "p" Buffer-menu-mode)
(if (or (null arg) (= arg 0))
(setq arg 1))
(while (> arg 0)
@ -446,14 +448,14 @@ buffers to delete; a negative ARG means to delete backwards."
A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]'
command will delete the marked buffer. Prefix ARG means move
that many lines."
(interactive "p")
(interactive "p" Buffer-menu-mode)
(Buffer-menu-delete (- (or arg 1))))
(defun Buffer-menu-save ()
"Mark the buffer on this Buffer Menu line for saving.
A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
will save it."
(interactive)
(interactive nil Buffer-menu-mode)
(when (Buffer-menu-buffer)
(tabulated-list-set-col 2 "S" t)
(forward-line 1)))
@ -462,7 +464,7 @@ will save it."
"Mark the buffer on this line as unmodified (no changes to save).
If ARG is non-nil (interactively, with a prefix argument), mark
it as modified."
(interactive "P")
(interactive "P" Buffer-menu-mode)
(with-current-buffer (Buffer-menu-buffer t)
(set-buffer-modified-p arg))
(tabulated-list-set-col 2 (if arg "*" " ") t))
@ -471,7 +473,7 @@ it as modified."
"Save and/or delete marked buffers in the Buffer Menu.
Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted."
(interactive)
(interactive nil Buffer-menu-mode)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
@ -502,7 +504,7 @@ You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' com
This command deletes and replaces all the previously existing windows
in the selected frame, and will remove any marks."
(interactive)
(interactive nil Buffer-menu-mode)
(let* ((this-buffer (Buffer-menu-buffer t))
(menu-buffer (current-buffer))
(others (delq this-buffer (Buffer-menu-marked-buffers t)))
@ -533,23 +535,23 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-isearch-buffers ()
"Search for a string through all marked buffers using Isearch."
(interactive)
(interactive nil Buffer-menu-mode)
(multi-isearch-buffers (Buffer-menu-marked-buffers)))
(defun Buffer-menu-isearch-buffers-regexp ()
"Search for a regexp through all marked buffers using Isearch."
(interactive)
(interactive nil Buffer-menu-mode)
(multi-isearch-buffers-regexp (Buffer-menu-marked-buffers)))
(defun Buffer-menu-multi-occur (regexp &optional nlines)
"Show all lines in marked buffers containing a match for a regexp."
(interactive (occur-read-primary-args))
(interactive (occur-read-primary-args) Buffer-menu-mode)
(multi-occur (Buffer-menu-marked-buffers) regexp nlines))
(defun Buffer-menu-visit-tags-table ()
"Visit the tags table in the buffer on this line. See `visit-tags-table'."
(interactive)
(interactive nil Buffer-menu-mode)
(let ((file (buffer-file-name (Buffer-menu-buffer t))))
(if file
(visit-tags-table file)
@ -557,30 +559,30 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-1-window ()
"Select this line's buffer, alone, in full frame."
(interactive)
(interactive nil Buffer-menu-mode)
(switch-to-buffer (Buffer-menu-buffer t))
(bury-buffer (other-buffer))
(delete-other-windows))
(defun Buffer-menu-this-window ()
"Select this line's buffer in this window."
(interactive)
(interactive nil Buffer-menu-mode)
(switch-to-buffer (Buffer-menu-buffer t)))
(defun Buffer-menu-other-window ()
"Select this line's buffer in other window, leaving buffer menu visible."
(interactive)
(interactive nil Buffer-menu-mode)
(switch-to-buffer-other-window (Buffer-menu-buffer t)))
(defun Buffer-menu-switch-other-window ()
"Make the other window select this line's buffer.
The current window remains selected."
(interactive)
(interactive nil Buffer-menu-mode)
(display-buffer (Buffer-menu-buffer t) t))
(defun Buffer-menu-2-window ()
"Select this line's buffer, with previous buffer in second window."
(interactive)
(interactive nil Buffer-menu-mode)
(let ((buff (Buffer-menu-buffer t))
(menu (current-buffer)))
(delete-other-windows)
@ -591,7 +593,7 @@ The current window remains selected."
(defun Buffer-menu-toggle-read-only ()
"Toggle read-only status of buffer on this line.
This behaves like invoking \\[read-only-mode] in that buffer."
(interactive)
(interactive nil Buffer-menu-mode)
(let ((read-only
(with-current-buffer (Buffer-menu-buffer t)
(read-only-mode 'toggle)
@ -600,7 +602,7 @@ This behaves like invoking \\[read-only-mode] in that buffer."
(defun Buffer-menu-bury ()
"Bury the buffer listed on this line."
(interactive)
(interactive nil Buffer-menu-mode)
(let ((buffer (tabulated-list-get-id)))
(cond ((null buffer))
((buffer-live-p buffer)
@ -616,12 +618,12 @@ This behaves like invoking \\[read-only-mode] in that buffer."
(defun Buffer-menu-view ()
"View this line's buffer in View mode."
(interactive)
(interactive nil Buffer-menu-mode)
(view-buffer (Buffer-menu-buffer t)))
(defun Buffer-menu-view-other-window ()
"View this line's buffer in View mode in another window."
(interactive)
(interactive nil Buffer-menu-mode)
(view-buffer-other-window (Buffer-menu-buffer t)))
;;; Functions for populating the Buffer Menu.
@ -646,7 +648,7 @@ means list those buffers and no others."
(defun Buffer-menu-mouse-select (event)
"Select the buffer whose line you click on."
(interactive "e")
(interactive "e" Buffer-menu-mode)
(select-window (posn-window (event-end event)))
(let ((buffer (tabulated-list-get-id (posn-point (event-end event)))))
(when (buffer-live-p buffer)

30
lisp/calc/calc-embed.el
View file

@ -854,31 +854,21 @@ The command \\[yank] can retrieve it from there."
(newmode (cl-assoc-if #'derived-mode-p
calc-embedded-open-close-mode-alist)))
(when newann
(make-local-variable 'calc-embedded-announce-formula)
(setq calc-embedded-announce-formula (cdr newann)))
(setq-local calc-embedded-announce-formula (cdr newann)))
(when newform
(make-local-variable 'calc-embedded-open-formula)
(make-local-variable 'calc-embedded-close-formula)
(setq calc-embedded-open-formula (nth 0 (cdr newform)))
(setq calc-embedded-close-formula (nth 1 (cdr newform))))
(setq-local calc-embedded-open-formula (nth 0 (cdr newform)))
(setq-local calc-embedded-close-formula (nth 1 (cdr newform))))
(when newword
(make-local-variable 'calc-embedded-word-regexp)
(setq calc-embedded-word-regexp (nth 1 newword)))
(setq-local calc-embedded-word-regexp (nth 1 newword)))
(when newplain
(make-local-variable 'calc-embedded-open-plain)
(make-local-variable 'calc-embedded-close-plain)
(setq calc-embedded-open-plain (nth 0 (cdr newplain)))
(setq calc-embedded-close-plain (nth 1 (cdr newplain))))
(setq-local calc-embedded-open-plain (nth 0 (cdr newplain)))
(setq-local calc-embedded-close-plain (nth 1 (cdr newplain))))
(when newnewform
(make-local-variable 'calc-embedded-open-new-formula)
(make-local-variable 'calc-embedded-close-new-formula)
(setq calc-embedded-open-new-formula (nth 0 (cdr newnewform)))
(setq calc-embedded-close-new-formula (nth 1 (cdr newnewform))))
(setq-local calc-embedded-open-new-formula (nth 0 (cdr newnewform)))
(setq-local calc-embedded-close-new-formula (nth 1 (cdr newnewform))))
(when newmode
(make-local-variable 'calc-embedded-open-mode)
(make-local-variable 'calc-embedded-close-mode)
(setq calc-embedded-open-mode (nth 0 (cdr newmode)))
(setq calc-embedded-close-mode (nth 1 (cdr newmode)))))))
(setq-local calc-embedded-open-mode (nth 0 (cdr newmode)))
(setq-local calc-embedded-close-mode (nth 1 (cdr newmode)))))))
(while (and (cdr found)
(> point (aref (car (cdr found)) 3)))
(setq found (cdr found)))

4
lisp/calc/calc-sel.el
View file

@ -486,8 +486,8 @@
(defun calc-replace-sub-formula (expr rsf-old rsf-new)
(let ((calc-rsf-old rsf-old)
(calc-rsf-new (calc-encase-atoms rsf-new))))
(calc-replace-sub-formula-rec expr))
(calc-rsf-new (calc-encase-atoms rsf-new)))
(calc-replace-sub-formula-rec expr)))
(defun calc-replace-sub-formula-rec (expr)
(cond ((eq expr calc-rsf-old) calc-rsf-new)

4
lisp/calc/calcalg2.el
View file

@ -1545,9 +1545,7 @@
(set-buffer trace-buffer)
(goto-char (point-max))
(or (assq 'scroll-stop (buffer-local-variables))
(progn
(make-local-variable 'scroll-step)
(setq scroll-step 3)))
(setq-local scroll-step 3))
(insert "\n\n\n")
(set-buffer calcbuf)
(math-try-integral sexpr))

62
lisp/calculator.el
View file

@ -20,23 +20,18 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;=====================================================================
;;; Commentary:
;;
;; A calculator for Emacs.
;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or
;; whatever), when you have Emacs running already?
;;
;; If this is not part of your Emacs distribution, then simply bind
;; `calculator' to a key and make it an autoloaded function, e.g.:
;; (autoload 'calculator "calculator"
;; "Run the Emacs calculator." t)
;; You can bind this to a key by adding this to your Init file:
;;
;; (global-set-key [(control return)] 'calculator)
;;
;; Written by Eli Barzilay, eli@barzilay.org
;;
;;;=====================================================================
;;; Customization:
(defgroup calculator nil
@ -50,19 +45,16 @@
"Run `calculator' electrically, in the echo area.
Electric mode saves some place but changes the way you interact with the
calculator."
:type 'boolean
:group 'calculator)
:type 'boolean)
(defcustom calculator-use-menu t
"Make `calculator' create a menu.
Note that this requires easymenu. Must be set before loading."
:type 'boolean
:group 'calculator)
:type 'boolean)
(defcustom calculator-bind-escape nil
"If non-nil, set escape to exit the calculator."
:type 'boolean
:group 'calculator)
:type 'boolean)
(defcustom calculator-unary-style 'postfix
"Value is either `prefix' or `postfix'.
@ -75,44 +67,38 @@ This determines the default behavior of unary operators."
It should contain a \"%s\" somewhere that will indicate the i/o radixes;
this will be a two-character string as described in the documentation
for `calculator-mode'."
:type 'string
:group 'calculator)
:type 'string)
(defcustom calculator-number-digits 3
"The calculator's number of digits used for standard display.
Used by the `calculator-standard-display' function - it will use the
format string \"%.NC\" where this number is N and C is a character given
at runtime."
:type 'integer
:group 'calculator)
:type 'integer)
(defcustom calculator-radix-grouping-mode t
"Use digit grouping in radix output mode.
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
output mode is active (determined by `calculator-output-radix')."
:type 'boolean
:group 'calculator)
:type 'boolean)
(defcustom calculator-radix-grouping-digits 4
"The number of digits used for grouping display in radix modes.
See `calculator-radix-grouping-mode'."
:type 'integer
:group 'calculator)
:type 'integer)
(defcustom calculator-radix-grouping-separator "'"
"The separator used in radix grouping display.
See `calculator-radix-grouping-mode'."
:type 'string
:group 'calculator)
:type 'string)
(defcustom calculator-remove-zeros t
"Non-nil value means delete all redundant zero decimal digits.
If this value is not t and not nil, redundant zeros are removed except
for one.
Used by the `calculator-remove-zeros' function."
:type '(choice (const t) (const leave-decimal) (const nil))
:group 'calculator)
:type '(choice (const t) (const leave-decimal) (const nil)))
(defcustom calculator-displayer '(std ?n)
"A displayer specification for numerical values.
@ -135,8 +121,7 @@ a character and G is an optional boolean, in this case the
arguments."
:type '(choice (function) (string) (sexp)
(list (const std) character)
(list (const std) character boolean))
:group 'calculator)
(list (const std) character boolean)))
(defcustom calculator-displayers
'(((std ?n) "Standard display, decimal point or scientific")
@ -152,15 +137,13 @@ specification is the same as the values that can be stored in
`calculator-displayer'.
`calculator-rotate-displayer' rotates this list."
:type 'sexp
:group 'calculator)
:type 'sexp)
(defcustom calculator-paste-decimals t
"If non-nil, convert pasted integers so they have a decimal point.
This makes it possible to paste big integers since they will be read as
floats, otherwise the Emacs reader will fail on them."
:type 'boolean
:group 'calculator)
:type 'boolean)
(make-obsolete-variable 'calculator-paste-decimals
"it is no longer used." "26.1")
@ -169,14 +152,12 @@ floats, otherwise the Emacs reader will fail on them."
`calculator-displayer', to format a string before copying it with
`calculator-copy'. If nil, then `calculator-displayer's normal value is
used."
:type 'boolean
:group 'calculator)
:type 'boolean)
(defcustom calculator-2s-complement nil
"If non-nil, show negative numbers in 2s complement in radix modes.
Otherwise show as a negative number."
:type 'boolean
:group 'calculator)
:type 'boolean)
(defcustom calculator-mode-hook nil
"List of hook functions for `calculator-mode' to run.
@ -184,8 +165,7 @@ Note: if `calculator-electric-mode' is on, then this hook will get
activated in the minibuffer -- in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
:type 'hook
:group 'calculator)
:type 'hook)
(defcustom calculator-user-registers nil
"An association list of user-defined register bindings.
@ -200,8 +180,7 @@ before you load calculator."
(when (boundp 'calculator-registers)
(setq calculator-registers
(append val calculator-registers)))
(setq calculator-user-registers val))
:group 'calculator)
(setq calculator-user-registers val)))
(defcustom calculator-user-operators nil
"A list of additional operators.
@ -234,8 +213,7 @@ Examples:
Note that this will be either postfix or prefix, according to
`calculator-unary-style'."
:type '(repeat (list string symbol sexp integer integer))
:group 'calculator)
:type '(repeat (list string symbol sexp integer integer)))
;;;=====================================================================
;;; Code:

26
lisp/calendar/icalendar.el
View file

@ -889,12 +889,14 @@ If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
(defun icalendar--datestring-to-isodate (datestring &optional day-shift year-shift)
"Convert diary-style DATESTRING to iso-style date.
If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
-- DAY-SHIFT must be either nil or an integer. This function
tries to figure the date style from DATESTRING itself. If that
is not possible it uses the current calendar date style."
-- DAY-SHIFT must be either nil or an integer. If YEAR-SHIFT is
non-nil, the result is shifted by YEAR-SHIFT years -- YEAR-SHIFT
must be either nil or an integer. This function tries to figure
the date style from DATESTRING itself. If that is not possible
it uses the current calendar date style."
(let ((day -1) month year)
(save-match-data
(cond ( ;; iso-style numeric date
@ -904,7 +906,7 @@ is not possible it uses the current calendar date style."
"0?\\([1-9][0-9]?\\)")
datestring)
(setq year (read (substring datestring (match-beginning 1)
(match-end 1))))
(match-end 1))))
(setq month (read (substring datestring (match-beginning 2)
(match-end 2))))
(setq day (read (substring datestring (match-beginning 3)
@ -967,6 +969,9 @@ is not possible it uses the current calendar date style."
(match-end 3)))))
(t
nil)))
(when year-shift
(setq year (+ year year-shift)))
(if (> day 0)
(let ((mdy (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian (list month day
@ -1916,9 +1921,9 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(let* ((datetime (substring entry-main (match-beginning 1)
(match-end 1)))
(startisostring (icalendar--datestring-to-isodate
datetime))
datetime nil 1))
(endisostring (icalendar--datestring-to-isodate
datetime 1))
datetime 1 1))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
@ -2402,8 +2407,11 @@ END-T is the event's end time in diary format."
(if end-t "-" "")
(or end-t ""))))
(setq result (format
"%%%%(and (diary-anniversary %s)) %s%s%s"
dtstart-conv
"%%%%(diary-anniversary %s) %s%s%s"
(let* ((year (nth 5 dtstart-dec))
(dtstart-1y-dec (copy-sequence dtstart-dec)))
(setf (nth 5 dtstart-1y-dec) (1- year))
(icalendar--datetime-to-diary-date dtstart-1y-dec))
(or start-t "")
(if end-t "-" "") (or end-t "")))))
;; monthly

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

@ -29,7 +29,7 @@
;; `parse-time-string' parses a time in a string and returns a list of
;; values, just like `decode-time', where unspecified elements in the
;; string are returned as nil (except unspecfied DST is returned as -1).
;; string are returned as nil (except unspecified DST is returned as -1).
;; `encode-time' may be applied on these values to obtain an internal
;; time value.

44
lisp/cedet/data-debug.el
View file

@ -1045,30 +1045,30 @@ If the result is a list or vector, then use the data debugger to display it."
(list (let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Eval: "
nil read-expression-map t
'read-expression-history))
))
'read-expression-history))))
(if (null eval-expression-debug-on-error)
(setq values (cons (eval expr) values))
(let ((old-value (make-symbol "t")) new-value)
;; Bind debug-on-error to something unique so that we can
;; detect when evalled code changes it.
(let ((debug-on-error old-value))
(setq values (cons (eval expr) values))
(setq new-value debug-on-error))
;; If evalled code has changed the value of debug-on-error,
;; propagate that change to the global binding.
(unless (eq old-value new-value)
(setq debug-on-error new-value))))
(let (result)
(if (null eval-expression-debug-on-error)
(setq result (values--store-value (eval expr)))
(let ((old-value (make-symbol "t")) new-value)
;; Bind debug-on-error to something unique so that we can
;; detect when evalled code changes it.
(let ((debug-on-error old-value))
(setq result (values--store-value (eval expr)))
(setq new-value debug-on-error))
;; If evalled code has changed the value of debug-on-error,
;; propagate that change to the global binding.
(unless (eq old-value new-value)
(setq debug-on-error new-value))))
(if (or (consp (car values)) (vectorp (car values)))
(let ((v (car values)))
(data-debug-show-stuff v "Expression"))
;; Old style
(prog1
(prin1 (car values) t)
(let ((str (eval-expression-print-format (car values))))
(if str (princ str t))))))
(if (or (consp result) (vectorp result))
(let ((v result))
(data-debug-show-stuff v "Expression"))
;; Old style
(prog1
(prin1 result t)
(let ((str (eval-expression-print-format result)))
(if str (princ str t)))))))
(provide 'data-debug)

2
lisp/cedet/ede.el
View file

@ -1518,7 +1518,7 @@ It does not apply the value to buffers."
;;; FIXME: Could someone look into implementing `project-ignores' for
;;; EDE and/or a faster `project-files'?
(add-hook 'project-find-functions #'project-try-ede)
(add-hook 'project-find-functions #'project-try-ede 50)
(provide 'ede)

29
lisp/cedet/ede/base.el
View file

@ -1,4 +1,4 @@
;;; ede/base.el --- Baseclasses for EDE.
;;; ede/base.el --- Baseclasses for EDE -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@ -288,7 +288,7 @@ All specific project types must derive from this project."
;;
(defmacro ede-with-projectfile (obj &rest forms)
"For the project in which OBJ resides, execute FORMS."
(declare (indent 1))
(declare (indent 1) (debug t))
(unless (symbolp obj)
(message "Beware! ede-with-projectfile's first arg is copied: %S" obj))
`(let* ((pf (if (obj-of-class-p ,obj 'ede-target)
@ -317,13 +317,15 @@ If set to nil, then the cache is not saved."
(defvar ede-project-cache-files nil
"List of project files EDE has seen before.")
(defvar recentf-exclude)
(defun ede-save-cache ()
"Save a cache of EDE objects that Emacs has seen before."
(interactive)
(when ede-project-placeholder-cache-file
(let ((p ede-projects)
(c ede-project-cache-files)
(recentf-exclude '( (lambda (f) t) ))
(recentf-exclude `( ,(lambda (_) t) ))
)
(condition-case nil
(progn
@ -461,7 +463,7 @@ Not all buffers need headers, so return nil if no applicable."
(ede-buffer-header-file ede-object (current-buffer))
nil))
(cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
(cl-defmethod ede-buffer-header-file ((_this ede-project) _buffer)
"Return nil, projects don't have header files."
nil)
@ -487,12 +489,12 @@ Some projects may have multiple documentation files, so return a list."
(ede-buffer-documentation-files ede-object (current-buffer))
nil))
(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
(cl-defmethod ede-buffer-documentation-files ((this ede-project) _buffer)
"Return all documentation in project THIS based on BUFFER."
;; Find the info node.
(ede-documentation this))
(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
(cl-defmethod ede-buffer-documentation-files ((_this ede-target) buffer)
"Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
@ -518,7 +520,7 @@ files in the project."
proj (cdr proj)))
found))
(cl-defmethod ede-documentation ((this ede-target))
(cl-defmethod ede-documentation ((_this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@ -529,7 +531,7 @@ files in the project."
(ede-html-documentation (ede-toplevel))
)
(cl-defmethod ede-html-documentation ((this ede-project))
(cl-defmethod ede-html-documentation ((_this ede-project))
"Return a list of HTML files provided by project THIS."
)
@ -636,18 +638,7 @@ PROJECT-FILE-NAME is a name of project file (short name, like `pom.xml', etc."
(oset this directory (file-name-directory (oref this file))))
)
;;; Hooks & Autoloads
;;
;; These let us watch various activities, and respond appropriately.
;; (add-hook 'edebug-setup-hook
;; (lambda ()
;; (def-edebug-spec ede-with-projectfile
;; (form def-body))))
(provide 'ede/base)
;; Local variables:

2
lisp/cedet/ede/dired.el
View file

@ -1,4 +1,4 @@
;;; ede/dired.el --- EDE extensions to dired.
;;; ede/dired.el --- EDE extensions to dired. -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2003, 2009-2021 Free Software Foundation,
;; Inc.

27
lisp/cedet/ede/emacs.el
View file

@ -1,4 +1,4 @@
;;; ede/emacs.el --- Special project for Emacs
;;; ede/emacs.el --- Special project for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -54,31 +54,6 @@ Return a tuple of ( EMACSNAME . VERSION )."
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
(cond
;; Maybe XEmacs?
((file-exists-p "version.sh")
(setq emacs "XEmacs")
(insert-file-contents "version.sh")
(goto-char (point-min))
(re-search-forward "emacs_major_version=\\([0-9]+\\)
emacs_minor_version=\\([0-9]+\\)
emacs_beta_version=\\([0-9]+\\)")
(setq ver (concat (match-string 1) "."
(match-string 2) "."
(match-string 3)))
)
((file-exists-p "sxemacs.pc.in")
(setq emacs "SXEmacs")
(insert-file-contents "sxemacs_version.m4")
(goto-char (point-min))
(re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\])
m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\])
m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
(setq ver (concat (match-string 1) "."
(match-string 2) "."
(match-string 3)))
)
;; Insert other Emacs here...
;; Vaguely recent version of GNU Emacs?
((or (file-exists-p configure_ac)
(file-exists-p (setq configure_ac "configure.in")))

2
lisp/cedet/ede/make.el
View file

@ -1,4 +1,4 @@
;;; ede/make.el --- General information about "make"
;;; ede/make.el --- General information about "make" -*- lexical-binding: t -*-
;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.

22
lisp/cedet/ede/pmake.el
View file

@ -1,4 +1,4 @@
;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
;;; ede-pmake.el --- EDE Generic Project Makefile code generator -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
@ -241,6 +241,7 @@ MFILENAME is the makefile to generate."
(defmacro ede-pmake-insert-variable-shared (varname &rest body)
"Add VARNAME into the current Makefile.
Execute BODY in a location where a value can be placed."
(declare (debug t) (indent 1))
`(let ((addcr t) (v ,varname))
(if (save-excursion
(goto-char (point-max))
@ -258,11 +259,11 @@ Execute BODY in a location where a value can be placed."
,@body
(if addcr (insert "\n"))
(goto-char (point-max))))
(put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1)
(defmacro ede-pmake-insert-variable-once (varname &rest body)
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
(declare (debug t) (indent 1))
`(let ((addcr t) (v ,varname))
(unless
(save-excursion
@ -271,7 +272,6 @@ Execute BODY in a location where a value can be placed."
,@body
(when addcr (insert "\n"))
(goto-char (point-max)))))
(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1)
;;; SOURCE VARIABLE NAME CONSTRUCTION
@ -289,7 +289,7 @@ Change . to _ in the variable name."
;;; DEPENDENCY FILE GENERATOR LISTS
;;
(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
(cl-defmethod ede-proj-makefile-dependency-files ((_this ede-proj-target))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
nil)
@ -302,7 +302,7 @@ Argument THIS is the target to get sources from."
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
(cl-defmethod ede-proj-makefile-insert-variables-new ((_this ede-proj-project))
"Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of
@ -420,7 +420,7 @@ Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
&optional moresource)
&optional _moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
@ -449,12 +449,12 @@ sources variable."
(ede-proj-makefile-insert-variables linker)))))
(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target))
((_this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target))
((_this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
@ -511,7 +511,7 @@ Argument THIS is the project that should insert stuff."
(mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
)
(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((_this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
nil)
@ -530,7 +530,7 @@ Argument THIS is the target that should insert stuff."
(insert " " (ede-subproject-relative-path sproj))
))))
(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
(cl-defmethod ede-proj-makefile-automake-insert-extradist ((_this ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
@ -602,7 +602,7 @@ Argument THIS is the target that should insert stuff."
"\t@false\n\n"
"\n\n# End of Makefile\n")))
(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
(cl-defmethod ede-proj-makefile-insert-rules ((_this ede-proj-target))
"Insert rules needed by THIS target."
nil)

6
lisp/cedet/ede/proj-archive.el
View file

@ -1,10 +1,12 @@
;;; ede/proj-archive.el --- EDE Generic Project archive support
;;; ede/proj-archive.el --- EDE Generic Project archive support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2001, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
;; 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
@ -43,7 +45,7 @@
"Linker object for creating an archive.")
(cl-defmethod ede-proj-makefile-insert-source-variables :before
((this ede-proj-target-makefile-archive) &optional moresource)
((this ede-proj-target-makefile-archive) &optional _moresource)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
Makefile.am generator, so use it to add this important bin program."

2
lisp/cedet/ede/proj-aux.el
View file

@ -1,4 +1,4 @@
;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2007, 2009-2021 Free Software Foundation,
;; Inc.

35
lisp/cedet/ede/proj-comp.el
View file

@ -1,4 +1,4 @@
;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2021 Free Software
;; Foundation, Inc.
@ -172,12 +172,12 @@ Adds this rule to a .PHONY list."))
This is used when creating a Makefile to prevent duplicate variables and
rules from being created.")
(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
(cl-defmethod initialize-instance :after ((this ede-compiler) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(add-to-list 'ede-compiler-list this))
(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
(cl-defmethod initialize-instance :after ((this ede-linker) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
@ -185,11 +185,13 @@ rules from being created.")
(defmacro ede-compiler-begin-unique (&rest body)
"Execute BODY, making sure that `ede-current-build-list' is maintained.
This will prevent rules from creating duplicate variables or rules."
(declare (indent 0) (debug t))
`(let ((ede-current-build-list nil))
,@body))
(defmacro ede-compiler-only-once (object &rest body)
"Using OBJECT, execute BODY only once per Makefile generation."
(declare (indent 1) (debug t))
`(if (not (member ,object ede-current-build-list))
(progn
(add-to-list 'ede-current-build-list ,object)
@ -198,25 +200,18 @@ This will prevent rules from creating duplicate variables or rules."
(defmacro ede-linker-begin-unique (&rest body)
"Execute BODY, making sure that `ede-current-build-list' is maintained.
This will prevent rules from creating duplicate variables or rules."
(declare (indent 0) (debug t))
`(let ((ede-current-build-list nil))
,@body))
(defmacro ede-linker-only-once (object &rest body)
"Using OBJECT, execute BODY only once per Makefile generation."
(declare (indent 1) (debug t))
`(if (not (member ,object ede-current-build-list))
(progn
(add-to-list 'ede-current-build-list ,object)
,@body)))
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec ede-compiler-begin-unique def-body)
(def-edebug-spec ede-compiler-only-once (form def-body))
(def-edebug-spec ede-linker-begin-unique def-body)
(def-edebug-spec ede-linker-only-once (form def-body))
(def-edebug-spec ede-pmake-insert-variable-shared (form def-body))
))
;;; Queries
(defun ede-proj-find-compiler (compilers sourcetype)
"Return a compiler from the list COMPILERS that will compile SOURCETYPE."
@ -246,7 +241,7 @@ This will prevent rules from creating duplicate variables or rules."
)
(oref this autoconf)))
(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
(cl-defmethod ede-proj-flush-autoconf ((_this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
@ -281,8 +276,8 @@ If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
targetname)
(cl-defmethod ede-compiler-intermediate-object-variable ((_this ede-compiler)
targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ"))
@ -343,16 +338,6 @@ compiler it decides to use after inserting in the rule."
commands))
(insert "\n")))
;;; Some details about our new macro
;;
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec ede-compiler-begin-unique def-body)))
(put 'ede-compiler-begin-unique 'lisp-indent-function 0)
(put 'ede-compiler-only-once 'lisp-indent-function 1)
(put 'ede-linker-begin-unique 'lisp-indent-function 0)
(put 'ede-linker-only-once 'lisp-indent-function 1)
(provide 'ede/proj-comp)
;;; ede/proj-comp.el ends here

2
lisp/cedet/ede/proj-misc.el
View file

@ -1,4 +1,4 @@
;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2001, 2008-2021 Free Software Foundation, Inc.

4
lisp/cedet/ede/proj-scheme.el
View file

@ -1,4 +1,4 @@
;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
@ -40,7 +40,7 @@
)
"This target consists of scheme files.")
(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))

107
lisp/cedet/ede/project-am.el
View file

@ -1,4 +1,4 @@
;;; project-am.el --- A project management scheme based on automake files.
;;; project-am.el --- A project management scheme based on automake files. -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
@ -54,17 +54,14 @@
(defcustom project-am-compile-project-command nil
"Default command used to compile a project."
:group 'project-am
:type '(choice (const nil) string))
(defcustom project-am-compile-target-command (concat ede-make-command " -k %s")
"Default command used to compile a project."
:group 'project-am
:type 'string)
(defcustom project-am-debug-target-function 'gdb
"Default Emacs command used to debug a target."
:group 'project-am
:type 'function) ; make this be a list some day
(defconst project-am-type-alist
@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
(cl-defmethod project-new-target ((proj project-am-makefile)
&optional name type)
(cl-defmethod project-new-target ((_proj project-am-makefile)
&optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
matching something in `project-am-type-alist' or type class symbol.
@ -300,7 +297,7 @@ buffer being in order to provide a smart default target type."
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
(cl-defmethod project-compile-project ((obj project-am-target) &optional command)
(cl-defmethod project-compile-project ((_obj project-am-target) &optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
(cl-defmethod project-compile-project ((obj project-am-makefile)
(cl-defmethod project-compile-project ((_obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
(cl-defmethod project-compile-target ((obj project-am-target) &optional command)
(cl-defmethod project-compile-target ((_obj project-am-target) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the target."
;;; Project loading and saving
;;
(defun project-am-load (directory &optional rootproj)
(defun project-am-load (directory &optional _rootproj)
"Read an automakefile DIRECTORY into our data structure.
If a given set of projects has already been loaded, then do nothing
but return the project for the directory given.
@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project."
(file-name-directory (directory-file-name newdir))))
(expand-file-name dir)))
(defvar recentf-exclude)
(defmacro project-am-with-makefile-current (dir &rest forms)
"Set the Makefile.am in DIR to be the current buffer.
Run FORMS while the makefile is current.
Kill the makefile if it was not loaded before the load."
`(let* ((fn (expand-file-name "Makefile.am" ,dir))
(fb nil)
(kb (get-file-buffer fn)))
(if (not (file-exists-p fn))
nil
(save-excursion
(if kb (setq fb kb)
;; We need to find-file this thing, but don't use
;; any semantic features.
(let ((semantic-init-hook nil)
(recentf-exclude '( (lambda (f) t) ))
)
(setq fb (find-file-noselect fn)))
)
(set-buffer fb)
(prog1 ,@forms
(if (not kb) (kill-buffer (current-buffer))))))))
(put 'project-am-with-makefile-current 'lisp-indent-function 1)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec project-am-with-makefile-current
(form def-body))))
Run FORMS while the makefile is current."
(declare (indent 1) (debug (form def-body)))
`(project-am--with-makefile-current ,dir (lambda () ,@forms)))
(defun project-am--with-makefile-current (dir fun)
(let* ((fn (expand-file-name "Makefile.am" dir))
(kb (get-file-buffer fn)))
(if (not (file-exists-p fn))
nil
(with-current-buffer
(or kb
;; We need to find-file this thing, but don't use
;; any semantic features.
(let ((semantic-init-hook nil)
(recentf-exclude `(,(lambda (_f) t))))
(find-file-noselect fn)))
(unwind-protect (funcall fun)
(if (not kb) (kill-buffer (current-buffer))))))))
(defun project-am-load-makefile (path &optional suggestedname)
"Convert PATH into a project Makefile, and return its project object.
@ -480,6 +471,7 @@ This is used when subprojects are made in named subdirectories."
(if (and ede-object (project-am-makefile-p ede-object))
ede-object
(let* ((pi (project-am-package-info path))
(fn buffer-file-name)
(sfn (when suggestedname
(project-am-last-dir suggestedname)))
(pn (or sfn (nth 0 pi) (project-am-last-dir fn)))
@ -734,19 +726,19 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES"))
(cl-defmethod project-am-macro ((this project-am-header-noinst))
(cl-defmethod project-am-macro ((_this project-am-header-noinst))
"Return the default macro to `edit' for this object."
"noinst_HEADERS")
(cl-defmethod project-am-macro ((this project-am-header-inst))
(cl-defmethod project-am-macro ((_this project-am-header-inst))
"Return the default macro to `edit' for this object."
"include_HEADERS")
(cl-defmethod project-am-macro ((this project-am-header-pkg))
(cl-defmethod project-am-macro ((_this project-am-header-pkg))
"Return the default macro to `edit' for this object."
"pkginclude_HEADERS")
(cl-defmethod project-am-macro ((this project-am-header-chk))
(cl-defmethod project-am-macro ((_this project-am-header-chk))
"Return the default macro to `edit' for this object."
"check_HEADERS")
@ -758,7 +750,7 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(oref this name))
(cl-defmethod project-am-macro ((this project-am-lisp))
(cl-defmethod project-am-macro ((_this project-am-lisp))
"Return the default macro to `edit' for this object."
"lisp_LISP")
@ -785,13 +777,11 @@ nil means that this buffer belongs to no-one."
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this file) efn)
(string-match "/configure\\.ac$" efn)
(string-match "/configure\\.in$" efn)
(string-match "/configure$" efn)
(string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn)
;; Search output files.
(let ((ans nil))
(dolist (f (oref this configureoutputfiles))
(when (string-match (concat (regexp-quote f) "$") efn)
(when (string-match (concat (regexp-quote f) "\\'") efn)
(setq ans t)))
ans)
)))
@ -822,7 +812,7 @@ nil means that this buffer belongs to no-one."
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
(cl-defmethod project-compile-target-command ((this project-am-target))
(cl-defmethod project-compile-target-command ((_this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
@ -861,7 +851,7 @@ Argument FILE is the file to extract the end directory name from."
(t
'project-am-program)))
(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer)
"There are no default header files."
(or (cl-call-next-method)
(let ((s (oref this source))
@ -910,22 +900,13 @@ files in the project."
"Set the Configure FILE in the top most directory above DIR as current.
Run FORMS in the configure file.
Kill the Configure buffer if it was not already in a buffer."
`(save-excursion
(let ((fb (generate-new-buffer ,file)))
(set-buffer fb)
(erase-buffer)
(insert-file-contents ,file)
(prog1 ,@forms
(kill-buffer fb)))))
(declare (indent 1) (debug t))
`(with-temp-buffer
(erase-buffer)
(insert-file-contents ,file)
,@forms))
(put 'project-am-with-config-current 'lisp-indent-function 1)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec project-am-with-config-current
(form def-body))))
(defmacro project-am-extract-shell-variable (var)
(defun project-am-extract-shell-variable (var)
"Extract the value of the shell variable VAR from a shell script."
(save-excursion
(goto-char (point-min))
@ -997,12 +978,12 @@ Calculates the info with `project-am-extract-package-info'."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
(cl-defmethod ede-system-include-path ((this project-am-makefile))
(cl-defmethod ede-system-include-path ((_this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
(cl-defmethod ede-system-include-path ((this project-am-target))
(cl-defmethod ede-system-include-path ((_this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))

3
lisp/cedet/ede/srecode.el
View file

@ -1,4 +1,4 @@
;;; ede/srecode.el --- EDE utilities on top of SRecoder
;;; ede/srecode.el --- EDE utilities on top of SRecoder -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -86,7 +86,6 @@ Note: Just like `srecode-insert', but templates found in `ede' app."
(car (cdr dictionary-entries)))
(setq dictionary-entries
(cdr (cdr dictionary-entries))))
))
(provide 'ede/srecode)

2
lisp/cedet/ede/system.el
View file

@ -1,4 +1,4 @@
;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) -*- lexical-binding: t -*-
;; Copyright (C) 2001-2003, 2009-2021 Free Software Foundation, Inc.

4
lisp/cedet/pulse.el
View file

@ -1,6 +1,6 @@
;;; pulse.el --- Pulsing Overlays
;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*-
;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.0

14
lisp/cedet/semantic/bovine/gcc.el
View file

@ -1,4 +1,4 @@
;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -25,6 +25,7 @@
;; GCC, and set up the preprocessor and include paths.
(require 'semantic/dep)
(require 'cl-lib)
(defvar semantic-lex-c-preprocessor-symbol-file)
(defvar semantic-lex-c-preprocessor-symbol-map)
@ -88,10 +89,9 @@ to give to the program."
(let ((path (substring line 1)))
(when (and (file-accessible-directory-p path)
(file-name-absolute-p path))
(add-to-list 'inc-path
(expand-file-name path)
t))))))))
inc-path))
(cl-pushnew (expand-file-name path) inc-path
:test #'equal))))))))
(nreverse inc-path)))
(defun semantic-cpp-defs (str)
@ -101,7 +101,7 @@ to give to the program."
(dolist (L lines)
(let ((dat (split-string L)))
(when (= (length dat) 3)
(add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
(push (cons (nth 1 dat) (nth 2 dat)) lst))))
lst))
(defun semantic-gcc-fields (str)
@ -142,6 +142,8 @@ This is an alist, and should include keys of:
`--prefix' - where GCC was installed.
It should also include other symbols GCC was compiled with.")
(defvar c++-include-path)
;;;###autoload
(defun semantic-gcc-setup ()
"Setup Semantic C/C++ parsing based on GCC output."

24
lisp/cedet/semantic/ctxt.el
View file

@ -1,4 +1,4 @@
;;; semantic/ctxt.el --- Context calculations for Semantic tools.
;;; semantic/ctxt.el --- Context calculations for Semantic tools -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -137,18 +137,16 @@ Return non-nil if there is no upper context."
(defmacro semantic-with-buffer-narrowed-to-context (&rest body)
"Execute BODY with the buffer narrowed to the current context."
(declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-context)
,@body))
(put 'semantic-with-buffer-narrowed-to-context 'lisp-indent-function 0)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec semantic-with-buffer-narrowed-to-context
(def-body))))
;;; Local Variables
;;
;;
(defvar semantic--progress-reporter)
(define-overloadable-function semantic-get-local-variables (&optional point)
"Get the local variables based on POINT's context.
Local variables are returned in Semantic tag format.
@ -345,14 +343,10 @@ beginning and end of a command."
(defmacro semantic-with-buffer-narrowed-to-command (&rest body)
"Execute BODY with the buffer narrowed to the current command."
(declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-command)
,@body))
(put 'semantic-with-buffer-narrowed-to-command 'lisp-indent-function 0)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec semantic-with-buffer-narrowed-to-command
(def-body))))
(define-overloadable-function semantic-ctxt-end-of-symbol (&optional point)
"Move point to the end of the current symbol under POINT.
@ -374,7 +368,7 @@ work on C like languages."
;; NOTE: The [ \n] expression below should used \\s-, but that
;; doesn't work in C since \n means end-of-comment, and isn't
;; really whitespace.
(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)"))
;;(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)"))
(case-fold-search semantic-case-fold)
(continuesearch t)
(end nil)
@ -655,7 +649,7 @@ POINT defaults to the value of point in current buffer.
You should override this function in multiple mode buffers to
determine which major mode apply at point.")
(defun semantic-ctxt-current-mode-default (&optional point)
(defun semantic-ctxt-current-mode-default (&optional _point)
"Return the major mode active at POINT.
POINT defaults to the value of point in current buffer.
This default implementation returns the current major mode."
@ -671,7 +665,7 @@ The return value can be a mixed list of either strings (names of
types that are in scope) or actual tags (type declared locally
that may or may not have a name.)")
(defun semantic-ctxt-scoped-types-default (&optional point)
(defun semantic-ctxt-scoped-types-default (&optional _point)
"Return a list of scoped types by name for the current context at POINT.
This is very different for various languages, and does nothing unless
overridden."

8
lisp/cedet/semantic/decorate/include.el
View file

@ -1,4 +1,4 @@
;;; semantic/decorate/include.el --- Decoration modes for include statements
;;; semantic/decorate/include.el --- Decoration modes for include statements -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -535,7 +535,7 @@ Argument EVENT is the mouse clicked event."
(interactive)
(let* ((tag (semantic-current-tag))
(table (semanticdb-find-table-for-include tag (current-buffer)))
(mm major-mode))
) ;; (mm major-mode)
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(help-setup-xref (list #'semantic-decoration-fileless-include-describe)
(called-interactively-p 'interactive))
@ -793,7 +793,7 @@ any decorated referring includes.")
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
(semanticdb-notify-references
table (lambda (tab me)
table (lambda (tab _me)
(semantic-decoration-unparsed-include-refrence-reset tab)
))
))
@ -805,7 +805,7 @@ any decorated referring includes.")
(semantic-reset cache)))
(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
_new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))

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

@ -1,4 +1,4 @@
;;; semantic/decorate/mode.el --- Minor mode for decorating tags
;;; semantic/decorate/mode.el --- Minor mode for decorating tags -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
@ -358,12 +358,12 @@ Return non-nil if the decoration style is enabled."
:selected `(semantic-decoration-style-enabled-p ,(car style))
))
(defun semantic-build-decoration-mode-menu (&rest ignore)
(defun semantic-build-decoration-mode-menu (&rest _ignore)
"Create a menu listing all the known decorations for toggling.
IGNORE any input arguments."
(or semantic-decoration-menu-cache
(setq semantic-decoration-menu-cache
(mapcar 'semantic-decoration-build-style-menu
(mapcar #'semantic-decoration-build-style-menu
(reverse semantic-decoration-styles))
)))

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

@ -1,4 +1,4 @@
;;; idle.el --- Schedule parsing tasks in idle time
;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc.
@ -222,18 +222,18 @@ And also manages services that depend on tag values."
(and (buffer-file-name b)
b))
(buffer-list)))))
safe ;; This safe is not used, but could be.
;; safe ;; This safe is not used, but could be.
others
mode)
(when (semantic-idle-scheduler-enabled-p)
(save-excursion
;; First, reparse the current buffer.
(setq mode major-mode
safe (semantic-safe "Idle Parse Error: %S"
;(error "Goofy error 1")
(semantic-idle-scheduler-refresh-tags)
)
)
(setq mode major-mode)
;; (setq safe
(semantic-safe "Idle Parse Error: %S"
;(error "Goofy error 1")
(semantic-idle-scheduler-refresh-tags))
;; Now loop over other buffers with same major mode, trying to
;; update them as well. Stop on keypress.
(dolist (b buffers)
@ -430,6 +430,8 @@ datasets."
(message "Long Work Idle Timer...%s" exit-type)))
)
(defvar ede-auto-add-method)
(defun semantic-idle-scheduler-work-parse-neighboring-files ()
"Parse all the files in similar directories to buffers being edited."
;; Let's tell EDE to ignore all the files we're about to load
@ -564,11 +566,12 @@ DOC will be a documentation string describing FORMS.
FORMS will be called during idle time after the current buffer's
semantic tag information has been updated.
This routine creates the following functions and variables:"
(declare (indent 1) (debug (&define name stringp def-body)))
(let ((global (intern (concat "global-" (symbol-name name) "-mode")))
(mode (intern (concat (symbol-name name) "-mode")))
(hook (intern (concat (symbol-name name) "-mode-hook")))
(map (intern (concat (symbol-name name) "-mode-map")))
(setup (intern (concat (symbol-name name) "-mode-setup")))
;; (setup (intern (concat (symbol-name name) "-mode-setup")))
(func (intern (concat (symbol-name name) "-idle-function"))))
`(progn
@ -618,11 +621,6 @@ turned on in every Semantic-supported buffer.")
,(concat "Perform idle activity for the minor mode `"
(symbol-name mode) "'.")
,@forms))))
(put 'define-semantic-idle-service 'lisp-indent-function 1)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec define-semantic-idle-service
(&define name stringp def-body))))
;;; SUMMARY MODE
;;
@ -821,6 +819,8 @@ turned on in every Semantic-supported buffer."
(make-obsolete-variable 'semantic-idle-symbol-highlight-face
"customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
(defvar pulse-flag)
(defun semantic-idle-symbol-maybe-highlight (tag)
"Perhaps add highlighting to the symbol represented by TAG.
TAG was found as the symbol under point. If it happens to be
@ -898,7 +898,7 @@ Call `semantic-symref-hits-in-region' to identify local references."
(when (semantic-tag-p target)
(require 'semantic/symref/filter)
(semantic-symref-hits-in-region
target (lambda (start end prefix)
target (lambda (start end _prefix)
(when (/= start (car Hbounds))
(pulse-momentary-highlight-region
start end semantic-idle-symbol-highlight-face))
@ -1231,7 +1231,7 @@ shortened at the beginning."
)
(defun semantic-idle-breadcrumbs--format-linear
(tag-list &optional max-length)
(tag-list &optional _max-length)
"Format TAG-LIST as a linear list, starting with the outermost tag.
MAX-LENGTH is not used."
(require 'semantic/analyze/fcn)

55
lisp/cedet/semantic/lex-spp.el
View file

@ -1,4 +1,4 @@
;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@ -106,22 +106,12 @@ added and removed from this symbol table.")
Pushes NAME into the macro stack. The above stack is checked
by `semantic-lex-spp-symbol' to not return true for any symbol
currently being expanded."
(declare (indent 1) (debug (symbolp def-body)))
`(unwind-protect
(progn
(push ,name semantic-lex-spp-expanded-macro-stack)
,@body)
(pop semantic-lex-spp-expanded-macro-stack)))
(put 'semantic-lex-with-macro-used 'lisp-indent-function 1)
(add-hook
'edebug-setup-hook
#'(lambda ()
(def-edebug-spec semantic-lex-with-macro-used
(symbolp def-body)
)
))
;;; MACRO TABLE UTILS
;;
@ -190,7 +180,7 @@ Disable debugging by entering nothing."
(setq semantic-lex-spp-debug-symbol nil)
(setq semantic-lex-spp-debug-symbol sym)))
(defmacro semantic-lex-spp-validate-value (name value)
(defmacro semantic-lex-spp-validate-value (_name _value)
"Validate the NAME and VALUE of a macro before it is set."
; `(progn
; (when (not (semantic-lex-spp-value-valid-p ,value))
@ -212,12 +202,11 @@ the dynamic map."
(semantic-lex-spp-dynamic-map)))
value))
(defsubst semantic-lex-spp-symbol-remove (name &optional obarray)
(defsubst semantic-lex-spp-symbol-remove (name &optional map)
"Remove the spp symbol with NAME.
If optional OBARRAY is non-nil, then use that obarray instead of
If optional obarray MAP is non-nil, then use that obarray instead of
the dynamic map."
(unintern name (or obarray
(semantic-lex-spp-dynamic-map))))
(unintern name (or map (semantic-lex-spp-dynamic-map))))
(defun semantic-lex-spp-symbol-push (name value)
"Push macro NAME with VALUE into the map.
@ -246,7 +235,7 @@ Reverse with `semantic-lex-spp-symbol-pop'."
(stack (semantic-lex-spp-dynamic-map-stack))
(mapsym (intern name map))
(stacksym (intern name stack))
(oldvalue nil)
;; (oldvalue nil)
)
(if (or (not (boundp stacksym) )
(= (length (symbol-value stacksym)) 0))
@ -324,7 +313,7 @@ For use with semanticdb restoration of state."
;; Default obarray for below is the dynamic map.
(semantic-lex-spp-symbol-set (car e) (cdr e))))
(defun semantic-lex-spp-reset-hook (start end)
(defun semantic-lex-spp-reset-hook (start _end)
"Reset anything needed by SPP for parsing.
In this case, reset the dynamic macro symbol table if
START is (point-min).
@ -354,7 +343,7 @@ Return non-nil if it matches"
(string-match regex value))
))
(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues)
(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end _argvalues)
"Convert lexical macro contents VAL into a macro expansion stream.
These are for simple macro expansions that a user may have typed in directly.
As such, we need to analyze the input text, to figure out what kind of real
@ -819,7 +808,7 @@ ARGVALUES are values for any arg list, or nil."
;; An analyzer that will push tokens from a macro in place
;; of the macro symbol.
;;
(defun semantic-lex-spp-analyzer-do-replace (sym val beg end)
(defun semantic-lex-spp-analyzer-do-replace (_sym val beg end)
"Do the lexical replacement for SYM with VAL.
Argument BEG and END specify the bounds of SYM in the buffer."
(if (not val)
@ -1045,7 +1034,7 @@ and variable state from the current buffer."
(fresh-toks nil)
(toks nil)
(origbuff (current-buffer))
(analyzer semantic-lex-analyzer)
;; (analyzer semantic-lex-analyzer)
(important-vars '(semantic-lex-spp-macro-symbol-obarray
semantic-lex-spp-project-macro-symbol-obarray
semantic-lex-spp-dynamic-macro-symbol-obarray
@ -1176,6 +1165,7 @@ of type `spp-macro-def' is to be created.
VALFORM are forms that return the value to be saved for this macro, or nil.
When implementing a macro, you can use `semantic-lex-spp-stream-for-macro'
to convert text into a lexical stream for storage in the macro."
(declare (debug (&define name stringp stringp form def-body)))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@ -1209,6 +1199,7 @@ REGEXP is a regular expression for the analyzer to match.
See `define-lex-regex-analyzer' for more on regexp.
TOKIDX is an index into REGEXP for which a new lexical token
of type `spp-macro-undef' is to be created."
(declare (debug (&define name stringp stringp form)))
(let ((start (make-symbol "start"))
(end (make-symbol "end")))
`(define-lex-regex-analyzer ,name
@ -1244,7 +1235,7 @@ Note: Not implemented yet."
:group 'semantic
:type 'boolean)
(defun semantic-lex-spp-merge-header (name)
(defun semantic-lex-spp-merge-header (_name)
"Extract and merge any macros from the header with NAME.
Finds the header file belonging to NAME, gets the macros
from that file, and then merge the macros with our current
@ -1269,6 +1260,7 @@ type of include. The return value should be of the form:
(NAME . TYPE)
where NAME is the name of the include, and TYPE is the type of the include,
where a valid symbol is `system', or nil."
(declare (debug (&define name stringp stringp form def-body)))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@ -1369,23 +1361,6 @@ If BUFFER is not provided, use the current buffer."
(princ "\n")
))))
;;; EDEBUG Handlers
;;
(add-hook
'edebug-setup-hook
#'(lambda ()
(def-edebug-spec define-lex-spp-macro-declaration-analyzer
(&define name stringp stringp form def-body)
)
(def-edebug-spec define-lex-spp-macro-undeclaration-analyzer
(&define name stringp stringp form)
)
(def-edebug-spec define-lex-spp-include-analyzer
(&define name stringp stringp form def-body))))
(provide 'semantic/lex-spp)
;; Local variables:

44
lisp/cedet/semantic/lex.el
View file

@ -469,11 +469,9 @@ PROPERTY set."
;;; Lexical Analyzer framework settings
;;
;; FIXME change to non-obsolete default.
(defvar-local semantic-lex-analyzer 'semantic-flex
(defvar-local semantic-lex-analyzer 'semantic-lex
"The lexical analyzer used for a given buffer.
See `semantic-lex' for documentation.
For compatibility with Semantic 1.x it defaults to `semantic-flex'.")
See `semantic-lex' for documentation.")
(defvar semantic-lex-tokens
'(
@ -762,6 +760,7 @@ If two analyzers can match the same text, it is important to order the
analyzers so that the one you want to match first occurs first. For
example, it is good to put a number analyzer in front of a symbol
analyzer which might mistake a number for a symbol."
(declare (debug (&define name stringp (&rest symbolp))))
`(defun ,name (start end &optional depth length)
,(concat doc "\nSee `semantic-lex' for more information.")
;; Make sure the state of block parsing starts over.
@ -1066,14 +1065,13 @@ the desired syntax, and a position returned.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
Avoid using a large FORMS since it is duplicated."
(declare (indent 1) (debug t))
`(if (and debug-on-error semantic-lex-debug-analyzers)
(progn ,@forms)
(condition-case nil
(progn ,@forms)
(error
(semantic-lex-unterminated-syntax-detected ,syntax)))))
(put 'semantic-lex-unterminated-syntax-protection
'lisp-indent-function 1)
(defmacro define-lex-analyzer (name doc condition &rest forms)
"Create a single lexical analyzer NAME with DOC.
@ -1098,6 +1096,7 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to
after the location of the analyzed entry, and to add any discovered tokens
at the beginning of `semantic-lex-token-stream'.
This can be done by using `semantic-lex-push-token'."
(declare (debug (&define name stringp form def-body)))
`(eval-and-compile
(defvar ,name nil ,doc)
(defun ,name nil)
@ -1124,6 +1123,7 @@ This can be done by using `semantic-lex-push-token'."
"Create a lexical analyzer with NAME and DOC that will match REGEXP.
FORMS are evaluated upon a successful match.
See `define-lex-analyzer' for more about analyzers."
(declare (debug (&define name stringp form def-body)))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@ -1141,6 +1141,8 @@ expression.
FORMS are evaluated upon a successful match BEFORE the new token is
created. It is valid to ignore FORMS.
See `define-lex-analyzer' for more about analyzers."
(declare (debug
(&define name stringp form symbolp [ &optional form ] def-body)))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@ -1165,6 +1167,7 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM
and CLOSE-DELIM are respectively the open and close delimiters
identifying a block. OPEN-SYM and CLOSE-SYM are respectively the
symbols returned in open and close tokens."
(declare (debug (&define name stringp form (&rest form))))
(let ((specs (cons spec1 specs))
spec open olist clist)
(while specs
@ -1686,6 +1689,7 @@ the error will be caught here without the buffer's cache being thrown
out of date.
If there is an error, the syntax that failed is returned.
If there is no error, then the last value of FORMS is returned."
(declare (indent 1) (debug (symbolp def-body)))
(let ((ret (make-symbol "ret"))
(syntax (make-symbol "syntax"))
(start (make-symbol "start"))
@ -1709,35 +1713,7 @@ If there is no error, then the last value of FORMS is returned."
;;(message "Buffer not currently parsable (%S)." ,ret)
(semantic-parse-tree-unparseable))
,ret)))
(put 'semantic-lex-catch-errors 'lisp-indent-function 1)
;;; Interfacing with edebug
;;
(add-hook
'edebug-setup-hook
#'(lambda ()
(def-edebug-spec define-lex
(&define name stringp (&rest symbolp))
)
(def-edebug-spec define-lex-analyzer
(&define name stringp form def-body)
)
(def-edebug-spec define-lex-regex-analyzer
(&define name stringp form def-body)
)
(def-edebug-spec define-lex-simple-regex-analyzer
(&define name stringp form symbolp [ &optional form ] def-body)
)
(def-edebug-spec define-lex-block-analyzer
(&define name stringp form (&rest form))
)
(def-edebug-spec semantic-lex-catch-errors
(symbolp def-body)
)
))
;;; Compatibility with Semantic 1.x lexical analysis

14
lisp/cedet/semantic/scope.el
View file

@ -1,4 +1,4 @@
;;; semantic/scope.el --- Analyzer Scope Calculations
;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.")
)
(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
new-tags)
_new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
@ -262,7 +262,7 @@ are from nesting data types."
(semantic-go-to-tag pparent)
(setq stack (semantic-find-tag-by-overlay (point)))
;; Step one, find the merged version of stack in the typecache.
(let* ((stacknames (reverse (mapcar 'semantic-tag-name stack)))
(let* ((stacknames (reverse (mapcar #'semantic-tag-name stack)))
(tc nil)
)
;; @todo - can we use the typecache ability to
@ -317,7 +317,7 @@ are from nesting data types."
;; returnlist is empty.
(while snlist
(setq fullsearchname
(append (mapcar 'semantic-tag-name returnlist)
(append (mapcar #'semantic-tag-name returnlist)
(list (car snlist)))) ;; Next one
(setq ptag
(semanticdb-typecache-find fullsearchname))
@ -325,8 +325,8 @@ are from nesting data types."
(when (or (not ptag)
(not (semantic-tag-of-class-p ptag 'type)))
(let ((rawscope
(apply 'append
(mapcar 'semantic-tag-type-members
(apply #'append
(mapcar #'semantic-tag-type-members
(cons (car returnlist) scopetypes)
)))
)
@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE."
(setq leftover (cons S leftover)))))
(nreverse leftover)))
(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit _protection)
"Return all parts of TYPE, a tag representing a TYPE declaration.
SCOPE is the scope object.
NOINHERIT turns off searching of inherited tags.

4
lisp/cedet/semantic/symref/cscope.el
View file

@ -1,6 +1,6 @@
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope -*- lexical-binding: t; -*-
;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>

10
lisp/cedet/semantic/symref/filter.el
View file

@ -1,4 +1,4 @@
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@ -48,7 +48,7 @@
"Determine if the tag TARGET is used at POSITION in the current buffer.
Return non-nil for a match."
(semantic-analyze-current-symbol
(lambda (start end prefix)
(lambda (_start _end prefix)
(let ((tag (car (nreverse prefix))))
(and (semantic-tag-p tag)
(semantic-equivalent-tag-p target tag))))
@ -97,7 +97,7 @@ tag that contains point, and return that."
(Lcount 0))
(when (semantic-tag-p target)
(semantic-symref-hits-in-region
target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount)))
(semantic-tag-start tag)
(semantic-tag-end tag))
(when (called-interactively-p 'interactive)
@ -106,6 +106,8 @@ tag that contains point, and return that."
(semantic-elapsed-time start nil)))
Lcount)))
(defvar srecode-field-archive)
(defun semantic-symref-rename-local-variable ()
"Fancy way to rename the local variable under point.
Depends on the SRecode Field editing API."
@ -140,7 +142,7 @@ Depends on the SRecode Field editing API."
(region nil)
)
(semantic-symref-hits-in-region
target (lambda (start end prefix)
target (lambda (start end _prefix)
;; For every valid hit, create one field.
(srecode-field "LOCAL" :name "LOCAL" :start start :end end))
(semantic-tag-start tag) (semantic-tag-end tag))

2
lisp/cedet/semantic/symref/global.el
View file

@ -1,4 +1,4 @@
;;; semantic/symref/global.el --- Use GNU Global for symbol references
;;; semantic/symref/global.el --- Use GNU Global for symbol references -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.

2
lisp/cedet/semantic/symref/grep.el
View file

@ -1,4 +1,4 @@
;;; semantic/symref/grep.el --- Symref implementation using find/grep
;;; semantic/symref/grep.el --- Symref implementation using find/grep -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.

4
lisp/cedet/semantic/symref/idutils.el
View file

@ -1,6 +1,6 @@
;;; semantic/symref/idutils.el --- Symref implementation for idutils
;;; semantic/symref/idutils.el --- Symref implementation for idutils -*- lexical-binding: t; -*-
;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>

2
lisp/cedet/semantic/symref/list.el
View file

@ -1,4 +1,4 @@
;;; semantic/symref/list.el --- Symref Output List UI.
;;; semantic/symref/list.el --- Symref Output List UI -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.

14
lisp/cedet/semantic/tag.el
View file

@ -1,4 +1,4 @@
;;; semantic/tag.el --- tag creation and access
;;; semantic/tag.el --- Tag creation and access -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@ -1038,25 +1038,17 @@ See `semantic-tag-bounds'."
(defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body)
"Execute BODY with the buffer narrowed to the current tag."
(declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-tag (semantic-current-tag))
,@body))
(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
(def-body))))
(defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body)
"Narrow to TAG, and execute BODY."
(declare (indent 1) (debug t))
`(save-restriction
(semantic-narrow-to-tag ,tag)
,@body))
(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1)
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec semantic-with-buffer-narrowed-to-tag
(def-body))))
;;; Tag Hooks
;;

15
lisp/cedet/semantic/wisent.el
View file

@ -1,4 +1,4 @@
;;; semantic/wisent.el --- Wisent - Semantic gateway
;;; semantic/wisent.el --- Wisent - Semantic gateway -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2007, 2009-2021 Free Software Foundation, Inc.
@ -69,6 +69,7 @@ Returned tokens must have the form:
(TOKSYM VALUE START . END)
where VALUE is the buffer substring between START and END positions."
(declare (debug (&define name stringp def-body)))
`(defun
,name () ,doc
(cond
@ -319,18 +320,6 @@ the standard function `semantic-parse-region'."
(point-max))))))
;; Return parse tree
(nreverse ptree)))
;;; Interfacing with edebug
;;
(add-hook
'edebug-setup-hook
#'(lambda ()
(def-edebug-spec define-wisent-lexer
(&define name stringp def-body)
)
))
(provide 'semantic/wisent)

7
lisp/comint.el
View file

@ -378,7 +378,7 @@ This variable is buffer-local."
"\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
;; "[[:alpha:]]" used to be "for", which fails to match non-English.
"\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'")
"\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:version "27.1"
@ -700,8 +700,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00827.html
;;
;; This makes it really work to keep point at the bottom.
;; (make-local-variable 'scroll-conservatively)
;; (setq scroll-conservatively 10000)
;; (setq-local scroll-conservatively 10000)
(add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
(make-local-variable 'comint-ptyp)
(make-local-variable 'comint-process-echoes)
@ -2433,6 +2432,8 @@ This function could be in the list `comint-output-filter-functions'."
(replace-regexp-in-string "\r" "" string)))
(when (string-match "^[ \n\r\t\v\f\b\a]+" string)
(setq string (replace-match "" t t string)))
(when (string-match "\n+\\'" string)
(setq string (replace-match "" t t string)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
(if (> comint--prompt-recursion-depth 10)
(message "Password prompt recursion too deep")

4
lisp/cus-dep.el
View file

@ -178,7 +178,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(insert "\
;; The remainder of this file is for handling :version.
;; We provide a minimum of information so that `customize-changed-options'
;; We provide a minimum of information so that `customize-changed'
;; can do its job.
;; For groups we set `custom-version', `group-documentation' and
@ -239,7 +239,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
This is an alist whose members have as car a version string, and as
elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
buffer that `customize-changed-options' generates.\")\n\n"))
buffer that `customize-changed' generates.\")\n\n"))
(save-buffer)
(byte-compile-info
(format "Generating %s...done" generated-custom-dependencies-file) t))

7
lisp/cus-edit.el
View file

@ -1206,7 +1206,7 @@ Show the buffer in another window, but don't select it."
(message "`%s' is an alias for `%s'" symbol basevar))))
(defvar customize-changed-options-previous-release "26.3"
"Version for `customize-changed-options' to refer back to by default.")
"Version for `customize-changed' to refer back to by default.")
;; Packages will update this variable, so make it available.
;;;###autoload
@ -1242,10 +1242,11 @@ the user might see the value in an error message, a good choice is
the official name of the package, such as MH-E or Gnus.")
;;;###autoload
(defalias 'customize-changed 'customize-changed-options)
(define-obsolete-function-alias 'customize-changed-options
#'customize-changed "28.1")
;;;###autoload
(defun customize-changed-options (&optional since-version)
(defun customize-changed (&optional since-version)
"Customize all settings whose meanings have changed in Emacs itself.
This includes new user options and faces, and new customization
groups, as well as older options and faces whose meanings or

2
lisp/cus-start.el
View file

@ -343,7 +343,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const :tag "Never" nil)
(const :tag "Always" t)
(repeat (symbol :tag "Parameter")))
"25.1")
"27.1")
(iconify-child-frame frames
(choice
(const :tag "Do nothing" nil)

2
lisp/dired-x.el
View file

@ -447,7 +447,7 @@ If it is `no-dir', omitting is much faster, but you can only match
against the non-directory part of the file name. Set it to nil if you
need to match the entire file name.")
;; \017=^O for Omit - other packages can chose other control characters.
;; \017=^O for Omit - other packages can choose other control characters.
(defvar dired-omit-marker-char ?\017
"Temporary marker used by Dired-Omit.
Should never be used as marker by the user or other packages.")

15
lisp/emacs-lisp/autoload.el
View file

@ -141,9 +141,12 @@ expression, in which case we want to handle forms differently."
((stringp (car-safe rest)) (car rest))))
;; Look for an interactive spec.
(interactive (pcase body
((or `((interactive . ,_) . ,_)
`(,_ (interactive . ,_) . ,_))
t))))
((or `((interactive . ,iargs) . ,_)
`(,_ (interactive . ,iargs) . ,_))
;; List of modes or just t.
(if (nthcdr 1 iargs)
(list 'quote (nthcdr 1 iargs))
t)))))
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (consp args) (setq doc (help-add-fundoc-usage doc args)))
@ -207,7 +210,11 @@ expression, in which case we want to handle forms differently."
easy-mmode-define-minor-mode
define-minor-mode))
t)
(eq (car-safe (car body)) 'interactive))
(and (eq (car-safe (car body)) 'interactive)
;; List of modes or just t.
(or (if (nthcdr 1 (car body))
(list 'quote (nthcdr 1 (car body)))
t))))
,(if macrop ''macro nil))))
;; For defclass forms, use `eieio-defclass-autoload'.

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

@ -190,7 +190,7 @@ This is commonly used to recompute `backtrace-frames'.")
(defvar-local backtrace-print-function #'cl-prin1
"Function used to print values in the current Backtrace buffer.")
(defvar-local backtrace-goto-source-functions nil
(defvar backtrace-goto-source-functions nil
"Abnormal hook used to jump to the source code for the current frame.
Each hook function is called with no argument, and should return
non-nil if it is able to switch to the buffer containing the
@ -638,10 +638,8 @@ content of the sexp."
(source-available (plist-get (backtrace-frame-flags frame)
:source-available)))
(unless (and source-available
(catch 'done
(dolist (func backtrace-goto-source-functions)
(when (funcall func)
(throw 'done t)))))
(run-hook-with-args-until-success
'backtrace-goto-source-functions))
(user-error "Source code location not known"))))
(defun backtrace-help-follow-symbol (&optional pos)

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

@ -26,7 +26,7 @@
;; Packing and unpacking of (binary) data structures.
;;
;; The data formats used in binary files and network protocols are
;; often structed data which can be described by a C-style structure
;; often structured data which can be described by a C-style structure
;; such as the one shown below. Using the bindat package, decoding
;; and encoding binary data formats like these is made simple using a
;; structure specification which closely resembles the C style
@ -41,23 +41,23 @@
;; Consider the following C structures:
;;
;; struct header {
;; unsigned long dest_ip;
;; unsigned long src_ip;
;; unsigned short dest_port;
;; unsigned short src_port;
;; uint32_t dest_ip;
;; uint32_t src_ip;
;; uint16_t dest_port;
;; uint16_t src_port;
;; };
;;
;; struct data {
;; unsigned char type;
;; unsigned char opcode;
;; unsigned long length; /* In little endian order */
;; uint8_t type;
;; uint8_t opcode;
;; uint32_t length; /* In little endian order */
;; unsigned char id[8]; /* nul-terminated string */
;; unsigned char data[/* (length + 3) & ~3 */];
;; };
;;
;; struct packet {
;; struct header header;
;; unsigned char items;
;; uint8_t items;
;; unsigned char filler[3];
;; struct data item[/* items */];
;; };
@ -65,21 +65,24 @@
;; The corresponding Lisp bindat specification looks like this:
;;
;; (setq header-bindat-spec
;; '((dest-ip ip)
;; (bindat-spec
;; (dest-ip ip)
;; (src-ip ip)
;; (dest-port u16)
;; (src-port u16)))
;;
;; (setq data-bindat-spec
;; '((type u8)
;; (bindat-spec
;; (type u8)
;; (opcode u8)
;; (length u16r) ;; little endian order
;; (length u32r) ;; little endian order
;; (id strz 8)
;; (data vec (length))
;; (align 4)))
;;
;; (setq packet-bindat-spec
;; '((header struct header-bindat-spec)
;; (bindat-spec
;; (header struct header-bindat-spec)
;; (items u8)
;; (fill 3)
;; (item repeat (items)
@ -126,28 +129,30 @@
;; SPEC ::= ( ITEM... )
;; ITEM ::= ( [FIELD] TYPE )
;; ITEM ::= ( FIELD TYPE )
;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only
;; | ( [FIELD] fill LEN ) -- skip LEN bytes
;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes
;; | ( [FIELD] struct SPEC_NAME )
;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] )
;; | ( [FIELD] repeat COUNT ITEM... )
;; | ( FIELD repeat ARG ITEM... )
;; -- In (eval EXPR), the value of the last field is available in
;; the dynamically bound variable `last'.
;; the dynamically bound variable `last' and all the previous
;; ones in the variable `struct'.
;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE
;; | u8 | byte -- length 1
;; | u16 | word | short -- length 2, network byte order
;; | u24 -- 3-byte value
;; | u32 | dword | long -- length 4, network byte order
;; | u16r | u24r | u32r -- little endian byte order.
;; | u64 -- length 8, network byte order
;; | u16r | u24r | u32r | u64r - little endian byte order.
;; | str LEN -- LEN byte string
;; | strz LEN -- LEN byte (zero-terminated) string
;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8)
;; | ip -- 4 byte vector
;; | bits LEN -- List with bits set in LEN bytes.
;; | bits LEN -- bit vector using LEN bytes.
;;
;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
;; and 0x1c 0x28 to (3 5 10 11 12).
@ -178,7 +183,7 @@
;; is interpreted by evalling TAG_VAL and then comparing that to
;; each TAG using equal; if a match is found, the corresponding SPEC
;; is used.
;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
;; If TAG is a form (eval EXPR), EXPR is eval'ed with `tag' bound to the
;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil.
;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
;;
@ -191,7 +196,7 @@
;;; Code:
;; Helper functions for structure unpacking.
;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
;; Relies on dynamic binding of `bindat-raw' and `bindat-idx'.
(defvar bindat-raw)
(defvar bindat-idx)
@ -210,6 +215,9 @@
(defun bindat--unpack-u32 ()
(logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16)))
(defun bindat--unpack-u64 ()
(logior (ash (bindat--unpack-u32) 32) (bindat--unpack-u32)))
(defun bindat--unpack-u16r ()
(logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8)))
@ -219,25 +227,26 @@
(defun bindat--unpack-u32r ()
(logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16)))
(defun bindat--unpack-u64r ()
(logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32)))
(defun bindat--unpack-item (type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
(cond
((memq type '(u8 byte))
(pcase type
((or 'u8 'byte)
(bindat--unpack-u8))
((memq type '(u16 word short))
((or 'u16 'word 'short)
(bindat--unpack-u16))
((eq type 'u24)
(bindat--unpack-u24))
((memq type '(u32 dword long))
('u24 (bindat--unpack-u24))
((or 'u32 'dword 'long)
(bindat--unpack-u32))
((eq type 'u16r)
(bindat--unpack-u16r))
((eq type 'u24r)
(bindat--unpack-u24r))
((eq type 'u32r)
(bindat--unpack-u32r))
((eq type 'bits)
('u64 (bindat--unpack-u64))
('u16r (bindat--unpack-u16r))
('u24r (bindat--unpack-u24r))
('u32r (bindat--unpack-u32r))
('u64r (bindat--unpack-u64r))
('bits
(let ((bits nil) (bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
(if (= (setq m (bindat--unpack-u8)) 0)
@ -249,12 +258,12 @@
(setq bnum (1- bnum)
j (ash j -1)))))
bits))
((eq type 'str)
('str
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
(apply #'unibyte-string s))))
((eq type 'strz)
('strz
(let ((i 0) s)
(while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
@ -262,34 +271,29 @@
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
(apply #'unibyte-string s))))
((eq type 'vec)
(let ((v (make-vector len 0)) (i 0) (vlen 1))
('vec
(let ((v (make-vector len 0)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
vectype (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))
(while (< i len)
(aset v i (bindat--unpack-item type vlen vectype))
(setq i (1+ i)))
(dotimes (i len)
(aset v i (bindat--unpack-item type vlen vectype)))
v))
(t nil)))
(_ nil)))
(defun bindat--unpack-group (spec)
(with-suppressed-warnings ((lexical last))
(defvar last))
(with-suppressed-warnings ((lexical struct last))
(defvar struct) (defvar last))
(let (struct last)
(while spec
(let* ((item (car spec))
(field (car item))
(dolist (item spec)
(let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3)
data)
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@ -299,29 +303,29 @@
len type
type field
field nil))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
((eq type 'eval)
(pcase type
('eval
(if field
(setq data (eval len t))
(eval len t)))
((eq type 'fill)
('fill
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
('align
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
('struct
(setq data (bindat--unpack-group (eval len t))))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
(push (bindat--unpack-group (nthcdr tail item)) data)
(setq index (1+ index)))
(setq data (nreverse data))))
((eq type 'union)
('repeat
(dotimes (_ len)
(push (bindat--unpack-group (nthcdr tail item)) data))
(setq data (nreverse data)))
('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@ -333,7 +337,8 @@
(and (consp cc) (eval cc t)))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
(t
((pred integerp) (debug t))
(_
(setq data (bindat--unpack-item type len vectype)
last data)))
(if data
@ -367,30 +372,26 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq field (cdr field)))
struct)
;; Calculate bindat-raw length of structured data
;;;; Calculate bindat-raw length of structured data
(defvar bindat--fixed-length-alist
'((u8 . 1) (byte . 1)
(u16 . 2) (u16r . 2) (word . 2) (short . 2)
(u24 . 3) (u24r . 3)
(u32 . 4) (u32r . 4) (dword . 4) (long . 4)
(u64 . 8) (u64r . 8)
(ip . 4)))
(defun bindat--length-group (struct spec)
(with-suppressed-warnings ((lexical last))
(defvar last))
(let (last)
(while spec
(let* ((item (car spec))
(field (car item))
(with-suppressed-warnings ((lexical struct last))
(defvar struct) (defvar last))
(let ((struct struct) last)
(dolist (item spec)
(let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@ -400,6 +401,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
len type
type field
field nil))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
@ -410,27 +413,25 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil)))
(cond
((eq type 'eval)
(pcase type
('eval
(if field
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
((eq type 'fill)
('fill
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
('align
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
('struct
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
(bindat--length-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
('repeat
(dotimes (index len)
(bindat--length-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))))
('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@ -443,7 +444,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
(t
(_
(if (setq type (assq type bindat--fixed-length-alist))
(setq len (* len (cdr type))))
(if field
@ -451,13 +452,13 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (+ bindat-idx len))))))))
(defun bindat-length (spec struct)
"Calculate bindat-raw length for STRUCT according to bindat SPEC."
"Calculate `bindat-raw' length for STRUCT according to bindat SPEC."
(let ((bindat-idx 0))
(bindat--length-group struct spec)
bindat-idx))
;; Pack structured data into bindat-raw
;;;; Pack structured data into bindat-raw
(defun bindat--pack-u8 (v)
(aset bindat-raw bindat-idx (logand v 255))
@ -476,6 +477,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u16 (ash v -16))
(bindat--pack-u16 v))
(defun bindat--pack-u64 (v)
(bindat--pack-u32 (ash v -32))
(bindat--pack-u32 v))
(defun bindat--pack-u16r (v)
(aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255))
(aset bindat-raw bindat-idx (logand v 255))
@ -489,27 +494,30 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u16r v)
(bindat--pack-u16r (ash v -16)))
(defun bindat--pack-u64r (v)
(bindat--pack-u32r v)
(bindat--pack-u32r (ash v -32)))
(defun bindat--pack-item (v type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
(cond
((null v)
(pcase type
((guard (null v))
(setq bindat-idx (+ bindat-idx len)))
((memq type '(u8 byte))
((or 'u8 'byte)
(bindat--pack-u8 v))
((memq type '(u16 word short))
((or 'u16 'word 'short)
(bindat--pack-u16 v))
((eq type 'u24)
('u24
(bindat--pack-u24 v))
((memq type '(u32 dword long))
((or 'u32 'dword 'long)
(bindat--pack-u32 v))
((eq type 'u16r)
(bindat--pack-u16r v))
((eq type 'u24r)
(bindat--pack-u24r v))
((eq type 'u32r)
(bindat--pack-u32r v))
((eq type 'bits)
('u64 (bindat--pack-u64 v))
('u16r (bindat--pack-u16r v))
('u24r (bindat--pack-u24r v))
('u32r (bindat--pack-u32r v))
('u64r (bindat--pack-u64r v))
('bits
(let ((bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
(setq m 0)
@ -522,41 +530,33 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bnum (1- bnum)
j (ash j -1))))
(bindat--pack-u8 m))))
((memq type '(str strz))
(let ((l (length v)) (i 0))
(if (> l len) (setq l len))
(while (< i l)
(aset bindat-raw (+ bindat-idx i) (aref v i))
(setq i (1+ i)))
(setq bindat-idx (+ bindat-idx len))))
((eq type 'vec)
(let ((l (length v)) (i 0) (vlen 1))
((or 'str 'strz)
(dotimes (i (min len (length v)))
(aset bindat-raw (+ bindat-idx i) (aref v i)))
(setq bindat-idx (+ bindat-idx len)))
('vec
(let ((l (length v)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
vectype (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))
(if (> l len) (setq l len))
(while (< i l)
(bindat--pack-item (aref v i) type vlen vectype)
(setq i (1+ i)))))
(t
(dotimes (i l)
(bindat--pack-item (aref v i) type vlen vectype))))
(_
(setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
(with-suppressed-warnings ((lexical last))
(defvar last))
(let (last)
(while spec
(let* ((item (car spec))
(field (car item))
(with-suppressed-warnings ((lexical struct last))
(defvar struct) (defvar last))
(let ((struct struct) last)
(dolist (item spec)
(let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@ -566,31 +566,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
len type
type field
field nil))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
((eq type 'eval)
(pcase type
('eval
(if field
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
((eq type 'fill)
('fill
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
('align
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
('struct
(bindat--pack-group
(if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
(bindat--pack-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
('repeat
(dotimes (index len)
(bindat--pack-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))))
('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@ -603,7 +603,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(progn
(bindat--pack-group struct (cdr case))
(setq cases nil))))))
(t
(_
(setq last (bindat-get-field struct field))
(bindat--pack-item last type len vectype)
))))))
@ -622,21 +622,61 @@ Optional fourth arg IDX is the starting offset into RAW."
(bindat--pack-group struct spec)
(if raw nil bindat-raw)))
;;;; Debugging support
;; Misc. format conversions
(def-edebug-elem-spec 'bindat-spec '(&rest bindat-item))
(def-edebug-elem-spec 'bindat--item-aux
;; Field types which can come without a field label.
'(&or ["eval" form]
["fill" bindat-len]
["align" bindat-len]
["struct" form] ;A reference to another bindat-spec.
["union" bindat-tag-val &rest (bindat-tag bindat-spec)]))
(def-edebug-elem-spec 'bindat-item
'((&or bindat--item-aux ;Without label..
[bindat-field ;..or with label
&or bindat--item-aux
["repeat" bindat-arg bindat-spec]
bindat-type])))
(def-edebug-elem-spec 'bindat-type
'(&or ("eval" form)
["str" bindat-len]
["strz" bindat-len]
["vec" bindat-len &optional bindat-type]
["bits" bindat-len]
symbolp))
(def-edebug-elem-spec 'bindat-field
'(&or ("eval" form) symbolp))
(def-edebug-elem-spec 'bindat-len '(&or [] "nil" bindat-arg))
(def-edebug-elem-spec 'bindat-tag-val '(bindat-arg))
(def-edebug-elem-spec 'bindat-tag '(&or ("eval" form) atom))
(def-edebug-elem-spec 'bindat-arg
'(&or ("eval" form) integerp (&rest symbolp integerp)))
(defmacro bindat-spec (&rest fields)
"Build the bindat spec described by FIELDS."
(declare (indent 0) (debug (bindat-spec)))
;; FIXME: We should really "compile" this to a triplet of functions!
`',fields)
;;;; Misc. format conversions
(defun bindat-format-vector (vect fmt sep &optional len)
"Format vector VECT using element format FMT and separator SEP.
Result is a string with each element of VECT formatted using FMT and
separated by the string SEP. If optional fourth arg LEN is given, use
only that many elements from VECT."
(unless len
(setq len (length vect)))
(let ((i len) (fmt2 (concat sep fmt)) (s nil))
(while (> i 0)
(setq i (1- i)
s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
(apply #'concat s)))
(when len (setq vect (substring vect 0 len)))
(mapconcat (lambda (x) (format fmt x)) vect sep))
(defun bindat-vector-to-dec (vect &optional sep)
"Format vector VECT in decimal format separated by dots.

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

@ -289,7 +289,7 @@
(byte-compile-preprocess
(byte-compile--reify-function fn))))))
(if (eq (car-safe newfn) 'function)
(byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
(macroexp--unfold-lambda `(,(cadr newfn) ,@(cdr form)))
;; This can happen because of macroexp-warn-and-return &co.
(byte-compile-warn
"Inlining closure %S failed" name)
@ -297,77 +297,91 @@
(_ ;; Give up on inlining.
form))))
;; ((lambda ...) ...)
(defun byte-compile-unfold-lambda (form &optional name)
;; In lexical-binding mode, let and functions don't bind vars in the same way
;; (let obey special-variable-p, but functions don't). But luckily, this
;; doesn't matter here, because function's behavior is underspecified so it
;; can safely be turned into a `let', even though the reverse is not true.
(or name (setq name "anonymous lambda"))
(let* ((lambda (car form))
(values (cdr form))
(arglist (nth 1 lambda))
(body (cdr (cdr lambda)))
optionalp restp
bindings)
(if (and (stringp (car body)) (cdr body))
(setq body (cdr body)))
(if (and (consp (car body)) (eq 'interactive (car (car body))))
(setq body (cdr body)))
;; FIXME: The checks below do not belong in an optimization phase.
(while arglist
(cond ((eq (car arglist) '&optional)
;; ok, I'll let this slide because funcall_lambda() does...
;; (if optionalp (error "multiple &optional keywords in %s" name))
(if restp (error "&optional found after &rest in %s" name))
(if (null (cdr arglist))
(error "nothing after &optional in %s" name))
(setq optionalp t))
((eq (car arglist) '&rest)
;; ...but it is by no stretch of the imagination a reasonable
;; thing that funcall_lambda() allows (&rest x y) and
;; (&rest x &optional y) in arglists.
(if (null (cdr arglist))
(error "nothing after &rest in %s" name))
(if (cdr (cdr arglist))
(error "multiple vars after &rest in %s" name))
(setq restp t))
(restp
(setq bindings (cons (list (car arglist)
(and values (cons 'list values)))
bindings)
values nil))
((and (not optionalp) (null values))
(byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
(setq arglist nil values 'too-few))
(t
(setq bindings (cons (list (car arglist) (car values))
bindings)
values (cdr values))))
(setq arglist (cdr arglist)))
(if values
(progn
(or (eq values 'too-few)
(byte-compile-warn
"attempt to open-code `%s' with too many arguments" name))
form)
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
;; byte-compile that file.
;(setq body (mapcar 'byte-optimize-form body)))
(let ((newform
(if bindings
(cons 'let (cons (nreverse bindings) body))
(cons 'progn body))))
(byte-compile-log " %s\t==>\t%s" form newform)
newform))))
;;; implementing source-level optimizers
(defconst byte-optimize-enable-variable-constprop t
"If non-nil, enable constant propagation through local variables.")
(defconst byte-optimize-warn-eliminated-variable nil
"Whether to warn when a variable is optimised away entirely.
This does usually not indicate a problem and makes the compiler
very chatty, but can be useful for debugging.")
(defvar byte-optimize--lexvars nil
"Lexical variables in scope, in reverse order of declaration.
Each element is on the form (NAME KEEP [VALUE]), where:
NAME is the variable name,
KEEP is a boolean indicating whether the binding must be retained,
VALUE, if present, is a substitutable expression.
Earlier variables shadow later ones with the same name.")
(defvar byte-optimize--vars-outside-condition nil
"Alist of variables lexically bound outside conditionally executed code.
Variables here are sensitive to mutation inside the conditional code,
since their contents in sequentially later code depends on the path taken
and may no longer be statically known.
Same format as `byte-optimize--lexvars', with shared structure and contents.")
(defvar byte-optimize--vars-outside-loop nil
"Alist of variables lexically bound outside the innermost `while' loop.
Variables here are sensitive to mutation inside the loop, since this can
occur an indeterminate number of times and thus have effect on code
sequentially preceding the mutation itself.
Same format as `byte-optimize--lexvars', with shared structure and contents.")
(defvar byte-optimize--dynamic-vars nil
"List of variables declared as dynamic during optimisation.")
(defun byte-optimize--substitutable-p (expr)
"Whether EXPR is a constant that can be propagated."
;; Only consider numbers, symbols and strings to be values for substitution
;; purposes. Numbers and symbols are immutable, and mutating string
;; literals (or results from constant-evaluated string-returning functions)
;; can be considered undefined.
;; (What about other quoted values, like conses?)
(or (booleanp expr)
(numberp expr)
(stringp expr)
(and (consp expr)
(eq (car expr) 'quote)
(symbolp (cadr expr)))
(keywordp expr)))
(defmacro byte-optimize--pcase (exp &rest cases)
;; When we do
;;
;; (pcase EXP
;; (`(if ,exp ,then ,else) (DO-TEST))
;; (`(plus ,e2 ,e2) (DO-ADD))
;; (`(times ,e2 ,e2) (DO-MULT))
;; ...)
;;
;; we usually don't want to fall back to the default case if
;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)'
;; or `(times E1 E2 E3)', instead we either want to signal an error
;; that EXP has an unexpected shape, or we want to carry on as if
;; it had the right shape (ignore the extra data and pretend the missing
;; data is nil) because it should simply never happen.
;;
;; The macro below implements the second option by rewriting patterns
;; like `(if ,exp ,then ,else)'
;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'.
;;
;; The resulting macroexpansion is also significantly cleaner/smaller/faster.
(declare (indent 1) (debug (form &rest (pcase-PAT body))))
`(pcase ,exp
. ,(mapcar (lambda (case)
`(,(pcase (car case)
((and `(,'\` (,_ . (,'\, ,_))) pat) pat)
(`(,'\` (,head . ,tail))
(list '\`
(cons head
(list '\, `(or ,(list '\` tail) pcase--dontcare)))))
(pat pat))
. ,(cdr case)))
cases)))
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@ -380,13 +394,26 @@
;; have no place in an optimizer: the corresponding tests should be
;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
(let ((fn (car-safe form)))
(pcase form
(byte-optimize--pcase form
((pred (not consp))
(if (not (and for-effect
(or byte-compile-delete-errors
(not (symbolp form))
(eq form t))))
form))
(cond
((and for-effect
(or byte-compile-delete-errors
(not (symbolp form))
(eq form t)))
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
(if (cddr lexvar) ; Value available?
(if (assq form byte-optimize--vars-outside-loop)
;; Cannot substitute; mark for retention to avoid the
;; variable being eliminated.
(progn
(setcar (cdr lexvar) t)
form)
(caddr lexvar)) ; variable value to use
form)))
(t form)))
(`(quote . ,v)
(if (cdr v)
(byte-compile-warn "malformed quote form: `%s'"
@ -396,39 +423,28 @@
(and (car v)
(not for-effect)
form))
(`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare))
;; Recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
;; are more deeply nested are optimized first.
(cons fn
(cons
(mapcar (lambda (binding)
(if (symbolp binding)
binding
(if (cdr (cdr binding))
(byte-compile-warn "malformed let binding: `%s'"
(prin1-to-string binding)))
(list (car binding)
(byte-optimize-form (nth 1 binding) nil))))
bindings)
(byte-optimize-body exps for-effect))))
(`(,(or 'let 'let*) . ,rest)
(cons fn (byte-optimize-let-form fn rest for-effect)))
(`(cond . ,clauses)
(cons fn
(mapcar (lambda (clause)
(if (consp clause)
(cons
(byte-optimize-form (car clause) nil)
(byte-optimize-body (cdr clause) for-effect))
(byte-compile-warn "malformed cond form: `%s'"
(prin1-to-string clause))
clause))
clauses)))
;; The condition in the first clause is always executed, but
;; right now we treat all of them as conditional for simplicity.
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
(cons fn
(mapcar (lambda (clause)
(if (consp clause)
(cons
(byte-optimize-form (car clause) nil)
(byte-optimize-body (cdr clause) for-effect))
(byte-compile-warn "malformed cond form: `%s'"
(prin1-to-string clause))
clause))
clauses))))
(`(progn . ,exps)
;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
(`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
(`(prog1 ,exp . ,exps)
(if exps
`(prog1 ,(byte-optimize-form exp for-effect)
. ,(byte-optimize-body exps t))
@ -442,37 +458,60 @@
(cons fn (byte-optimize-body exps for-effect)))
(`(if ,test ,then . ,else)
`(if ,(byte-optimize-form test nil)
,(byte-optimize-form then for-effect)
. ,(byte-optimize-body else for-effect)))
(`(if . ,_)
(byte-compile-warn "too few arguments for `if'"))
;; FIXME: We are conservative here: any variable changed in the
;; THEN branch will be barred from substitution in the ELSE
;; branch, despite the branches being mutually exclusive.
;; The test is always executed.
(let* ((test-opt (byte-optimize-form test nil))
(const (macroexp-const-p test-opt))
;; The branches are traversed unconditionally when possible.
(byte-optimize--vars-outside-condition
(if const
byte-optimize--vars-outside-condition
byte-optimize--lexvars))
;; Avoid traversing dead branches.
(then-opt (and test-opt (byte-optimize-form then for-effect)))
(else-opt (and (not (and test-opt const))
(byte-optimize-body else for-effect))))
`(if ,test-opt ,then-opt . ,else-opt)))
(`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
;; Take forms off the back until we can't any more.
;; In the future it could conceivably be a problem that the
;; subexpressions of these forms are optimized in the reverse
;; order, but it's ok for now.
(if for-effect
(let ((backwards (reverse exps)))
(while (and backwards
(null (setcar backwards
(byte-optimize-form (car backwards)
for-effect))))
(setq backwards (cdr backwards)))
(if (and exps (null backwards))
(byte-compile-log
" all subforms of %s called for effect; deleted" form))
(and backwards
(cons fn (nreverse (mapcar #'byte-optimize-form
backwards)))))
(cons fn (mapcar #'byte-optimize-form exps))))
;; FIXME: We have to traverse the expressions in left-to-right
;; order (because that is the order of evaluation and variable
;; mutations must be found prior to their use), but doing so we miss
;; some optimisation opportunities:
;; consider (and A B) in a for-effect context, where B => nil.
;; Then A could be optimised in a for-effect context too.
(let ((tail exps)
(args nil))
(when tail
;; The first argument is always unconditional.
(push (byte-optimize-form
(car tail) (and for-effect (null (cdr tail))))
args)
(setq tail (cdr tail))
;; Remaining arguments are conditional.
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
(while tail
(push (byte-optimize-form
(car tail) (and for-effect (null (cdr tail))))
args)
(setq tail (cdr tail)))))
(cons fn (nreverse args))))
(`(while ,exp . ,exps)
`(while ,(byte-optimize-form exp nil)
. ,(byte-optimize-body exps t)))
(`(while . ,_)
(byte-compile-warn "too few arguments for `while'"))
;; FIXME: We conservatively prevent the substitution of any variable
;; bound outside the loop in case it is mutated later in the loop,
;; but this misses many opportunities: variables not mutated in the
;; loop at all, and variables affecting the initial condition (which
;; is always executed unconditionally).
(let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars)
(byte-optimize--vars-outside-loop byte-optimize--lexvars)
(condition (byte-optimize-form exp nil))
(body (byte-optimize-body exps t)))
`(while ,condition . ,body)))
(`(interactive . ,_)
(byte-compile-warn "misplaced interactive spec: `%s'"
@ -484,25 +523,36 @@
;; all the subexpressions and compiling them separately.
form)
(`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
`(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
`(,(car clause)
,@(byte-optimize-body (cdr clause) for-effect)))
clauses)))
(`(condition-case ,var ,exp . ,clauses)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
`(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
`(,(car clause)
,@(byte-optimize-body (cdr clause) for-effect)))
clauses))))
(`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare))
;; The "protected" part of an unwind-protect is compiled (and thus
;; optimized) as a top-level form, so don't do it here. But the
;; non-protected part has the same for-effect status as the
;; unwind-protect itself. (The protected part is always for effect,
(`(unwind-protect ,exp . ,exps)
;; The unwinding part of an unwind-protect is compiled (and thus
;; optimized) as a top-level form, but run the optimizer for it here
;; anyway for lexical variable usage and substitution. But the
;; protected part has the same for-effect status as the
;; unwind-protect itself. (The unwinding part is always for effect,
;; but that isn't handled properly yet.)
`(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps))
(let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars)
(bodyform (byte-optimize-form exp for-effect)))
(pcase exps
(`(:fun-body ,f)
`(unwind-protect ,bodyform
:fun-body ,(byte-optimize-form f nil)))
(_
`(unwind-protect ,bodyform
. ,(byte-optimize-body exps t))))))
(`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
`(catch ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect)))
(`(catch ,tag . ,exps)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
`(catch ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect))))
(`(ignore . ,exps)
;; Don't treat the args to `ignore' as being
@ -512,10 +562,17 @@
`(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
;; Needed as long as we run byte-optimize-form after cconv.
(`(internal-make-closure . ,_) form)
(`(internal-make-closure . ,_)
;; Look up free vars and mark them to be kept, so that they
;; won't be optimised away.
(dolist (var (caddr form))
(let ((lexvar (assq var byte-optimize--lexvars)))
(when lexvar
(setcar (cdr lexvar) t))))
form)
(`((lambda . ,_) . ,_)
(let ((newform (byte-compile-unfold-lambda form)))
(let ((newform (macroexp--unfold-lambda form)))
(if (eq newform form)
;; Some error occurred, avoid infinite recursion.
form
@ -525,6 +582,35 @@
;; is a *value* and shouldn't appear in the car.
(`((closure . ,_) . ,_) form)
(`(setq . ,args)
(let ((var-expr-list nil))
(while args
(unless (and (consp args)
(symbolp (car args)) (consp (cdr args)))
(byte-compile-warn "malformed setq form: %S" form))
(let* ((var (car args))
(expr (cadr args))
(lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
;; Set a new value or inhibit further substitution.
(setcdr (cdr lexvar)
(and
;; Inhibit if bound outside conditional code.
(not (assq var byte-optimize--vars-outside-condition))
;; The new value must be substitutable.
(byte-optimize--substitutable-p value)
(list value)))
(setcar (cdr lexvar) t)) ; Mark variable to be kept.
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
(cons fn (nreverse var-expr-list))))
(`(defvar ,(and (pred symbolp) name) . ,_)
(push name byte-optimize--dynamic-vars)
form)
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
@ -557,30 +643,84 @@
(defun byte-optimize-form (form &optional for-effect)
"The source-level pass of the optimizer."
;;
;; First, optimize all sub-forms of this one.
(setq form (byte-optimize-form-code-walker form for-effect))
;;
;; after optimizing all subforms, optimize this form until it doesn't
;; optimize any further. This means that some forms will be passed through
;; the optimizer many times, but that's necessary to make the for-effect
;; processing do as much as possible.
;;
(let (opt new)
(if (and (consp form)
(symbolp (car form))
(or ;; (and for-effect
;; ;; We don't have any of these yet, but we might.
;; (setq opt (get (car form)
;; 'byte-for-effect-optimizer)))
(setq opt (function-get (car form) 'byte-optimizer)))
(not (eq form (setq new (funcall opt form)))))
(progn
;; (if (equal form new) (error "bogus optimizer -- %s" opt))
(byte-compile-log " %s\t==>\t%s" form new)
(setq new (byte-optimize-form new for-effect))
new)
form)))
(while
(progn
;; First, optimize all sub-forms of this one.
(setq form (byte-optimize-form-code-walker form for-effect))
;; If a form-specific optimiser is available, run it and start over
;; until a fixpoint has been reached.
(and (consp form)
(symbolp (car form))
(let ((opt (function-get (car form) 'byte-optimizer)))
(and opt
(let ((old form)
(new (funcall opt form)))
(byte-compile-log " %s\t==>\t%s" old new)
(setq form new)
(not (eq new old))))))))
;; Normalise (quote nil) to nil, for a single representation of constant nil.
(and (not (equal form '(quote nil))) form))
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
;; are more deeply nested are optimized first.
(if (and lexical-binding byte-optimize-enable-variable-constprop)
(let* ((byte-optimize--lexvars byte-optimize--lexvars)
(new-lexvars nil)
(let-vars nil))
(dolist (binding (car form))
(let (name expr)
(cond ((consp binding)
(setq name (car binding))
(unless (symbolp name)
(byte-compile-warn "let-bind nonvariable: `%S'" name))
(setq expr (byte-optimize-form (cadr binding) nil)))
((symbolp binding)
(setq name binding))
(t (byte-compile-warn "malformed let binding: `%S'" binding)))
(let* (
(value (and (byte-optimize--substitutable-p expr)
(list expr)))
(lexical (not (or (and (symbolp name)
(special-variable-p name))
(memq name byte-compile-bound-variables)
(memq name byte-optimize--dynamic-vars))))
(lexinfo (and lexical (cons name (cons nil value)))))
(push (cons name (cons expr (cdr lexinfo))) let-vars)
(when lexinfo
(push lexinfo (if (eq head 'let*)
byte-optimize--lexvars
new-lexvars))))))
(setq byte-optimize--lexvars
(append new-lexvars byte-optimize--lexvars))
;; Walk the body expressions, which may mutate some of the records,
;; and generate new bindings that exclude unused variables.
(let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars)
(opt-body (byte-optimize-body (cdr form) for-effect))
(bindings nil))
(dolist (var let-vars)
;; VAR is (NAME EXPR [KEEP [VALUE]])
(if (and (nthcdr 3 var) (not (nth 2 var)))
;; Value present and not marked to be kept: eliminate.
(when byte-optimize-warn-eliminated-variable
(byte-compile-warn "eliminating local variable %S" (car var)))
(push (list (nth 0 var) (nth 1 var)) bindings)))
(cons bindings opt-body)))
;; With dynamic binding, no substitutions are in effect.
(let ((byte-optimize--lexvars nil))
(cons
(mapcar (lambda (binding)
(if (symbolp binding)
binding
(when (or (atom binding) (cddr binding))
(byte-compile-warn "malformed let binding: `%S'" binding))
(list (car binding)
(byte-optimize-form (nth 1 binding) nil))))
(car form))
(byte-optimize-body (cdr form) for-effect)))))
(defun byte-optimize-body (forms all-for-effect)
@ -1422,10 +1562,7 @@
;; so we create a copy of it, and replace the addresses with
;; TAGs.
(let ((orig-table last-constant))
(cl-loop for e across constvec
when (eq e last-constant)
do (setq last-constant (copy-hash-table e))
and return nil)
(setq last-constant (copy-hash-table last-constant))
;; Replace all addresses with TAGs.
(maphash #'(lambda (value offset)
(let ((match (assq offset tags)))

19
lisp/emacs-lisp/byte-run.el
View file

@ -113,6 +113,9 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''side-effect-free (list 'quote val))))
(put 'compiler-macro 'edebug-declaration-spec
'(&or symbolp ("lambda" &define lambda-list lambda-doc def-body)))
(defalias 'byte-run--set-compiler-macro
#'(lambda (f args compiler-function)
(if (not (eq (car-safe compiler-function) 'lambda))
@ -143,6 +146,18 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''lisp-indent-function (list 'quote val))))
(defalias 'byte-run--set-completion
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''completion-predicate val)))
(defalias 'byte-run--set-modes
#'(lambda (f _args &rest val)
(list 'function-put (list 'quote f)
''completion-predicate
`(lambda (_ b)
(command-completion-with-modes-p ',val b)))))
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
@ -159,7 +174,9 @@ This may shift errors from run-time to compile-time.")
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
(list 'compiler-macro #'byte-run--set-compiler-macro)
(list 'doc-string #'byte-run--set-doc-string)
(list 'indent #'byte-run--set-indent))
(list 'indent #'byte-run--set-indent)
(list 'completion #'byte-run--set-completion)
(list 'modes #'byte-run--set-modes))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,

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

@ -195,7 +195,6 @@ otherwise adds \".elc\"."
(autoload 'byte-optimize-form "byte-opt")
;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
(autoload 'byte-compile-unfold-lambda "byte-opt")
;; This is the entry point to the decompiler, which is used by the
;; disassembler. The disassembler just requires 'byte-compile, but
@ -2860,7 +2859,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
((eq arg '&optional)
(when (memq '&optional (cdr list))
(error "Duplicate &optional")))
((memq arg vars)
((and (memq arg vars)
;; Allow repetitions for unused args.
(not (string-match "\\`_" (symbol-name arg))))
(byte-compile-warn "repeated variable %s in lambda-list" arg))
(t
(push arg vars))))
@ -2940,7 +2941,8 @@ for symbols generated by the byte compiler itself."
;; unless it is the last element of the body.
(if (cdr body)
(setq body (cdr body))))))
(int (assq 'interactive body)))
(int (assq 'interactive body))
command-modes)
(when lexical-binding
(dolist (var arglistvars)
(when (assq var byte-compile--known-dynamic-vars)
@ -2951,10 +2953,13 @@ for symbols generated by the byte compiler itself."
;; Skip (interactive) if it is in front (the most usual location).
(if (eq int (car body))
(setq body (cdr body)))
(cond ((consp (cdr int))
(if (cdr (cdr int))
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int)))
(cond ((consp (cdr int)) ; There is an `interactive' spec.
;; Check that the bit after the `interactive' spec is
;; just a list of symbols (i.e., modes).
(unless (seq-every-p #'symbolp (cdr (cdr int)))
(byte-compile-warn "malformed interactive specc: %s"
(prin1-to-string int)))
(setq command-modes (cdr (cdr int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
@ -2965,15 +2970,14 @@ for symbols generated by the byte compiler itself."
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
(if (and (eq (car-safe form) 'list)
;; For code using lexical-binding, form is not
;; valid lisp, but rather an intermediate form
;; which may include "calls" to
;; internal-make-closure (Bug#29988).
(not lexical-binding))
nil
(setq int `(interactive ,newform)))))
((cdr int)
(when (or (not (eq (car-safe form) 'list))
;; For code using lexical-binding, form is not
;; valid lisp, but rather an intermediate form
;; which may include "calls" to
;; internal-make-closure (Bug#29988).
lexical-binding)
(setq int `(interactive ,newform)))))
((cdr int) ; Invalid (interactive . something).
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int)))))
;; Process the body.
@ -3003,9 +3007,16 @@ for symbols generated by the byte compiler itself."
(list (help-add-fundoc-usage doc arglist)))
((or doc int)
(list doc)))
;; optionally, the interactive spec.
(if int
(list (nth 1 int))))))))
;; optionally, the interactive spec (and the modes the
;; command applies to).
(cond
;; We have some command modes, so use the vector form.
(command-modes
(list (vector (nth 1 int) command-modes)))
;; No command modes, use the simple form with just the
;; interactive spec.
(int
(list (nth 1 int)))))))))
(defvar byte-compile-reserved-constants 0)
@ -3277,7 +3288,7 @@ for symbols generated by the byte compiler itself."
((and (eq (car-safe (car form)) 'lambda)
;; if the form comes out the same way it went in, that's
;; because it was malformed, and we couldn't unfold it.
(not (eq form (setq form (byte-compile-unfold-lambda form)))))
(not (eq form (setq form (macroexp--unfold-lambda form)))))
(byte-compile-form form byte-compile--for-effect)
(setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))

6
lisp/emacs-lisp/chart.el
View file

@ -187,7 +187,7 @@ Make sure the width/height is correct."
)
"Class used to display an axis which represents different named items.")
(defclass chart-sequece ()
(defclass chart-sequence ()
((data :initarg :data
:initform nil)
(name :initarg :name
@ -583,12 +583,12 @@ SORT-PRED if desired."
))
(iv (eq dir 'vertical)))
(chart-add-sequence nc
(make-instance 'chart-sequece
(make-instance 'chart-sequence
:data namelst
:name nametitle)
(if iv 'x-axis 'y-axis))
(chart-add-sequence nc
(make-instance 'chart-sequece
(make-instance 'chart-sequence
:data numlst
:name numtitle)
(if iv 'y-axis 'x-axis))

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