[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk aac33a8: Merge branch 'master' of git.sv.gnu.org:/srv/git/e
|
From: |
Yuuki Harano |
|
Subject: |
feature/pgtk aac33a8: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk |
|
Date: |
Sun, 10 Jan 2021 05:04:08 -0500 (EST) |
branch: feature/pgtk
commit aac33a8074c41354ffdb1236a342da16dca4a1bc
Merge: 78fd106 690cf6b
Author: Yuuki Harano <masm+github@masm11.me>
Commit: Yuuki Harano <masm+github@masm11.me>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
---
Makefile.in | 4 +
admin/charsets/cp51932.awk | 2 +-
admin/charsets/eucjp-ms.awk | 2 +-
admin/last-chance.el | 20 +-
admin/nt/dist-build/build-zips.sh | 10 +-
admin/unidata/blocks.awk | 2 +-
configure.ac | 12 +
doc/lispref/debugging.texi | 2 +-
doc/lispref/help.texi | 2 +-
doc/lispref/minibuf.texi | 2 +-
doc/lispref/strings.texi | 6 +-
doc/lispref/syntax.texi | 2 +-
doc/lispref/windows.texi | 6 +
doc/misc/widget.texi | 8 +-
etc/NEWS | 40 ++
lisp/arc-mode.el | 2 -
lisp/bindings.el | 6 +-
lisp/calc/calc-embed.el | 2 +-
lisp/calc/calc-ext.el | 2 +-
lisp/calc/calc-prog.el | 25 +-
lisp/calc/calc-sel.el | 12 +-
lisp/calc/calc-store.el | 8 +-
lisp/calc/calc-yank.el | 88 ++--
lisp/calendar/appt.el | 4 +-
lisp/cedet/semantic/symref/grep.el | 3 +-
lisp/cedet/srecode/semantic.el | 8 +-
lisp/composite.el | 8 +-
lisp/cus-face.el | 2 +-
lisp/custom.el | 8 +-
lisp/disp-table.el | 2 +-
lisp/dos-fns.el | 2 +-
lisp/dos-w32.el | 10 +-
lisp/electric.el | 4 +-
lisp/emacs-lisp/autoload.el | 25 +-
lisp/emacs-lisp/byte-run.el | 29 +-
lisp/emacs-lisp/bytecomp.el | 9 +-
lisp/emacs-lisp/cl-generic.el | 26 +-
lisp/emacs-lisp/cl-macs.el | 123 +++++-
lisp/emacs-lisp/eieio-core.el | 3 +-
lisp/emacs-lisp/macroexp.el | 29 ++
lisp/emacs-lisp/package.el | 92 ++--
lisp/emacs-lisp/pcase.el | 27 +-
lisp/erc/erc.el | 79 ++--
lisp/facemenu.el | 2 +-
lisp/filesets.el | 477 +++++++++------------
lisp/font-core.el | 2 +-
lisp/format.el | 5 +-
lisp/gnus/gnus-win.el | 1 -
lisp/gnus/mm-decode.el | 19 +-
lisp/gnus/nnmaildir.el | 2 +-
lisp/info.el | 21 +-
lisp/international/characters.el | 13 +-
lisp/international/fontset.el | 2 +-
lisp/international/iso-transl.el | 2 +-
lisp/international/mule-conf.el | 2 +-
lisp/international/mule.el | 2 +-
lisp/international/ucs-normalize.el | 4 +-
lisp/isearch.el | 8 +
lisp/jka-cmpr-hook.el | 3 +-
lisp/json.el | 5 +-
lisp/language/chinese.el | 2 +-
lisp/language/cyrillic.el | 2 +-
lisp/language/english.el | 2 +-
lisp/language/ethiopic.el | 2 +-
lisp/language/european.el | 2 +-
lisp/language/hebrew.el | 2 +-
lisp/language/indian.el | 2 +-
lisp/language/japanese.el | 2 +-
lisp/language/korean.el | 2 +-
lisp/language/lao.el | 2 +-
lisp/language/misc-lang.el | 2 +-
lisp/language/thai.el | 2 +-
lisp/language/tibetan.el | 2 +-
lisp/mail/reporter.el | 82 ++--
lisp/mail/rmail.el | 11 +-
lisp/mb-depth.el | 10 +-
lisp/menu-bar.el | 5 +-
lisp/net/pop3.el | 2 +-
lisp/net/socks.el | 1 +
lisp/net/tramp-sh.el | 9 +-
lisp/play/dunnet.el | 29 +-
lisp/progmodes/flymake.el | 7 +-
lisp/progmodes/perl-mode.el | 29 +-
lisp/progmodes/project.el | 3 +-
lisp/progmodes/ruby-mode.el | 9 +-
lisp/progmodes/xref.el | 11 +-
lisp/rfn-eshadow.el | 2 +-
lisp/scroll-bar.el | 2 +-
lisp/startup.el | 12 +-
lisp/subr.el | 132 +++++-
lisp/tab-bar.el | 158 ++++---
lisp/term/common-win.el | 2 +-
lisp/term/tty-colors.el | 2 +-
lisp/textmodes/fill.el | 31 +-
lisp/textmodes/paragraphs.el | 63 +--
lisp/textmodes/reftex-vars.el | 11 +-
lisp/w32-fns.el | 12 +-
lisp/wid-edit.el | 1 -
lisp/widget.el | 2 +-
lisp/window.el | 61 ++-
src/buffer.c | 12 -
src/callproc.c | 31 +-
src/casefiddle.c | 13 -
src/cmds.c | 21 -
src/commands.h | 8 -
src/emacs.c | 5 -
src/keyboard.c | 8 +-
src/keyboard.h | 2 +-
src/keymap.c | 93 +---
src/keymap.h | 2 -
src/lisp.h | 11 +-
src/minibuf.c | 3 -
src/nsfns.m | 14 +-
src/nsmenu.m | 21 +-
src/nsterm.h | 1 +
src/nsterm.m | 106 +++++
src/pdumper.c | 2 +-
src/print.c | 3 +-
src/process.c | 13 +-
src/terminfo.c | 6 +-
src/window.c | 24 +-
src/window.h | 1 -
src/xdisp.c | 16 +-
src/xterm.c | 8 +-
test/Makefile.in | 6 +-
.../warn-obsolete-variable-bound.el | 7 +
test/lisp/emacs-lisp/bytecomp-tests.el | 3 +
test/lisp/emacs-lisp/cl-macs-tests.el | 23 +
test/lisp/filenotify-tests.el | 2 +-
.../gnus/mm-decode-resources/8bit-multipart.bin | 20 +
test/lisp/gnus/mm-decode-tests.el | 89 ++++
test/lisp/help-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 18 +-
.../progmodes/cperl-mode-resources/here-docs.pl | 143 ++++++
test/lisp/progmodes/cperl-mode-tests.el | 32 ++
test/lisp/progmodes/ruby-mode-tests.el | 3 +-
test/lisp/progmodes/xref-tests.el | 38 +-
test/lisp/subr-tests.el | 38 ++
.../paragraphs-resources/mark-paragraph.bin | 9 +
test/lisp/textmodes/paragraphs-tests.el | 23 +
test/lisp/wid-edit-tests.el | 21 +
test/src/keymap-tests.el | 12 +
test/src/process-tests.el | 23 +-
143 files changed, 1914 insertions(+), 1075 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index e766cb4..7ed1b6e 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -976,6 +976,10 @@ else
@echo "Maybe you used a release tarfile that lacks tests."
endif
+test/%:
+ $(MAKE) -C test $*
+
+
dist:
cd ${srcdir}; ./make-dist
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk
index c355509..22b24af 100644
--- a/admin/charsets/cp51932.awk
+++ b/admin/charsets/cp51932.awk
@@ -31,7 +31,7 @@
# already been mapped to 1 or 3.
BEGIN {
- print ";;; cp51932.el -- translation table for CP51932";
+ print ";;; cp51932.el -- translation table for CP51932 -*-
lexical-binding:t -*-";
print ";;; Automatically generated from CP932-2BYTE.map";
print "(let ((map";
printf " '(;JISEXT<->UNICODE";
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index f6a6748..ca9a317 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -38,7 +38,7 @@ BEGIN {
JISX0208_FROM2 = "/xf5/xa1";
JISX0212_FROM = "/x8f/xf3/xf3";
- print ";;; eucjp-ms.el -- translation table for eucJP-ms";
+ print ";;; eucjp-ms.el -- translation table for eucJP-ms -*-
lexical-binding:t -*-";
print ";;; Automatically generated from
/usr/share/i18n/charmaps/EUC-JP-MS.gz";
print "(let ((map";
print " '(;JISEXT<->UNICODE";
diff --git a/admin/last-chance.el b/admin/last-chance.el
index fd5b8e9..e802112 100644
--- a/admin/last-chance.el
+++ b/admin/last-chance.el
@@ -105,18 +105,14 @@ defaulting to the one at point."
"Symbol: " obarray
nil nil
one nil one)))))
- (let ((default-directory (or (vc-root-dir)
- default-directory)))
- (grep (format "%s %s"
- last-chance-grep-command
- symbol)))
- (setf (buffer-local-value 'last-chance-symbol
- (process-buffer
- (car compilation-in-progress)))
- symbol))
-
-(add-to-list 'compilation-finish-functions
- 'last-chance-cleanup)
+ (with-current-buffer
+ (let ((default-directory (or (vc-root-dir)
+ default-directory)))
+ (grep (format "%s %s"
+ last-chance-grep-command
+ symbol)))
+ (add-hook 'compilation-finish-functions #'last-chance-cleanup nil t)
+ (setq-local last-chance-symbol symbol)))
(provide 'last-chance)
diff --git a/admin/nt/dist-build/build-zips.sh
b/admin/nt/dist-build/build-zips.sh
index 809cbc6..4a9a7b5 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -20,7 +20,7 @@
function git_up {
echo [build] Making git worktree for Emacs $VERSION
- cd $HOME/emacs-build/git/emacs-$MAJOR_VERSION
+ cd $REPO_DIR/emacs-$MAJOR_VERSION
git pull
git worktree add ../$BRANCH $BRANCH
@@ -54,7 +54,7 @@ function build_zip {
if [ ! -f Makefile ] || (($CONFIG))
then
echo [build] Configuring Emacs $ARCH
- ../../../git/$BRANCH/configure \
+ $REPO_DIR/$BRANCH/configure \
--without-dbus \
--host=$HOST --without-compress-install \
$CACHE \
@@ -88,7 +88,7 @@ function build_installer {
ARCH=$1
cd $HOME/emacs-build/install/emacs-$VERSION
echo [build] Calling makensis in `pwd`
- cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi .
+ cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
makensis -v4 \
-DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
@@ -110,6 +110,10 @@ CONFIG=1
CFLAGS="-O2 -static"
INSTALL_TARGET="install-strip"
+## The location of the git repo
+REPO_DIR=$HOME/emacs-build/git/
+
+
while getopts "36gb:hnsiV:" opt; do
case $opt in
3)
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 986d299..4ecb233 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -203,7 +203,7 @@ function name2alias(name , w, w2) {
}
END {
- print ";;; charscript.el --- character script table"
+ print ";;; charscript.el --- character script table -*- lexical-binding:t
-*-"
print ";;; Automatically generated from admin/unidata/Blocks.txt"
print "(let (script-list)"
print " (dolist (elt '("
diff --git a/configure.ac b/configure.ac
index 3625c4e..815d3c9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4468,6 +4468,18 @@ TERMCAP_OBJ=tparam.o
if test $TERMINFO = yes; then
AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.])
TERMCAP_OBJ=terminfo.o
+ AC_CACHE_CHECK([whether $LIBS_TERMCAP library defines BC],
+ [emacs_cv_terminfo_defines_BC],
+ [OLD_LIBS=$LIBS
+ LIBS="$LIBS $LIBS_TERMCAP"
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern char *BC;]], [[return !*BC;]])],
+ [emacs_cv_terminfo_defines_BC=yes],
+ [emacs_cv_terminfo_defines_BC=no])
+ LIBS=$OLD_LIBS])
+ if test "$emacs_cv_terminfo_defines_BC" = yes; then
+ AC_DEFINE([TERMINFO_DEFINES_BC], 1, [Define to 1 if the
+ terminfo library defines the variables BC, PC, and UP.])
+ fi
fi
if test "X$LIBS_TERMCAP" = "X-lncurses"; then
AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.])
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 1e779ac..8e4b0eb 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -424,7 +424,7 @@ move to it and type @key{RET}, to visit the source code.
You can also
type @key{RET} while point is on any name of a function or variable
which is not underlined, to see help information for that symbol in a
help buffer, if any exists. The @code{xref-find-definitions} command,
-bound to @key{M-.}, can also be used on any identifier in a backtrace
+bound to @kbd{M-.}, can also be used on any identifier in a backtrace
(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}).
In backtraces, the tails of long lists and the ends of long strings,
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 2fd05b7..298bec5 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -545,7 +545,7 @@ brackets.
@end group
@group
(single-key-description 'C-mouse-1)
- @result{} "<C-mouse-1>"
+ @result{} "C-<mouse-1>"
@end group
@group
(single-key-description 'C-mouse-1 t)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 81139b9..f0036f0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -348,7 +348,7 @@ default, it makes the following bindings:
@item @key{RET}
@code{exit-minibuffer}
-@item @key{M-<}
+@item @kbd{M-<}
@code{minibuffer-beginning-of-buffer}
@item @kbd{C-g}
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 897b424..5cae939 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -120,9 +120,9 @@ character (i.e., an integer), @code{nil} otherwise.
@cindex string creation
The following functions create strings, either from scratch, or by
-putting strings together, or by taking them apart. (For functions that
-create strings based on searching the contents of other strings (like
-@code{string-replace} and @code{replace-regexp-in-string}), see
+putting strings together, or by taking them apart. (For functions
+that create strings based on the modified contents of other strings,
+like @code{string-replace} and @code{replace-regexp-in-string}, see
@ref{Search and Replace}.)
@defun make-string count character &optional multibyte
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index b4bd487..d27053a 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -252,7 +252,7 @@ comment and a newline or formfeed ends one.
@item Inherit standard syntax: @samp{@@}
This syntax class does not specify a particular syntax. It says to
-look in the standard syntax table to find the syntax of this
+look in the parent syntax table to find the syntax of this
character.
@item Generic comment delimiters: @samp{!}
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index b0906ac..f305d1a 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2634,6 +2634,12 @@ window and displaying the buffer in that window. It can
fail if all
windows are dedicated to other buffers (@pxref{Dedicated Windows}).
@end defun
+@defun display-buffer-use-least-recent-window buffer alist
+This function is like @code{display-buffer-use-some-window}, but will
+not reuse the current window, and will use the least recently
+switched-to window.
+@end defun
+
@defun display-buffer-in-direction buffer alist
This function tries to display @var{buffer} at a location specified by
@var{alist}. For this purpose, @var{alist} should contain a
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index b0254e0..7fd9212 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -692,14 +692,14 @@ arguments, which will be used when creating the
@code{radio-button} or
@end table
-@deffn {User Option} widget-glyph-directory
-Directory where glyphs are found.
+@deffn {User Option} widget-image-directory
+Directory where Widget should look for images.
Widget will look here for a file with the same name as specified for the
image, with either a @file{.xpm} (if supported) or @file{.xbm} extension.
@end deffn
-@deffn{User Option} widget-glyph-enable
-If non-@code{nil}, allow glyphs to appear on displays where they are supported.
+@deffn{User Option} widget-image-enable
+If non-@code{nil}, allow images to appear on displays where they are supported.
@end deffn
diff --git a/etc/NEWS b/etc/NEWS
index b294ff1..eaaf9bf 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -212,6 +212,19 @@ This makes debugging Emacs Lisp scripts run in batch mode
easier. To
get back the old behavior, set the new variable
'backtrace-on-error-noninteractive' to a nil value.
+** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input.
+This is another attempt to solve the problem of handling high key repeat rate
+and other "slow scrolling" situations. It is hoped it behaves better
+than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'.
+It is not enabled by default.
+
++++
+** Modifiers now go outside angle brackets in pretty-printed key bindings.
+For example, <return> with Control and Meta modifiers is now shown as
+C-M-<return> instead of <C-M-return>. Either variant can be used as
+input; functions such as 'kbd' and 'read-kbd-macro' accept both styles
+as equivalent (they have done so for a long time).
+
* Editing Changes in Emacs 28.1
@@ -360,6 +373,15 @@ disabled entirely.
** Windows
++++
+*** New 'display-buffer' function 'display-buffer-use-least-recent-window'
+This is like 'display-buffer-use-some-window', but won't reuse the
+current window, and when called repeatedly will try not to reuse a
+previously selected window.
+
+*** New function 'window-bump-use-time'.
+This updates the use time of a window.
+
*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
It's bound to the command 'same-window-prefix' that requests the buffer
of the next command to be displayed in the same window.
@@ -383,11 +405,20 @@ of the next command to be displayed in a new tab.
+++
*** New command 'C-x t C-r' to open file read-only in other tab.
+---
*** The tab bar is frame-local when 'tab-bar-show' is a number.
Show/hide the tab bar independently for each frame, according to the
value of 'tab-bar-show'.
---
+*** New command 'toggle-frame-tab-bar'.
+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 user option 'tab-bar-tab-name-format-function'.
+
+---
*** The tabs in the tab line can now be scrolled using horizontal scroll.
If your mouse or trackpad supports it, you can now scroll tabs when
the mouse pointer is in the tab line by scrolling left or right.
@@ -1828,6 +1859,9 @@ also keep the type information of their arguments. Use the
** CPerl Mode
---
+*** New face 'perl-heredoc', used for heredoc elements.
+
+---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
Conway's book "Perl Best Practices" for indentation and formatting
@@ -2019,6 +2053,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
'wisent-lex-make-token-table'.
+** The 'when' argument of `make-obsolete` and related functions is mandatory.
+The use of those functions without a 'when' argument was marked
+obsolete back in Emacs-23.1. The affected functions are:
+make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
+define-obsolete-variable-alias.
+
* Lisp Changes in Emacs 28.1
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 52908d9..6c9ceb0 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -2237,8 +2237,6 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
;; not the GNU nor the BSD extensions. As it turns out, this is sufficient
;; for .deb packages.
-(autoload 'tar-grind-file-mode "tar-mode")
-
(defconst archive-ar-file-header-re
"\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([
0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
diff --git a/lisp/bindings.el b/lisp/bindings.el
index b68d55e..187444a 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1,4 +1,4 @@
-;;; bindings.el --- define standard key bindings and some variables
+;;; bindings.el --- define standard key bindings and some variables -*-
lexical-binding: t; -*-
;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software
;; Foundation, Inc.
@@ -856,7 +856,7 @@ in contrast with \\[forward-char] and \\[backward-char],
which
see."
(interactive "^p")
(if visual-order-cursor-movement
- (dotimes (i (if (numberp n) (abs n) 1))
+ (dotimes (_ (if (numberp n) (abs n) 1))
(move-point-visually (if (and (numberp n) (< n 0)) -1 1)))
(if (eq (current-bidi-paragraph-direction) 'left-to-right)
(forward-char n)
@@ -874,7 +874,7 @@ in contrast with \\[forward-char] and \\[backward-char],
which
see."
(interactive "^p")
(if visual-order-cursor-movement
- (dotimes (i (if (numberp n) (abs n) 1))
+ (dotimes (_ (if (numberp n) (abs n) 1))
(move-point-visually (if (and (numberp n) (< n 0)) 1 -1)))
(if (eq (current-bidi-paragraph-direction) 'left-to-right)
(backward-char n)
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index a113572..ea79bfa 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -396,7 +396,7 @@
(calc-wrapper
(setq str (math-showing-full-precision
(math-format-nice-expr (aref info 8) (frame-width))))
- (calc-edit-mode (list 'calc-embedded-finish-edit info))
+ (calc--edit-mode (lambda () (calc-embedded-finish-edit info)))
(insert str "\n")))
(calc-show-edit-buffer)))
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 7c319c4..f4ddb84 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1195,7 +1195,7 @@ calc-set-xor calc-sort calc-subvector calc-tail
calc-transpose
calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
-calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
+calc-copy-to-buffer calc-edit calc-edit-cancel calc--edit-mode
calc-kill calc-kill-region calc-yank))))
(defun calc-init-prefixes ()
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 6ac554e..3097b09 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -483,13 +483,13 @@
(interactive)
(calc-wrapper
(let ((lang calc-language))
- (calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang))
- t
- (format "Editing %s-Mode Syntax Table. "
- (cond ((null lang) "Normal")
- ((eq lang 'tex) "TeX")
- ((eq lang 'latex) "LaTeX")
- (t (capitalize (symbol-name lang))))))
+ (calc--edit-mode (lambda () (calc-finish-user-syntax-edit lang))
+ t
+ (format "Editing %s-Mode Syntax Table. "
+ (cond ((null lang) "Normal")
+ ((eq lang 'tex) "TeX")
+ ((eq lang 'latex) "LaTeX")
+ (t (capitalize (symbol-name lang))))))
(calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
lang)))
(calc-show-edit-buffer))
@@ -696,12 +696,13 @@
(setq cmd (symbol-function cmd)))
(cond ((or (stringp cmd)
(and (consp cmd)
- (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
+ (eq (car-safe (nth 3 cmd)) #'calc-execute-kbd-macro)))
+ ;; FIXME: Won't (nth 3 cmd) fail when (stringp cmd)?
(let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
(str (edmacro-format-keys mac t))
(kys (nth 3 (nth 3 cmd))))
- (calc-edit-mode
- (list 'calc-edit-macro-finish-edit cmdname kys)
+ (calc--edit-mode
+ (lambda () (calc-edit-macro-finish-edit cmdname kys))
t (format (concat
"Editing keyboard macro (%s, bound to %s).\n"
"Original keys: %s \n")
@@ -719,8 +720,8 @@
(if (and defn (calc-valid-formula-func func))
(let ((niceexpr (math-format-nice-expr defn (frame-width))))
(calc-wrapper
- (calc-edit-mode
- (list 'calc-finish-formula-edit (list 'quote func))
+ (calc--edit-mode
+ (lambda () (calc-finish-formula-edit func))
nil
(format (concat
"Editing formula (%s, %s, bound to %s).\n"
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index e6c6337..2b317ac 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -675,12 +675,12 @@
(entry (calc-top num 'entry))
(expr (car entry))
(sel (or (calc-auto-selection entry) expr))
- ) ;; alg
- (let ((str (math-showing-full-precision
- (math-format-nice-expr sel (frame-width)))))
- (calc-edit-mode (list 'calc-finish-selection-edit
- num (list 'quote sel) calc-sel-reselect))
- (insert str "\n"))))
+ ;; alg
+ (str (math-showing-full-precision
+ (math-format-nice-expr sel (frame-width))))
+ (csr calc-sel-reselect))
+ (calc--edit-mode (lambda () (calc-finish-selection-edit num sel csr)))
+ (insert str "\n")))
(calc-show-edit-buffer))
(defvar calc-original-buffer)
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index a5e9012..ee29c44 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -437,10 +437,10 @@
(if (eq (car-safe value) 'special-const)
(error "%s is a special constant" var))
(setq calc-last-edited-variable var)
- (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
- t
- (format-message
- "Editing variable `%s'" (calc-var-name var)))
+ (calc--edit-mode (lambda () (calc-finish-stack-edit var))
+ t
+ (format-message
+ "Editing variable `%s'" (calc-var-name var)))
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index 8267340..e5f0523 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -651,14 +651,14 @@ Interactively, reads the register using
`register-read-with-preview'."
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))
- (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret)
+ (calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n)))
allow-ret)
(while list
(insert (car list) "\n")
(setq list (cdr list)))))
(calc-show-edit-buffer))
(defun calc-alg-edit (str)
- (calc-edit-mode '(calc-finish-stack-edit 0))
+ (calc--edit-mode (lambda () (calc-finish-stack-edit 0)))
(calc-show-edit-buffer)
(insert str "\n")
(backward-char 1)
@@ -666,54 +666,47 @@ Interactively, reads the register using
`register-read-with-preview'."
(defvar calc-edit-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\n" 'calc-edit-finish)
- (define-key map "\r" 'calc-edit-return)
- (define-key map "\C-c\C-c" 'calc-edit-finish)
+ (define-key map "\n" #'calc-edit-finish)
+ (define-key map "\r" #'calc-edit-return)
+ (define-key map "\C-c\C-c" #'calc-edit-finish)
map)
- "Keymap for use by the calc-edit command.")
+ "Keymap for use by the `calc-edit' command.")
-(defvar calc-original-buffer)
-(defvar calc-return-buffer)
-(defvar calc-one-window)
-(defvar calc-edit-handler)
-(defvar calc-restore-trail)
-(defvar calc-allow-ret)
-(defvar calc-edit-top)
+(defvar calc-original-buffer nil)
+(defvar calc-return-buffer nil)
+(defvar calc-one-window nil)
+(defvar calc-edit-handler nil)
+(defvar calc-restore-trail nil)
+(defvar calc-allow-ret nil)
+(defvar calc-edit-top nil)
-(defun calc-edit-mode (&optional handler allow-ret title)
+(put 'calc-edit-mode 'mode-class 'special)
+(define-derived-mode calc-edit-mode nil "Calc Edit"
"Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
To cancel the edit, simply kill the *Calc Edit* buffer."
- (interactive)
+ (setq-local buffer-read-only nil)
+ (setq-local truncate-lines nil))
+
+(defun calc--edit-mode (handler &optional allow-ret title)
(unless handler
(error "This command can be used only indirectly through calc-edit"))
(let ((oldbuf (current-buffer))
(buf (get-buffer-create "*Calc Edit*")))
(set-buffer buf)
- (kill-all-local-variables)
- (use-local-map calc-edit-mode-map)
- (setq buffer-read-only nil)
- (setq truncate-lines nil)
- (setq major-mode 'calc-edit-mode)
- (setq mode-name "Calc Edit")
- (run-mode-hooks 'calc-edit-mode-hook)
- (make-local-variable 'calc-original-buffer)
- (setq calc-original-buffer oldbuf)
- (make-local-variable 'calc-return-buffer)
- (setq calc-return-buffer oldbuf)
- (make-local-variable 'calc-one-window)
- (setq calc-one-window (and (one-window-p t) pop-up-windows))
- (make-local-variable 'calc-edit-handler)
- (setq calc-edit-handler handler)
- (make-local-variable 'calc-restore-trail)
- (setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
- (make-local-variable 'calc-allow-ret)
- (setq calc-allow-ret allow-ret)
+ (calc-edit-mode)
+ (setq-local calc-original-buffer oldbuf)
+ (setq-local calc-return-buffer oldbuf)
+ (setq-local calc-one-window (and (one-window-p t) pop-up-windows))
+ (setq-local calc-edit-handler handler)
+ (setq-local calc-restore-trail (get-buffer-window (calc-trail-buffer)))
+ (setq-local calc-allow-ret allow-ret)
(let ((inhibit-read-only t))
(erase-buffer))
(add-hook 'kill-buffer-hook (lambda ()
(let ((calc-edit-handler nil))
(calc-edit-finish t))
- (message "(Canceled)")) t t)
+ (message "(Canceled)"))
+ t t)
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
@@ -721,9 +714,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(if allow-ret "" " or RET")
(format-message " to finish, `C-x k RET' to cancel.\n\n"))
'font-lock-face 'italic 'read-only t 'rear-nonsticky t
'front-sticky t))
- (make-local-variable 'calc-edit-top)
- (setq calc-edit-top (point))))
-(put 'calc-edit-mode 'mode-class 'special)
+ (setq-local calc-edit-top (point))))
(defun calc-show-edit-buffer ()
(let ((buf (current-buffer)))
@@ -743,24 +734,19 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(defun calc-edit-return ()
(interactive)
- (if (and (boundp 'calc-allow-ret) calc-allow-ret)
+ (if calc-allow-ret
(newline)
(calc-edit-finish)))
-;; The variable calc-edit-disp-trail is local to calc-edit finish, but
-;; is used by calc-finish-selection-edit and calc-finish-stack-edit.
+;; The variable `calc-edit-disp-trail' is local to `calc-edit-finish', but
+;; is used by `calc-finish-selection-edit' and `calc-finish-stack-edit'.
(defvar calc-edit-disp-trail)
(defun calc-edit-finish (&optional keep)
- "Finish calc-edit mode. Parse buffer contents and push them on the stack."
+ "Finish `calc-edit' mode. Parse buffer contents and push them on the stack."
(interactive "P")
(message "Working...")
- (or (and (boundp 'calc-original-buffer)
- (boundp 'calc-return-buffer)
- (boundp 'calc-one-window)
- (boundp 'calc-edit-handler)
- (boundp 'calc-restore-trail)
- (eq major-mode 'calc-edit-mode))
+ (or (derived-mode-p 'calc-edit-mode)
(error "This command is valid only in buffers created by calc-edit"))
(let ((buf (current-buffer))
(original calc-original-buffer)
@@ -775,7 +761,11 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(error "Original calculator buffer has been corrupted")))
(goto-char calc-edit-top)
(if (buffer-modified-p)
- (eval calc-edit-handler t))
+ (if (functionp calc-edit-handler)
+ (funcall calc-edit-handler)
+ (message "Deprecated handler expression in calc-edit-handler: %S"
+ calc-edit-handler)
+ (eval calc-edit-handler t)))
(if (and one-window (not (one-window-p t)))
(delete-window))
(if (get-buffer-window return)
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 29bcd6d..281b89e 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -700,7 +700,7 @@ ARG is positive, otherwise off."
(let ((appt-active appt-timer))
(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
(not appt-active)))
- (remove-hook 'write-file-functions #'appt-update-list)
+ (remove-hook 'write-file-functions #'appt-update-list 'local)
(or global-mode-string (setq global-mode-string '("")))
(delq 'appt-mode-string global-mode-string)
(when appt-timer
@@ -708,7 +708,7 @@ ARG is positive, otherwise off."
(setq appt-timer nil))
(if appt-active
(progn
- (add-hook 'write-file-functions #'appt-update-list)
+ (add-hook 'write-file-functions #'appt-update-list nil t)
(setq appt-timer (run-at-time t 60 #'appt-check)
global-mode-string
(append global-mode-string '(appt-mode-string)))
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index 5f9a3fa..9f0ac38 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -168,7 +168,8 @@ This shell should support pipe redirect syntax."
(erase-buffer)
(setq default-directory rootdir)
(let ((cmd (semantic-symref-grep-use-template
- (file-local-name rootdir) filepattern grepflags greppat)))
+ (file-name-as-directory (file-local-name rootdir))
+ filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)))
(setq ans (semantic-symref-parse-tool-output tool b))
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 21ed1f9..101246c 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -1,4 +1,4 @@
-;;; srecode/semantic.el --- Semantic specific extensions to SRecode.
+;;; srecode/semantic.el --- Semantic specific extensions to SRecode -*-
lexical-binding:t -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -57,7 +57,7 @@ This class will be used to derive dictionary values.")
(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function
- dictionary)
+ _dictionary)
"Convert the compound dictionary value CP to a string.
If FUNCTION is non-nil, then FUNCTION is somehow applied to an
aspect of the compound value."
@@ -410,7 +410,9 @@ as `function' will leave point where code might be
inserted."
;; Insert the template.
(let ((endpt (srecode-insert-fcn temp dict nil t)))
- (run-hook-with-args 'point-insert-fcn tag)
+ (if (functionp point-insert-fcn)
+ (funcall point-insert-fcn tag)
+ (dolist (f point-insert-fcn) (funcall f tag)))
;;(sit-for 1)
(cond
diff --git a/lisp/composite.el b/lisp/composite.el
index 7337605..6f654df 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,4 +1,4 @@
-;;; composite.el --- support character composition
+;;; composite.el --- support character composition -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -593,7 +593,6 @@ All non-spacing characters have this function in
(as (lglyph-ascent glyph))
(de (lglyph-descent glyph))
(ce (/ (+ lb rb) 2))
- (w (lglyph-width glyph))
xoff yoff)
(cond
((and class (>= class 200) (<= class 240))
@@ -653,7 +652,8 @@ All non-spacing characters have this function in
((and (= class 0)
(eq (get-char-code-property (lglyph-char glyph)
;; Me = enclosing mark
- 'general-category) 'Me))
+ 'general-category)
+ 'Me))
;; Artificially laying out glyphs in an enclosing
;; mark is difficult. All we can do is to adjust
;; the x-offset and width of the base glyph to
@@ -695,9 +695,7 @@ All non-spacing characters have this function in
(defun compose-gstring-for-dotted-circle (gstring direction)
(let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
- (dc-id (lglyph-code dc))
(fc (lgstring-glyph gstring 1)) ; glyph of the following char
- (fc-id (lglyph-code fc))
(gstr (and nil (font-shape-gstring gstring direction))))
(if (and gstr
(or (= (lgstring-glyph-len gstr) 1)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 7d9d1fe..5dcb284 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,4 +1,4 @@
-;;; cus-face.el --- customization support for faces
+;;; cus-face.el --- customization support for faces -*- lexical-binding: t;
-*-
;;
;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
;;
diff --git a/lisp/custom.el b/lisp/custom.el
index dfa8539..d9d0898 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -161,7 +161,9 @@ set to nil, as the value is no longer rogue."
;; Whether automatically buffer-local.
buffer-local)
(unless (memq :group args)
- (custom-add-to-group (custom-current-group) symbol 'custom-variable))
+ (let ((cg (custom-current-group)))
+ (when cg
+ (custom-add-to-group cg symbol 'custom-variable))))
(while args
(let ((keyword (pop args)))
(unless (symbolp keyword)
@@ -525,7 +527,9 @@ If no such group is found, return nil."
"For customization option SYMBOL, handle keyword arguments ARGS.
Third argument TYPE is the custom option type."
(unless (memq :group args)
- (custom-add-to-group (custom-current-group) symbol type))
+ (let ((cg (custom-current-group)))
+ (when cg
+ (custom-add-to-group cg symbol type))))
(while args
(let ((arg (car args)))
(setq args (cdr args))
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 6de14b1..a7fc8f0 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -1,4 +1,4 @@
-;;; disp-table.el --- functions for dealing with char tables
+;;; disp-table.el --- functions for dealing with char tables -*-
lexical-binding: t; -*-
;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software
;; Foundation, Inc.
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 5d4aa78..255edd0 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -1,4 +1,4 @@
-;;; dos-fns.el --- MS-Dos specific functions
+;;; dos-fns.el --- MS-Dos specific functions -*- lexical-binding: t; -*-
;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software
;; Foundation, Inc.
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index e902491..cf75321 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,4 +1,4 @@
-;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
+;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*-
lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -154,13 +154,15 @@ when writing the file."
;; FIXME: Can't we use find-file-literally for the same purposes?
(interactive "FFind file binary: ")
(let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix?
- (find-file filename)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename))))
(defun find-file-text (filename)
"Visit file FILENAME and treat it as a text file."
(interactive "FFind file text: ")
(let ((coding-system-for-read 'undecided-dos))
- (find-file filename)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename))))
(defun w32-find-file-not-found-set-buffer-file-coding-system ()
(with-current-buffer (current-buffer)
@@ -261,6 +263,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
:group 'dos-fns
:group 'w32)
+(defvar w32-quote-process-args)
+
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
(defun w32-direct-print-region-helper (printer
diff --git a/lisp/electric.el b/lisp/electric.el
index 506e9aa..6701a36 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -1,4 +1,4 @@
-;;; electric.el --- window maker and Command loop for `electric' modes
+;;; electric.el --- window maker and Command loop for `electric' modes -*-
lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation,
;; Inc.
@@ -385,6 +385,8 @@ If multiple rules match, only first one is executed.")
(when electric-layout-mode
(electric-layout-post-self-insert-function-1)))
+(defvar electric-pair-open-newline-between-pairs)
+
;; for edebug's sake, a separate function
(defun electric-layout-post-self-insert-function-1 ()
(let* ((pos (electric--after-char-pos))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 1786b5c..ec7492d 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -220,16 +220,27 @@ expression, in which case we want to handle forms
differently."
;; Convert defcustom to less space-consuming data.
((eq car 'defcustom)
- (let ((varname (car-safe (cdr-safe form)))
- (init (car-safe (cdr-safe (cdr-safe form))))
- (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
- ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
- )
+ (let* ((varname (car-safe (cdr-safe form)))
+ (props (nthcdr 4 form))
+ (initializer (plist-get props :initialize))
+ (init (car-safe (cdr-safe (cdr-safe form))))
+ (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ )
`(progn
- (defvar ,varname ,init ,doc)
+ ,(if (not (member initializer '(nil 'custom-initialize-default
+ #'custom-initialize-default
+ 'custom-initialize-reset
+ #'custom-initialize-reset)))
+ form
+ `(defvar ,varname ,init ,doc))
+ ;; When we include the complete `form', this `custom-autoload'
+ ;; is not indispensable, but it still helps in case the `defcustom'
+ ;; doesn't specify its group explicitly, and probably in a few other
+ ;; corner cases.
(custom-autoload ',varname ,file
,(condition-case nil
- (null (cadr (memq :set form)))
+ (null (plist-get props :set))
(error nil))))))
((eq car 'defgroup)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 8334c09..0f8dd5a 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -372,7 +372,7 @@ convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
-(defun make-obsolete (obsolete-name current-name &optional when)
+(defun make-obsolete (obsolete-name current-name when)
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
OBSOLETE-NAME should be a function name or macro name (a symbol).
@@ -381,17 +381,14 @@ If CURRENT-NAME is a string, that is the `use instead'
message
\(it should end with a period, and not start with a capital).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
- (declare (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when) "23.1"))
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
-(defmacro define-obsolete-function-alias (obsolete-name current-name
- &optional when docstring)
+(defmacro define-obsolete-function-alias ( obsolete-name current-name when
+ &optional docstring)
"Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it
obsolete.
\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's
doc.\")
@@ -405,15 +402,13 @@ WHEN should be a string indicating when the function was
first
made obsolete, for example a date or a release number.
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4)
- (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when &optional docstring) "23.1"))
+ (declare (doc-string 4))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
-(defun make-obsolete-variable (obsolete-name current-name &optional when
access-type)
+(defun make-obsolete-variable ( obsolete-name current-name when
+ &optional access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
@@ -421,16 +416,13 @@ WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
- (declare (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
-(defmacro define-obsolete-variable-alias (obsolete-name current-name
- &optional when docstring)
+(defmacro define-obsolete-variable-alias ( obsolete-name current-name when
+ &optional docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
WHEN should be a string indicating when the variable was first
@@ -459,10 +451,7 @@ For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
`saved-value', `saved-variable-comment'."
- (declare (doc-string 4)
- (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when &optional docstring) "23.1"))
+ (declare (doc-string 4))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7645781..360da6b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3441,10 +3441,11 @@ for symbols generated by the byte compiler itself."
(and od
(not (memq var byte-compile-not-obsolete-vars))
(not (memq var byte-compile-global-not-obsolete-vars))
- (or (pcase (nth 1 od)
- ('set (not (eq access-type 'reference)))
- ('get (eq access-type 'reference))
- (_ t)))))
+ (not (memq var byte-compile-lexical-variables))
+ (pcase (nth 1 od)
+ ('set (not (eq access-type 'reference)))
+ ('get (eq access-type 'reference))
+ (_ t))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 19dd54c..8e36dbe 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY."
(lambda ,args ,@body))))
(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
- (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
- "Check which of the symbols VARS appear in SEXP."
- (let ((res '()))
- (while (consp sexp)
- (dolist (var (cl--generic-fgrep vars (pop sexp)))
- (unless (memq var res) (push var res))))
- (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
- res))
-
(defun cl--generic-split-args (args)
"Return (SPEC-ARGS . PLAIN-ARGS)."
(let ((plain-args ())
@@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY."
;; is used.
;; FIXME: Also, optimize the case where call-next-method is
;; only called with explicit arguments.
- (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
+ (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
(cons (not (not uses-cnm))
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
,@(car parsed-body)
- ,(if (not (memq nmp uses-cnm))
+ ,(if (not (assq nmp uses-cnm))
nbody
`(let ((,nmp (lambda ()
(cl--generic-isnot-nnm-p ,cnm))))
@@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called
\"specializers\") is defined
(lambda (,@fixedargs &rest args)
(let ,bindings
(apply (cl--generic-with-memoization
- (gethash ,tag-exp method-cache)
- (cl--generic-cache-miss
- generic ',dispatch-arg dispatches-left methods
- ,(if (cdr typescodes)
- `(append ,@typescodes) (car typescodes))))
+ (gethash ,tag-exp method-cache)
+ (cl--generic-cache-miss
+ generic ',dispatch-arg dispatches-left methods
+ ,(if (cdr typescodes)
+ `(append ,@typescodes) (car typescodes))))
,@fixedargs args)))))))))
(defun cl--generic-make-function (generic)
@@ -1110,7 +1101,8 @@ These match if the argument is a cons cell whose car is
`eql' to VAL."
(if (not (eq (car-safe specializer) 'head))
(cl-call-next-method)
(cl--generic-with-memoization
- (gethash (cadr specializer) cl--generic-head-used) specializer)
+ (gethash (cadr specializer) cl--generic-head-used)
+ specializer)
(list cl--generic-head-generalizer)))
(cl--generic-prefill-dispatchers 0 (head eql))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 1cb195d..c2bf02c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2060,10 +2060,99 @@ Like `cl-flet' but the definitions can refer to
previous ones.
((null (cdr bindings)) `(cl-flet ,bindings ,@body))
(t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
+(defun cl--self-tco (var fargs body)
+ ;; This tries to "optimize" tail calls for the specific case
+ ;; of recursive self-calls by replacing them with a `while' loop.
+ ;; It is quite far from a general tail-call optimization, since it doesn't
+ ;; even handle mutually recursive functions.
+ (letrec
+ ((done nil) ;; Non-nil if some TCO happened.
+ (retvar (make-symbol "retval"))
+ (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
+ (make-symbol (symbol-name s))))
+ fargs))
+ (opt-exps (lambda (exps) ;; `exps' is in tail position!
+ (append (butlast exps)
+ (list (funcall opt (car (last exps)))))))
+ (opt
+ (lambda (exp) ;; `exp' is in tail position!
+ (pcase exp
+ ;; FIXME: Optimize `apply'?
+ (`(funcall ,(pred (eq var)) . ,aargs)
+ ;; This is a self-recursive call in tail position.
+ (let ((sets nil)
+ (fargs ofargs))
+ (while fargs
+ (pcase (pop fargs)
+ ('&rest
+ (push (pop fargs) sets)
+ (push `(list . ,aargs) sets)
+ ;; (cl-assert (null fargs))
+ )
+ ('&optional nil)
+ (farg
+ (push farg sets)
+ (push (pop aargs) sets))))
+ (setq done t)
+ `(progn (setq . ,(nreverse sets))
+ :recurse)))
+ (`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
+ (`(if ,cond ,then . ,else)
+ `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
+ (`(cond . ,conds)
+ (let ((cs '()))
+ (while conds
+ (pcase (pop conds)
+ (`(,exp)
+ (push (if conds
+ ;; This returns the value of `exp' but it's
+ ;; only in tail position if it's the
+ ;; last condition.
+ `((setq ,retvar ,exp) nil)
+ `(,(funcall opt exp)))
+ cs))
+ (exps
+ (push (funcall opt-exps exps) cs))))
+ (if (eq t (caar cs))
+ `(cond . ,(nreverse cs))
+ `(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
+ ((and `(,(or 'let 'let*) ,bindings . ,exps)
+ (guard
+ ;; Note: it's OK for this `let' to shadow any
+ ;; of the formal arguments since we will only
+ ;; setq the fresh new `ofargs' vars instead ;-)
+ (let ((shadowings
+ (mapcar (lambda (b) (if (consp b) (car b) b))
bindings)))
+ ;; If `var' is shadowed, then it clearly can't be
+ ;; tail-called any more.
+ (not (memq var shadowings)))))
+ `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
+ (_
+ `(progn (setq ,retvar ,exp) nil))))))
+
+ (let ((optimized-body (funcall opt-exps body)))
+ (if (not done)
+ (cons fargs body)
+ ;; We use two sets of vars: `ofargs' and `fargs' because we need
+ ;; to be careful that if a closure captures a formal argument
+ ;; in one iteration, it needs to capture a different binding
+ ;; then that of other iterations, e.g.
+ (cons
+ ofargs
+ `((let (,retvar)
+ (while (let ,(delq nil
+ (cl-mapcar
+ (lambda (a oa)
+ (unless (memq a cl--lambda-list-keywords)
+ (list a oa)))
+ fargs ofargs))
+ . ,optimized-body))
+ ,retvar)))))))
+
;;;###autoload
(defmacro cl-labels (bindings &rest body)
- "Make local (recursive) function definitions.
-Each definition can take the form (FUNC ARGLIST BODY...) where
+ "Make local (recursive) function definitions.
++BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
@@ -2075,17 +2164,33 @@ details.
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)
(let ((var (make-symbol (format "--cl-%s--" (car binding)))))
- (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons var (cdr binding)) binds)
(push (cons (car binding)
(lambda (&rest args)
(if (eq (car args) cl--labels-magic)
(list cl--labels-magic var)
(cl-list* 'funcall var args))))
newenv)))
- (macroexpand-all `(letrec ,(nreverse binds) ,@body)
- ;; Don't override lexical-let's macro-expander.
- (if (assq 'function newenv) newenv
- (cons (cons 'function #'cl--labels-convert) newenv)))))
+ ;; Don't override lexical-let's macro-expander.
+ (unless (assq 'function newenv)
+ (push (cons 'function #'cl--labels-convert) newenv))
+ ;; Perform self-tail call elimination.
+ (setq binds (mapcar
+ (lambda (bind)
+ (pcase-let*
+ ((`(,var ,sargs . ,sbody) bind)
+ (`(function (lambda ,fargs . ,ebody))
+ (macroexpand-all `(cl-function (lambda ,sargs .
,sbody))
+ newenv))
+ (`(,ofargs . ,obody)
+ (cl--self-tco var fargs ebody)))
+ `(,var (function (lambda ,ofargs . ,obody)))))
+ (nreverse binds)))
+ `(letrec ,binds
+ . ,(macroexp-unprogn
+ (macroexpand-all
+ (macroexp-progn body)
+ newenv)))))
;; The following ought to have a better definition for use with newer
;; byte compilers.
@@ -3383,8 +3488,8 @@ macro that returns its `&whole' argument."
(put y 'side-effect-free t))
;;; Things that are inline.
-(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany
- cl-notevery cl-revappend cl-nreconc gethash))
+(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend
+ cl-nreconc gethash))
;;; Things that are side-effect-free.
(mapc (lambda (x) (function-put x 'side-effect-free t))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 3e5e9b9..a8361c0 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -215,7 +215,8 @@ It creates an autoload function for CNAME's constructor."
;; turn this into a usable self-pointing symbol
(when eieio-backward-compatibility
(set cname cname)
- (make-obsolete-variable cname (format "use \\='%s instead" cname)
+ (make-obsolete-variable cname (format "\
+use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
(setf (cl--find-class cname) newc)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 82a8cd2..3784497 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -480,6 +480,35 @@ itself or not."
v
(list 'quote v)))
+(defun macroexp--fgrep (bindings sexp)
+ "Return those of the BINDINGS which might be used in SEXP.
+It is used as a poor-man's \"free variables\" test. It differs from a true
+test of free variables in the following ways:
+- It does not distinguish variables from functions, so it can be used
+ both to detect whether a given variable is used by SEXP and to
+ detect whether a given function is used by SEXP.
+- It does not actually know ELisp syntax, so it only looks for the presence
+ of symbols in SEXP and can't distinguish if those symbols are truly
+ references to the given variable (or function). That can make the result
+ include bindings which actually aren't used.
+- For the same reason it may cause the result to fail to include bindings
+ which will be used if SEXP is not yet fully macro-expanded and the
+ use of the binding will only be revealed by macro expansion."
+ (let ((res '()))
+ (while (and (consp sexp) bindings)
+ (dolist (binding (macroexp--fgrep bindings (pop sexp)))
+ (push binding res)
+ (setq bindings (remove binding bindings))))
+ (if (or (vectorp sexp) (byte-code-function-p sexp))
+ ;; With backquote, code can appear within vectors as well.
+ ;; This wouldn't be needed if we `macroexpand-all' before
+ ;; calling macroexp--fgrep, OTOH.
+ (macroexp--fgrep bindings (mapcar #'identity sexp))
+ (let ((tmp (assq sexp bindings)))
+ (if tmp
+ (cons tmp res)
+ res)))))
+
;;; Load-time macro-expansion.
;; Because macro-expansion used to be more lazy, eager macro-expansion
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 40ba135..453e86c 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -173,12 +173,12 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
-call (package-initialize) in your init-file."
+call (package-activate-all) in your init-file."
:type 'boolean
:version "24.1")
(defcustom package-load-list '(all)
- "List of packages for `package-initialize' to make available.
+ "List of packages for `package-activate-all' to make available.
Each element in this list should be a list (NAME VERSION), or the
symbol `all'. The symbol `all' says to make available the latest
installed versions of all packages not specified by other
@@ -292,15 +292,18 @@ the package will be unavailable."
:risky t
:version "24.4")
+;;;###autoload
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
+ :initialize #'custom-initialize-delay
:risky t
:version "24.1")
+;;;###autoload
(defcustom package-directory-list
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
(let (result)
@@ -315,6 +318,7 @@ Each directory name should be absolute.
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
+ :initialize #'custom-initialize-delay
:risky t
:version "24.1")
@@ -587,9 +591,8 @@ package."
;;; Installed packages
;; The following variables store information about packages present in
;; the system. The most important of these is `package-alist'. The
-;; command `package-initialize' is also closely related to this
-;; section, but it is left for a later section because it also affects
-;; other stuff.
+;; command `package-activate-all' is also closely related to this
+;; section.
(defvar package--builtins nil
"Alist of built-in packages.
@@ -608,7 +611,7 @@ name (a symbol) and DESCS is a non-empty list of
`package-desc'
structures, sorted by decreasing versions.
This variable is set automatically by `package-load-descriptor',
-called via `package-initialize'. To change which packages are
+called via `package-activate-all'. To change which packages are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
@@ -869,6 +872,20 @@ DIR, sorted by most recently loaded last."
(lambda (x y) (< (cdr x) (cdr y))))))))
;;;; `package-activate'
+
+(defun package--get-activatable-pkg (pkg-name)
+ ;; Is "activatable" a word?
+ (let ((pkg-descs (cdr (assq pkg-name package-alist))))
+ ;; Check if PACKAGE is available in `package-alist'.
+ (while
+ (when pkg-descs
+ (let ((available-version (package-desc-version (car pkg-descs))))
+ (or (package-disabled-p pkg-name available-version)
+ ;; Prefer a builtin package.
+ (package-built-in-p pkg-name available-version))))
+ (setq pkg-descs (cdr pkg-descs)))
+ (car pkg-descs)))
+
;; This function activates a newer version of a package if an older
;; one was already activated. It also loads a features of this
;; package which were already loaded.
@@ -876,24 +893,16 @@ DIR, sorted by most recently loaded last."
"Activate the package named PACKAGE.
If FORCE is true, (re-)activate it if it's already activated.
Newer versions are always activated, regardless of FORCE."
- (let ((pkg-descs (cdr (assq package package-alist))))
- ;; Check if PACKAGE is available in `package-alist'.
- (while
- (when pkg-descs
- (let ((available-version (package-desc-version (car pkg-descs))))
- (or (package-disabled-p package available-version)
- ;; Prefer a builtin package.
- (package-built-in-p package available-version))))
- (setq pkg-descs (cdr pkg-descs)))
+ (let ((pkg-desc (package--get-activatable-pkg package)))
(cond
;; If no such package is found, maybe it's built-in.
- ((null pkg-descs)
+ ((null pkg-desc)
(package-built-in-p package))
;; If the package is already activated, just return t.
((and (memq package package-activated-list) (not force))
t)
;; Otherwise, proceed with activation.
- (t (package-activate-1 (car pkg-descs) nil 'deps)))))
+ (t (package-activate-1 pkg-desc nil 'deps)))))
;;; Installation -- Local operations
@@ -1616,9 +1625,8 @@ that code in the early init-file."
;; `package--initialized' is t.
(package--build-compatibility-table))
-(defvar package-quickstart-file)
-
;;;###autoload
+(progn ;; Make the function usable without loading `package.el'.
(defun package-activate-all ()
"Activate all installed packages.
The variable `package-load-list' controls which packages to load."
@@ -1632,13 +1640,19 @@ The variable `package-load-list' controls which
packages to load."
;; 2 when loading the .el file (this assumes we were careful to
;; save this file so it doesn't need any decoding).
(let ((load-source-file-function nil))
+ (unless (boundp 'package-activated-list)
+ (setq package-activated-list nil))
(load qs nil 'nomessage))
- (dolist (elt (package--alist))
- (condition-case err
- (package-activate (car elt))
- ;; Don't let failure of activation of a package arbitrarily stop
- ;; activation of further packages.
- (error (message "%s" (error-message-string err))))))))
+ (require 'package)
+ (package--activate-all)))))
+
+(defun package--activate-all ()
+ (dolist (elt (package--alist))
+ (condition-case err
+ (package-activate (car elt))
+ ;; Don't let failure of activation of a package arbitrarily stop
+ ;; activation of further packages.
+ (error (message "%s" (error-message-string err))))))
;;;; Populating `package-archive-contents' from archives
;; This subsection populates the variables listed above from the
@@ -2066,6 +2080,13 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'."
(mapc #'package-install-from-archive packages))
+(defun package--archives-initialize ()
+ "Make sure the list of installed and remote packages are initialized."
+ (unless package--initialized
+ (package-initialize t))
+ (unless package-archive-contents
+ (package-refresh-contents)))
+
;;;###autoload
(defun package-install (pkg &optional dont-select)
"Install the package PKG.
@@ -2086,10 +2107,7 @@ to install it but still mark it as selected."
(progn
;; Initialize the package system to get the list of package
;; symbols for completion.
- (unless package--initialized
- (package-initialize t))
- (unless package-archive-contents
- (package-refresh-contents))
+ (package--archives-initialize)
(list (intern (completing-read
"Install package: "
(delq nil
@@ -2099,6 +2117,7 @@ to install it but still mark it as selected."
package-archive-contents))
nil t))
nil)))
+ (package--archives-initialize)
(add-hook 'post-command-hook #'package-menu--post-refresh)
(let ((name (if (package-desc-p pkg)
(package-desc-name pkg)
@@ -3714,7 +3733,7 @@ short description."
(package-menu--generate nil t)))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf)))
+ (pop-to-buffer-same-window buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
@@ -4042,10 +4061,12 @@ activations need to be changed, such as when
`package-load-list' is modified."
:type 'boolean
:version "27.1")
+;;;###autoload
(defcustom package-quickstart-file
(locate-user-emacs-file "package-quickstart.el")
"Location of the file used to speed up activation of packages at startup."
:type 'file
+ :initialize #'custom-initialize-delay
:version "27.1")
(defun package--quickstart-maybe-refresh ()
@@ -4111,6 +4132,8 @@ activations need to be changed, such as when
`package-load-list' is modified."
;; no-update-autoloads: t
;; End:
"))
+ ;; FIXME: Do it asynchronously in an Emacs subprocess, and
+ ;; don't show the byte-compiler warnings.
(byte-compile-file package-quickstart-file)))
(defun package--imenu-prev-index-position-function ()
@@ -4131,6 +4154,15 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
+;;;; Introspection
+
+(defun package-get-descriptor (pkg-name)
+ "Return the `package-desc' of PKG-NAME."
+ (unless package--initialized (package-initialize 'no-activate))
+ (or (package--get-activatable-pkg pkg-name)
+ (cadr (assq pkg-name package-alist))
+ (cadr (assq pkg-name package-archive-contents))))
+
(provide 'package)
;;; package.el ends here
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 8fb79d2..72ea1ba 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,7 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
- (let ((vars (pcase--fgrep vars code))
+ (let ((vars (macroexp--fgrep vars code))
(prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
@@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'.
;; occurrences of this leaf since it's small.
(lambda (code vars)
(pcase-codegen code
- (pcase--fgrep vars code)))
+ (macroexp--fgrep vars code)))
codegen)
(cdr case)
vars))))
@@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form:
;; run, but we don't have the environment in which `pat' will
;; run, so we can't do a reliable verification. But let's try
;; and catch at least the easy cases such as (bug#14773).
- (not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
+ (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
((and (eq 'pred (car upat))
(let ((otherpred
@@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
-(defun pcase--fgrep (bindings sexp)
- "Return those of the BINDINGS which might be used in SEXP."
- (let ((res '()))
- (while (and (consp sexp) bindings)
- (dolist (binding (pcase--fgrep bindings (pop sexp)))
- (push binding res)
- (setq bindings (remove binding bindings))))
- (if (vectorp sexp)
- ;; With backquote, code can appear within vectors as well.
- ;; This wouldn't be needed if we `macroexpand-all' before
- ;; calling pcase--fgrep, OTOH.
- (pcase--fgrep bindings (mapcar #'identity sexp))
- (let ((tmp (assq sexp bindings)))
- (if tmp
- (cons tmp res)
- res)))))
-
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form:
`(,fun ,arg)
(let* (;; `env' is an upper bound on the bindings we need.
(env (mapcar (lambda (x) (list (car x) (cdr x)))
- (pcase--fgrep vars fun)))
+ (macroexp--fgrep vars fun)))
(call (progn
(when (assq arg env)
;; `arg' is shadowed by `env'.
@@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form:
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
- (let* ((env (pcase--fgrep vars exp)))
+ (let* ((env (macroexp--fgrep vars exp)))
(if env
(macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
env)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 1044acf..bb68173 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1046,8 +1046,8 @@ anyway."
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
(defcustom erc-pre-send-functions nil
- "List of functions called to possibly alter the string that is sent.
-The functions are called with one argument, a `erc-input' struct,
+ "Special hook run to possibly alter the string that is sent.
+The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
The struct has three slots:
@@ -1056,7 +1056,7 @@ The struct has three slots:
`insertp': Whether the string should be inserted into the erc buffer.
`sendp': Whether the string should be sent to the irc server."
:group 'erc
- :type '(repeat function)
+ :type 'hook
:version "27.1")
(defvar erc-insert-this t
@@ -1295,9 +1295,9 @@ Example:
(define-erc-module replace nil
\"This mode replaces incoming text according to `erc-replace-alist'.\"
((add-hook \\='erc-insert-modify-hook
- \\='erc-replace-insert))
+ #\\='erc-replace-insert))
((remove-hook \\='erc-insert-modify-hook
- \\='erc-replace-insert)))"
+ #\\='erc-replace-insert)))"
(declare (doc-string 3))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
@@ -1495,7 +1495,7 @@ Defaults to the server buffer."
(setq-local paragraph-start
(concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
(setq-local completion-ignore-case t)
- (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
+ (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
;; activation
@@ -2585,7 +2585,7 @@ This function adds `erc-lurker-update-status' to
most recent PRIVMSG as well as initializing the state variable
storing this information."
(setq erc-lurker-state (make-hash-table :test 'equal))
- (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
+ (add-hook 'erc-insert-pre-hook #'erc-lurker-update-status))
(defun erc-lurker-cleanup ()
"Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
@@ -2694,7 +2694,7 @@ otherwise `erc-server-announced-name'. SERVER is matched
against
(defun erc-add-targets (scope target-list)
(let ((targets
(mapcar (lambda (targets) (member scope targets)) target-list)))
- (cdr (apply 'append (delete nil targets)))))
+ (cdr (apply #'append (delete nil targets)))))
(defun erc-hide-current-message-p (parsed)
"Predicate indicating whether the parsed ERC response PARSED should be
hidden.
@@ -3038,7 +3038,7 @@ If no USER argument is specified, list the contents of
`erc-ignore-list'."
(erc-display-message
nil 'notice (current-buffer) 'ops
?i (length ops) ?s (if (> (length ops) 1) "s" "")
- ?o (mapconcat 'identity ops " "))
+ ?o (mapconcat #'identity ops " "))
(erc-display-message nil 'notice (current-buffer) 'ops-none)))
t)
@@ -3209,7 +3209,7 @@ command."
(defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
"Kick the user indicated in LINE from the current channel.
LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
- (let ((reasonstring (mapconcat 'identity reasonwords " ")))
+ (let ((reasonstring (mapconcat #'identity reasonwords " ")))
(if (string= "" reasonstring)
(setq reasonstring (format "Kicked by %s" (erc-current-nick))))
(if (erc-channel-p target)
@@ -3744,7 +3744,7 @@ the message given by REASON."
" -"
(make-string (length people) ?o)
" "
- (mapconcat 'identity people " ")))
+ (mapconcat #'identity people " ")))
t))
(defun erc-cmd-OP (&rest people)
@@ -3754,7 +3754,7 @@ the message given by REASON."
" +"
(make-string (length people) ?o)
" "
- (mapconcat 'identity people " ")))
+ (mapconcat #'identity people " ")))
t))
(defun erc-cmd-TIME (&optional line)
@@ -3952,7 +3952,7 @@ Unban all currently banned users in the current channel."
(erc-server-send
(format "MODE %s -%s %s" (erc-default-target)
(make-string (length x) ?b)
- (mapconcat 'identity x " "))))
+ (mapconcat #'identity x " "))))
(erc-group-list bans 3))))
t))))
@@ -4183,7 +4183,7 @@ Displays PROC and PARSED appropriately using
`erc-display-message'."
(erc-display-message
parsed 'notice proc
(mapconcat
- 'identity
+ #'identity
(let (res)
(mapc #'(lambda (x)
(if (stringp x)
@@ -5553,12 +5553,10 @@ This returns non-nil only if we actually send anything."
;; Instead `erc-pre-send-functions' is used as a filter to do
;; allow both changing and suppressing the string.
(run-hook-with-args 'erc-send-pre-hook input)
- (setq state (make-erc-input :string str
+ (setq state (make-erc-input :string str ;May be != from `input' now!
:insertp erc-insert-this
:sendp erc-send-this))
- (dolist (func erc-pre-send-functions)
- ;; The functions can return nil to inhibit sending.
- (funcall func state))
+ (run-hook-with-args 'erc-pre-send-functions state)
(when (and (erc-input-sendp state)
erc-send-this)
(let ((string (erc-input-string state)))
@@ -5579,26 +5577,26 @@ This returns non-nil only if we actually send anything."
(erc-process-input-line (concat string "\n") t nil))
t))))))
-(defun erc-display-command (line)
- (when erc-insert-this
- (let ((insert-position (point)))
- (unless erc-hide-prompt
- (erc-display-prompt nil nil (erc-command-indicator)
- (and (erc-command-indicator)
- 'erc-command-indicator-face)))
- (let ((beg (point)))
- (insert line)
- (erc-put-text-property beg (point)
- 'font-lock-face 'erc-command-indicator-face)
- (insert "\n"))
- (when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
- (set-marker erc-insert-marker (point))
- (save-excursion
- (save-restriction
- (narrow-to-region insert-position (point))
- (run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))))))
+;; (defun erc-display-command (line)
+;; (when erc-insert-this
+;; (let ((insert-position (point)))
+;; (unless erc-hide-prompt
+;; (erc-display-prompt nil nil (erc-command-indicator)
+;; (and (erc-command-indicator)
+;; 'erc-command-indicator-face)))
+;; (let ((beg (point)))
+;; (insert line)
+;; (erc-put-text-property beg (point)
+;; 'font-lock-face 'erc-command-indicator-face)
+;; (insert "\n"))
+;; (when (processp erc-server-process)
+;; (set-marker (process-mark erc-server-process) (point)))
+;; (set-marker erc-insert-marker (point))
+;; (save-excursion
+;; (save-restriction
+;; (narrow-to-region insert-position (point))
+;; (run-hooks 'erc-send-modify-hook)
+;; (run-hooks 'erc-send-post-hook))))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at the
@@ -6563,7 +6561,7 @@ If optional argument HERE is non-nil, insert version
number at point."
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((string
- (mapconcat 'identity
+ (mapconcat #'identity
(let (modes (case-fold-search nil))
(dolist (var (apropos-internal "^erc-.*mode$"))
(when (and (boundp var)
@@ -6817,7 +6815,8 @@ See also `format-spec'."
;;; Various hook functions
-(add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
+;; FIXME: Don't set the hook globally!
+(add-hook 'kill-buffer-hook #'erc-kill-buffer-function)
(defcustom erc-kill-server-hook '(erc-kill-server)
"Invoked whenever a server buffer is killed via `kill-buffer'."
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index d362adc..2609397 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,4 +1,4 @@
-;;; facemenu.el --- create a face menu for interactively adding fonts to text
+;;; facemenu.el --- create a face menu for interactively adding fonts to text
-*- lexical-binding: t; -*-
;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 7c01b15..2ef13ae 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,4 +1,4 @@
-;;; filesets.el --- handle group of files
+;;; filesets.el --- handle group of files -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -88,7 +88,8 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(require 'seq)
(require 'easymenu)
;;; Some variables
@@ -153,52 +154,25 @@ COND-FN takes one argument: the current element."
; (cl-remove 'dummy lst :test (lambda (dummy elt)
; (not (funcall cond-fn elt)))))
(let ((rv nil))
- (dolist (elt lst rv)
+ (dolist (elt lst)
(when (funcall cond-fn elt)
- (setq rv (append rv (list elt)))))))
+ (push elt rv)))
+ (nreverse rv)))
(defun filesets-ormap (fsom-pred lst)
"Return the tail of LST for the head of which FSOM-PRED is non-nil."
(let ((fsom-lst lst)
(fsom-rv nil))
- (while (and (not (null fsom-lst))
+ (while (and fsom-lst
(null fsom-rv))
(if (funcall fsom-pred (car fsom-lst))
(setq fsom-rv fsom-lst)
(setq fsom-lst (cdr fsom-lst))))
fsom-rv))
-(defun filesets-some (fss-pred fss-lst)
- "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
-Like `some', return the first value of FSS-PRED that is non-nil."
- (catch 'exit
- (dolist (fss-this fss-lst nil)
- (let ((fss-rv (funcall fss-pred fss-this)))
- (when fss-rv
- (throw 'exit fss-rv))))))
-;(fset 'filesets-some 'cl-some) ;; or use the cl function
-
-(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
- "Find the first occurrence of FSM-ITEM in FSM-LST.
-It is supposed to work like cl's `member*'. At the moment only the :test
-key is supported."
- (let ((fsm-test (or (plist-get fsm-keys ':test)
- (function equal))))
- (filesets-ormap (lambda (fsm-this)
- (funcall fsm-test fsm-item fsm-this))
- fsm-lst)))
-;(fset 'filesets-member 'cl-member) ;; or use the cl function
-
-(defun filesets-sublist (lst beg &optional end)
- "Get the sublist of LST from BEG to END - 1."
- (let ((rv nil)
- (i beg)
- (top (or end
- (length lst))))
- (while (< i top)
- (setq rv (append rv (list (nth i lst))))
- (setq i (+ i 1)))
- rv))
+(define-obsolete-function-alias 'filesets-some #'cl-some "28.1")
+(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
+(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
(defun filesets-select-command (cmd-list)
"Select one command from CMD-LIST -- a string with space separated names."
@@ -222,7 +196,7 @@ key is supported."
(defun filesets-message (level &rest args)
"Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
(when (<= level (abs filesets-verbosity))
- (apply 'message args)))
+ (apply #'message args)))
;;; config file
@@ -233,9 +207,9 @@ key is supported."
(defun filesets-reset-fileset (&optional fileset no-cache)
"Reset the cached values for one or all filesets."
- (if fileset
- (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil))
- (setq filesets-submenus nil))
+ (setq filesets-submenus (if fileset
+ (lax-plist-put filesets-submenus fileset nil)
+ nil))
(setq filesets-has-changed-flag t)
(setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
(not no-cache))))
@@ -303,50 +277,46 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set
with
(defcustom filesets-menu-name "Filesets"
"Filesets' menu name."
- :set (function filesets-set-default)
- :type 'string
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'string)
(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
See `easy-menu-add-item' for documentation."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice (const :tag "Top Level" nil)
(sexp :tag "Menu Path"))
:version "23.1" ; was nil
- :group 'filesets)
+ )
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
See `easy-menu-add-item' for documentation."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice (string :tag "Name")
(const :tag "Last" nil))
:version "23.1" ; was "File"
- :group 'filesets)
+ )
(defcustom filesets-menu-in-menu nil
"Use that instead of `current-menubar' as the menu to change.
See `easy-menu-add-item' for documentation."
- :set (function filesets-set-default)
- :type 'sexp
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'sexp)
(defcustom filesets-menu-shortcuts-flag t
"Non-nil means to prepend menus with hopefully unique shortcuts."
- :set (function filesets-set-default!)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default!
+ :type 'boolean)
(defcustom filesets-menu-shortcuts-marker "%_"
"String for marking menu shortcuts."
- :set (function filesets-set-default!)
- :type 'string
- :group 'filesets)
+ :set #'filesets-set-default!
+ :type 'string)
;;(defcustom filesets-menu-cnvfp-flag nil
;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern
menus."
-;; :set (function filesets-set-default!)
+;; :set #'filesets-set-default!
;; :type 'boolean
;; :group 'filesets)
@@ -355,9 +325,8 @@ See `easy-menu-add-item' for documentation."
"File to be used for saving the filesets menu between sessions.
Set this to \"\", to disable caching of menus.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
- :type 'file
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'file)
(put 'filesets-menu-cache-file 'risky-local-variable t)
(defcustom filesets-menu-cache-contents
@@ -383,7 +352,7 @@ If you want caching to work properly, at least
`filesets-submenus',
list.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat
(choice :tag "Variable"
(const :tag "filesets-submenus"
@@ -400,8 +369,7 @@ Don't forget to check out
`filesets-menu-ensure-use-cached'."
:value filesets-ingroup-patterns)
(const :tag "filesets-be-docile-flag"
:value filesets-be-docile-flag)
- (sexp :tag "Other" :value nil)))
- :group 'filesets)
+ (sexp :tag "Other" :value nil))))
(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
'filesets-cache-fill-content-hook "24.3")
@@ -423,48 +391,43 @@ configuration file, you can add a something like this
to this hook.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
- :type 'hook
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'hook)
(defcustom filesets-cache-hostname-flag nil
"Non-nil means cache the hostname.
If the current name differs from the cached one,
rebuild the menu and create a new cache file."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-cache-save-often-flag nil
"Non-nil means save buffer on every change of the filesets menu.
If this variable is set to nil and if Emacs crashes, the cache and
filesets-data could get out of sync. Set this to t if this happens from
time to time or if the fileset cache causes troubles."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-max-submenu-length 25
"Maximum length of submenus.
Set this value to 0 to turn menu splitting off. BTW, parts of submenus
will not be rewrapped if their length exceeds this value."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defcustom filesets-max-entry-length 50
"Truncate names of split submenus to this length."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
-(defcustom filesets-browse-dir-function 'dired
+(defcustom filesets-browse-dir-function #'dired
"A function or command used for browsing directories.
When using an external command, \"%s\" will be replaced with the
directory's name.
Note: You have to manually rebuild the menu if you change this value."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "dired"
:value dired)
@@ -473,10 +436,9 @@ Note: You have to manually rebuild the menu if you change
this value."
(string :tag "Name")
(string :tag "Arguments"))
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
-(defcustom filesets-open-file-function 'filesets-find-or-display-file
+(defcustom filesets-open-file-function #'filesets-find-or-display-file
"The function used for opening files.
`filesets-find-or-display-file' ... Filesets' default function for
@@ -489,26 +451,24 @@ for a specific file type. Either this viewer, if
defined, or
readable, will not be opened.
Caveat: Changes will take effect only after rebuilding the menu."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "filesets-find-or-display-file"
:value filesets-find-or-display-file)
(const :tag "filesets-find-file"
:value filesets-find-file)
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
-(defcustom filesets-save-buffer-function 'save-buffer
+(defcustom filesets-save-buffer-function #'save-buffer
"The function used to save a buffer.
Caveat: Changes will take effect after rebuilding the menu."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "save-buffer"
:value save-buffer)
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
(defcustom filesets-find-file-delay
(if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
@@ -519,29 +479,25 @@ This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
Set this to 0, if you don't use XEmacs's buffer tabs."
- :set (function filesets-set-default)
- :type 'number
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'number)
(defcustom filesets-be-docile-flag nil
"Non-nil means don't complain if a file or a directory doesn't exist.
This is useful if you want to use the same startup files in different
computer environments."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-sort-menu-flag t
"Non-nil means sort the filesets menu alphabetically."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-sort-case-sensitive-flag t
"Non-nil means sorting of the filesets menu is case sensitive."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-tree-max-level 3
"Maximum scan depth for directory trees.
@@ -561,9 +517,8 @@ i.e. how deep the menu should be. Try something like
and it should become clear what this option is about. In any case,
including directory trees to the menu can take a lot of memory."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defcustom filesets-commands
'(("Isearch"
@@ -590,7 +545,7 @@ function that returns one) to be run on a filesets' files.
The argument <file-name> or <<file-name>> (quoted) will be replaced with
the filename."
- :set (function filesets-set-default+)
+ :set #'filesets-set-default+
:type '(repeat :tag "Commands"
(list :tag "Definition" :value ("")
(string "Name")
@@ -606,8 +561,7 @@ the filename."
(string :tag "Quoted File Name"
:value "<<file-name>>")
(function :tag "Function"
- :value nil)))))
- :group 'filesets)
+ :value nil))))))
(put 'filesets-commands 'risky-local-variable t)
(defcustom filesets-external-viewers
@@ -627,28 +581,33 @@ the filename."
(dvi-cmd "xdvi")
(doc-cmd "antiword")
(pic-cmd "gqview"))
- `(("^.+\\..?html?$" browse-url
+ `((".\\..?html?\\'" browse-url
((:ignore-on-open-all t)))
- ("^.+\\.pdf$" ,pdf-cmd
+ (".\\.pdf\\'" ,pdf-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,pdf-cmd)))
- ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
+ ;; (:constraintp ,pdf-cmd)
+ ))
+ (".\\.e?ps\\(?:\\.gz\\)?\\'" ,ps-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,ps-cmd)))
- ("^.+\\.dvi$" ,dvi-cmd
+ ;; (:constraintp ,ps-cmd)
+ ))
+ (".\\.dvi\\'" ,dvi-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,dvi-cmd)))
- ("^.+\\.doc$" ,doc-cmd
+ ;; (:constraintp ,dvi-cmd)
+ ))
+ (".\\.doc\\'" ,doc-cmd
((:capture-output t)
(:ignore-on-read-text t)
- (:constraint-flag ,doc-cmd)))
- ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
+ ;; (:constraintp ,doc-cmd)
+ ))
+ (".\\.\\(tiff\\|xpm\\|gif\\|pgn\\)\\'" ,pic-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,pic-cmd)))))
+ ;; (:constraintp ,pic-cmd)
+ ))))
"Association list of file patterns and external viewers for use with
`filesets-find-or-display-file'.
@@ -665,10 +624,8 @@ i.e. on open-all-files-events or when running commands
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
-:constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
-
-:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
-in conjunction with :capture-output
+:open-hook FUNCTIONs ... run FUNCTIONs after spawning the viewer -- mainly
+useful in conjunction with :capture-output
:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
\(defaults to (list \"%S\")) when using shell commands
@@ -693,7 +650,7 @@ In order to view pdf or rtf files in an Emacs buffer, you
could use these:
(:constraintp (lambda ()
(and (filesets-which-command-p \"rtf2htm\")
(filesets-which-command-p \"w3m\"))))))"
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat :tag "Viewer"
(list :tag "Definition"
:value ("^.+\\.suffix$" "")
@@ -708,7 +665,7 @@ In order to view pdf or rtf files in an Emacs buffer, you
could use these:
(const :format ""
:value :constraintp)
(function :tag "Function"))
- (list :tag ":constraint-flag"
+ (list :tag ":constraint-flag (obsolete)"
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
@@ -749,8 +706,7 @@ In order to view pdf or rtf files in an Emacs buffer, you
could use these:
:value (:capture-output t)
(const :format ""
:value :capture-output)
- (boolean :tag "Boolean"))))))
- :group 'filesets)
+ (boolean :tag "Boolean")))))))
(put 'filesets-external-viewers 'risky-local-variable t)
(defcustom filesets-ingroup-patterns
@@ -891,7 +847,7 @@ With duplicates removed, it would be:
M + A - X
B"
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat
:tag "Include"
(list
@@ -937,8 +893,7 @@ With duplicates removed, it would be:
(list :tag ":preprocess"
:value (:preprocess)
(const :format "" :value :preprocess)
- (function :tag "Function")))))))
- :group 'filesets)
+ (function :tag "Function"))))))))
(put 'filesets-ingroup-patterns 'risky-local-variable t)
(defcustom filesets-data nil
@@ -1009,8 +964,7 @@ is used.
Before using :ingroup, make sure that the file type is already
defined in `filesets-ingroup-patterns'."
- :group 'filesets
- :set (function filesets-data-set-default)
+ :set #'filesets-data-set-default
:type '(repeat
(cons :tag "Fileset"
(string :tag "Name" :value "")
@@ -1072,9 +1026,8 @@ defined in `filesets-ingroup-patterns'."
(defcustom filesets-query-user-limit 15
"Query the user before opening a fileset with that many files."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defun filesets-filter-dir-names (lst &optional negative)
@@ -1127,16 +1080,16 @@ Return full path if FULL-FLAG is non-nil."
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched dir %S with pattern %S"
this pattern)
- (setq dirs (cons this dirs))))
+ (push this dirs)))
(t
(when (or (not pattern)
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched file %S with pattern %S"
this pattern)
- (setq files (cons (if full-flag
- (concat (file-name-as-directory dir) this)
- this)
- files))))))
+ (push (if full-flag
+ (concat (file-name-as-directory dir) this)
+ this)
+ files)))))
(cond
((equal what ':dirs)
(filesets-conditional-sort dirs))
@@ -1193,7 +1146,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-convert-path-list (string)
"Return a path-list given as STRING as list."
(if string
- (mapcar (lambda (x) (file-name-as-directory x))
+ (mapcar #'file-name-as-directory
(split-string string path-separator))
nil))
@@ -1203,17 +1156,17 @@ Return full path if FULL-FLAG is non-nil."
filename)))
(if (file-exists-p f)
f
- (filesets-some
+ (cl-some
(lambda (dir)
(let ((dir (file-name-as-directory dir))
(files (if (file-exists-p dir)
(filesets-directory-files dir nil ':files)
nil)))
- (filesets-some (lambda (file)
- (if (equal filename (file-name-nondirectory file))
- (concat dir file)
- nil))
- files)))
+ (cl-some (lambda (file)
+ (if (equal filename (file-name-nondirectory file))
+ (concat dir file)
+ nil))
+ files)))
path-list))))
@@ -1223,12 +1176,14 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-eviewer-constraint-p (entry)
(let* ((props (filesets-eviewer-get-props entry))
- (constraint (assoc ':constraintp props))
- (constraint-flag (assoc ':constraint-flag props)))
+ (constraint (assoc :constraintp props))
+ (constraint-flag (assoc :constraint-flag props)))
(cond
(constraint
(funcall (cadr constraint)))
(constraint-flag
+ (message "Obsolete :constraint-flag %S, use :constraintp instead"
+ (cadr constraint-flag))
(eval (cadr constraint-flag)))
(t
t))))
@@ -1236,7 +1191,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
- (filesets-some
+ (cl-some
(lambda (entry)
(when (and (string-match-p (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
@@ -1246,7 +1201,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
- (filesets-some
+ (cl-some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
@@ -1308,17 +1263,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
(oh (filesets-filetype-get-prop ':open-hook file entry))
(args (let ((fmt (filesets-filetype-get-prop ':args file entry)))
(if fmt
- (let ((rv ""))
- (dolist (this fmt rv)
- (setq rv (concat rv
- (cond
- ((stringp this)
- (format this file))
- ((and (symbolp this)
- (fboundp this))
- (format "%S" (funcall this)))
- (t
- (format "%S" this)))))))
+ (mapconcat
+ (lambda (this)
+ (if (stringp this) (format this file)
+ (format "%S" (if (functionp this)
+ (funcall this)
+ this))))
+ fmt "")
(format "%S" file))))
(output
(cond
@@ -1338,13 +1289,15 @@ Use the viewer defined in EV-ENTRY (a valid element of
(insert output)
(setq-local filesets-output-buffer-flag t)
(set-visited-file-name file t)
- (when oh
- (run-hooks 'oh))
+ (if (functionp oh)
+ (funcall oh)
+ (mapc #'funcall oh))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min)))
- (when oh
- (run-hooks 'oh))))
+ (if (functionp oh)
+ (funcall oh)
+ (mapc #'funcall oh))))
(error "Filesets: general error when spawning external viewer"))))
(defun filesets-find-file (file)
@@ -1355,7 +1308,8 @@ not be opened."
(when (or (file-readable-p file)
(not filesets-be-docile-flag))
(sit-for filesets-find-file-delay)
- (find-file file)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file file))))
(defun filesets-find-or-display-file (&optional file viewer)
"Visit FILE using an external VIEWER or open it in an Emacs buffer."
@@ -1394,7 +1348,8 @@ not be opened."
(if (functionp filesets-browse-dir-function)
(funcall filesets-browse-dir-function dir)
(let ((name (car filesets-browse-dir-function))
- (args (format (cadr filesets-browse-dir-function) (expand-file-name
dir))))
+ (args (format (cadr filesets-browse-dir-function)
+ (expand-file-name dir))))
(with-temp-buffer
(start-process (concat "Filesets:" name)
"*Filesets external directory browser*"
@@ -1445,7 +1400,7 @@ Return DEFAULT if not found. Return (car VALUE) if CARP
is non-nil."
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
- (filesets-some
+ (cl-some
(lambda (x)
(if (assoc x data)
x))
@@ -1557,16 +1512,15 @@ SAVE-FUNCTION takes no argument, but works on the
current buffer."
(assoc cmd-name filesets-commands))
(defun filesets-cmd-get-args (cmd-name)
- (let ((args (let ((def (filesets-cmd-get-def cmd-name)))
- (nth 2 def)))
- (rv nil))
- (dolist (this args rv)
- (cond
- ((and (symbolp this) (fboundp this))
- (let ((x (funcall this)))
- (setq rv (append rv (if (listp x) x (list x))))))
- (t
- (setq rv (append rv (list this))))))))
+ (mapcan (lambda (this)
+ (cond
+ ((and (symbolp this) (fboundp this))
+ (let ((x (funcall this)))
+ (if (listp x) x (list x))))
+ (t
+ (list this))))
+ (let ((def (filesets-cmd-get-def cmd-name)))
+ (nth 2 def))))
(defun filesets-cmd-get-fn (cmd-name)
(let ((def (filesets-cmd-get-def cmd-name)))
@@ -1628,28 +1582,24 @@ Replace <file-name> or <<file-name>> with filename."
(cond
((stringp fn)
(let* ((args
- (let ((txt ""))
- (dolist (this args txt)
- (setq txt
- (concat txt
- (if (equal txt "") "" " ")
- (filesets-run-cmd--repl-fn
+ (mapconcat
+ (lambda (this)
+ (filesets-run-cmd--repl-fn
this
(lambda (this)
- (format "%s"
this))))))))
+ (format "%s" this))))
+ args
+ " "))
(cmd (concat fn " " args)))
(filesets-cmd-show-result
cmd (shell-command-to-string cmd))))
((symbolp fn)
- (let ((args
- (let ((argl nil))
- (dolist (this args argl)
- (setq argl
- (append argl
- (filesets-run-cmd--repl-fn
- this
- 'list)))))))
- (apply fn args)))))))))))))))))
+ (apply fn
+ (mapcan (lambda (this)
+ (filesets-run-cmd--repl-fn
+ this
+ 'list))
+ args)))))))))))))))))
(defun filesets-get-cmd-menu ()
"Create filesets command menu."
@@ -1832,8 +1782,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (filesets-member this files
- :test 'filesets-files-equalp)))
+ (inlist (cl-member this files
+ :test #'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: `%s' is already in `%s'" this name))
@@ -1858,8 +1808,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (filesets-member this files
- :test 'filesets-files-equalp)))
+ (inlist (cl-member this files
+ :test #'filesets-files-equalp)))
;;(message "%s %s %s" files this inlist)
(if (and files this inlist)
(let ((new (list (cons ':files (delete (car inlist) files)))))
@@ -1908,7 +1858,7 @@ User will be queried, if no fileset name is provided."
(substring (elt submenu 0) 2))))
(if (listp submenu)
(cons name (cdr submenu))
- (apply 'vector (list name (cadr (append submenu nil)))))))
+ (apply #'vector (list name (cadr (append submenu nil)))))))
; (vconcat `[,name] (subseq submenu 1)))))
(defun filesets-wrap-submenu (submenu-body)
@@ -1926,12 +1876,14 @@ User will be queried, if no fileset name is provided."
((or (> count bl)
(null data)))
;; (let ((sl (subseq submenu-body count
- (let ((sl (filesets-sublist submenu-body count
- (let ((x (+ count factor)))
- (if (>= bl x)
- x
- nil)))))
+ (let ((sl (seq-subseq submenu-body count
+ (let ((x (+ count factor)))
+ (if (>= bl x)
+ x
+ nil)))))
(when sl
+ ;; FIXME: O(n²) performance bug because of repeated `append':
+ ;; use `mapcan'?
(setq result
(append
result
@@ -1948,6 +1900,8 @@ User will be queried, if no fileset name is provided."
(if (null (cdr x))
""
", "))))
+ ;; FIXME: O(n²) performance bug because of
+ ;; repeated `concat': use `mapconcat'?
(setq rv
(concat
rv
@@ -2023,11 +1977,11 @@ LOOKUP-NAME is used as lookup name for retrieving
fileset specific settings."
(and (stringp a)
(stringp b)
(string-match-p a b))))))
- (filesets-some (lambda (x)
- (if (funcall fn (car x) masterfile)
- (nth pos x)
- nil))
- filesets-ingroup-patterns)))
+ (cl-some (lambda (x)
+ (if (funcall fn (car x) masterfile)
+ (nth pos x)
+ nil))
+ filesets-ingroup-patterns)))
(defun filesets-ingroup-get-pattern (master)
"Access to `filesets-ingroup-patterns'. Extract patterns."
@@ -2039,12 +1993,8 @@ LOOKUP-NAME is used as lookup name for retrieving
fileset specific settings."
(defun filesets-ingroup-collect-finder (patt case-sensitivep)
"Helper function for `filesets-ingroup-collect'. Find pattern PATT."
- (let ((cfs case-fold-search)
- (rv (progn
- (setq case-fold-search (not case-sensitivep))
- (re-search-forward patt nil t))))
- (setq case-fold-search cfs)
- rv))
+ (let ((case-fold-search (not case-sensitivep)))
+ (re-search-forward patt nil t)))
(defun filesets-ingroup-cache-get (master)
"Access to `filesets-ingroup-cache'."
@@ -2102,9 +2052,9 @@ LOOKUP-NAME is used as lookup name for retrieving fileset
specific settings."
(when (and f
(not (member f flist))
(or (not remdupl-flag)
- (not (filesets-member
+ (not (cl-member
f filesets-ingroup-files
- :test 'filesets-files-equalp))))
+ :test #'filesets-files-equalp))))
(let ((no-stub-flag
(and (not this-stub-flag)
(if this-stubp
@@ -2116,16 +2066,18 @@ LOOKUP-NAME is used as lookup name for retrieving
fileset specific settings."
(cons f filesets-ingroup-files))
(when no-stub-flag
(filesets-ingroup-cache-put master f))
- (setq lst (append lst (list f))))))))
+ (push f lst))))))
(when lst
(setq rv
+ ;; FIXME: O(n²) performance bug because of repeated
+ ;; `nconc'.
(nconc rv
(mapcar (lambda (this)
`((,this ,this-name)
,@(filesets-ingroup-collect-files
fs remdupl-flag this
(- this-sd 1))))
- lst))))))))
+ (nreverse lst)))))))))
(filesets-message 2 "Filesets: no patterns defined for %S" master)))))
(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
@@ -2135,42 +2087,41 @@ FS is a fileset's name. FLIST is a list returned by
(if (null flist)
nil
(let ((count 0)
- (fsn fs)
- (rv nil))
- (dolist (this flist rv)
- (setq count (+ count 1))
- (let* ((def (if (listp this) (car this) (list this "")))
- (files (if (listp this) (cdr this) nil))
- (master (nth 0 def))
- (name (nth 1 def))
- (nm (concat (filesets-get-shortcut (if (or (not other-count)
files)
- count other-count))
- (if (or (null name) (equal name ""))
- ""
- (format "%s: " name))
- (file-name-nondirectory master))))
- (setq rv
- (append rv
- (if files
- `((,nm
- [,(concat "Inclusion Group: "
- (file-name-nondirectory master))
- (filesets-open ':ingroup ',master ',fsn)]
- "---"
- [,master (filesets-file-open nil ',master ',fsn)]
- "---"
- ,@(let ((count 0))
- (mapcar
- (lambda (this)
- (setq count (+ count 1))
- (let ((ff
(filesets-ingroup-collect-build-menu
- fs (list this) count)))
- (if (= (length ff) 1)
- (car ff)
- ff)))
- files))
- ,@(filesets-get-menu-epilog master ':ingroup
fsn)))
- `([,nm (filesets-file-open nil ',master
',fsn)])))))))))
+ (fsn fs))
+ (mapcan (lambda (this)
+ (setq count (+ count 1))
+ (let* ((def (if (listp this) (car this) (list this "")))
+ (files (if (listp this) (cdr this) nil))
+ (master (nth 0 def))
+ (name (nth 1 def))
+ (nm (concat (filesets-get-shortcut
+ (if (or (not other-count) files)
+ count other-count))
+ (if (or (null name) (equal name ""))
+ ""
+ (format "%s: " name))
+ (file-name-nondirectory master))))
+ (if files
+ `((,nm
+ [,(concat "Inclusion Group: "
+ (file-name-nondirectory master))
+ (filesets-open ':ingroup ',master ',fsn)]
+ "---"
+ [,master (filesets-file-open nil ',master ',fsn)]
+ "---"
+ ,@(let ((count 0))
+ (mapcar
+ (lambda (this)
+ (setq count (+ count 1))
+ (let ((ff (filesets-ingroup-collect-build-menu
+ fs (list this) count)))
+ (if (= (length ff) 1)
+ (car ff)
+ ff)))
+ files))
+ ,@(filesets-get-menu-epilog master ':ingroup fsn)))
+ `([,nm (filesets-file-open nil ',master ',fsn)]))))
+ flist))))
(defun filesets-ingroup-collect (fs remdupl-flag master)
"Collect names of included files and build submenu."
@@ -2275,7 +2226,7 @@ Construct a shortcut from COUNT."
(:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
- (pattname (apply 'concat (cons "Pattern: " dirpatt)))
+ (pattname (apply #'concat (cons "Pattern: " dirpatt)))
(count 0))
;;(filesets-message 3 "Filesets: scanning %S" pattname)
`([,pattname
@@ -2418,14 +2369,14 @@ fileset thinks this is necessary or not."
(dolist (this filesets-menu-cache-contents)
(if (get this 'custom-type)
(progn
- (insert (format "(setq-default %s '%S)" this (eval this)))
+ (insert (format "(setq-default %s '%S)" this (eval this t)))
(when filesets-menu-ensure-use-cached
(newline)
(insert (format "(setq %s (cons '%s %s))"
'filesets-ignore-next-set-default
this
'filesets-ignore-next-set-default))))
- (insert (format "(setq %s '%S)" this (eval this))))
+ (insert (format "(setq %s '%S)" this (eval this t))))
(newline 2))
(insert (format "(setq filesets-cache-version %S)" filesets-version))
(newline 2)
@@ -2526,9 +2477,9 @@ We apologize for the inconvenience.")))
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
(add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
- (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
- (add-hook 'first-change-hook (function filesets-reset-filename-on-change))
- (add-hook 'kill-emacs-hook (function filesets-exit))
+ (add-hook 'kill-buffer-hook #'filesets-remove-from-ubl)
+ (add-hook 'first-change-hook #'filesets-reset-filename-on-change)
+ (add-hook 'kill-emacs-hook #'filesets-exit)
(if (filesets-menu-cache-file-load)
(progn
(filesets-build-menu-maybe)
@@ -2542,7 +2493,7 @@ Set up hooks, load the cache file -- if existing -- and
build the menu."
(defun filesets-error (_class &rest args)
"`error' wrapper."
(declare (obsolete error "28.1"))
- (error "%s" (mapconcat 'identity args " ")))
+ (error "%s" (mapconcat #'identity args " ")))
(provide 'filesets)
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 38307bb..0f1a3d1 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -1,4 +1,4 @@
-;;; font-core.el --- Core interface to font-lock
+;;; font-core.el --- Core interface to font-lock -*- lexical-binding: t; -*-
;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
diff --git a/lisp/format.el b/lisp/format.el
index df3bc46..4209fc6 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -1,4 +1,4 @@
-;;; format.el --- read and save files in multiple formats
+;;; format.el --- read and save files in multiple formats -*-
lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software
;; Foundation, Inc.
@@ -419,7 +419,8 @@ If FORMAT is nil then do not do any format conversion."
(file-name-nondirectory file)))))
(list file fmt)))
(let ((format-alist nil))
- (find-file filename))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename)))
(if format
(format-decode-buffer format)))
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 18924a3..3fb8e46 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -145,7 +145,6 @@ used to display Gnus windows."
(,shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
- (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
("*Gnus Bug*" 1.0 point)))
(score-trace
(vertical 1.0
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 61946aa..2b0b61b 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1264,11 +1264,20 @@ in HANDLE."
(when (and (mm-handle-buffer handle)
(buffer-name (mm-handle-buffer handle)))
(with-temp-buffer
- (mm-disable-multibyte)
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
+ (if (and (eq (mm-handle-encoding handle) '8bit)
+ (with-current-buffer (mm-handle-buffer handle)
+ enable-multibyte-characters))
+ ;; Due to unfortunate historical reasons, we may have a
+ ;; multibyte buffer here, but if it's using an 8bit
+ ;; Content-Transfer-Encoding, then work around that by
+ ;; just ignoring the situation.
+ (insert-buffer-substring (mm-handle-buffer handle))
+ ;; Do the decoding.
+ (mm-disable-multibyte)
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle)))
,@forms))))
(put 'mm-with-part 'lisp-indent-function 1)
(put 'mm-with-part 'edebug-form-spec '(body))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 68c31dc..e4fd976 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -494,7 +494,7 @@ This variable is set by `nnmaildir-request-article'.")
(delete-char 1)
(setq nov (nnheader-parse-head t)
field (or (mail-header-lines nov) 0)))
- (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
+ (unless (or (<= field 0) (nnmaildir--param pgname 'distrust-Lines:))
(setq nov-mid field))
(setq nov-mid (number-to-string nov-mid)
nov-mid (concat (number-to-string attr) "\t" nov-mid))
diff --git a/lisp/info.el b/lisp/info.el
index ef94aa9..62d7b58 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -160,17 +160,14 @@ A header-line does not scroll with the rest of the
buffer."
:version "24.4")
;; This is a defcustom largely so that we can get the benefit
-;; of custom-initialize-delay. Perhaps it would work to make it a
-;; defvar and explicitly give it a standard-value property, and
-;; call custom-initialize-delay on it.
-;; The progn forces the autoloader to include the whole thing, not
-;; just an abbreviated version. The value is initialized at startup
-;; time, when command-line calls custom-reevaluate-setting on all
-;; the defcustoms in custom-delayed-init-variables. This is
-;; somewhat sub-optimal, as ideally this should be done when Info
-;; mode is first invoked.
+;; of `custom-initialize-delay'. Perhaps it would work to make it a
+;; `defvar' and explicitly give it a `standard-value' property, and
+;; call `custom-initialize-delay' on it.
+;; The value is initialized at startup time, when command-line calls
+;; `custom-reevaluate-setting' on all the defcustoms in
+;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally
+;; this should be done when Info mode is first invoked.
;;;###autoload
-(progn
(defcustom Info-default-directory-list
(let* ((config-dir
(file-name-as-directory
@@ -232,8 +229,8 @@ the environment variable INFOPATH is set.
Although this is a customizable variable, that is mainly for technical
reasons. Normally, you should either set INFOPATH or customize
`Info-additional-directory-list', rather than changing this variable."
- :initialize 'custom-initialize-delay
- :type '(repeat directory)))
+ :initialize #'custom-initialize-delay
+ :type '(repeat directory))
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 6924e1c..9bce419 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1,4 +1,4 @@
-;;; characters.el --- set syntax and category for multibyte characters
+;;; characters.el --- set syntax and category for multibyte characters -*-
lexical-binding: t; -*-
;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -526,9 +526,6 @@ with L, LRE, or LRO Unicode bidi character type.")
;; FIXME: We should probably just use the Unicode properties to set
;; up the syntax table.
- ;; NBSP isn't semantically interchangeable with other whitespace chars,
- ;; so it's more like punctuation.
- (set-case-syntax ? "." tbl)
(set-case-syntax ?¡ "." tbl)
(set-case-syntax ?¦ "_" tbl)
(set-case-syntax ?§ "." tbl)
@@ -602,11 +599,17 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Cyrillic Extended-C
(modify-category-entry '(#x1C80 . #x1C8F) ?y)
- ;; general punctuation
+ ;; space characters (see section 6.2 in the Unicode Standard)
+ (set-case-syntax ? " " tbl)
(setq c #x2000)
(while (<= c #x200b)
(set-case-syntax c " " tbl)
(setq c (1+ c)))
+ (let ((chars '(#x202F #x205F #x3000)))
+ (while chars
+ (set-case-syntax (car chars) " " tbl)
+ (setq chars (cdr chars))))
+ ;; general punctuation
(while (<= c #x200F)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 4d80e17..14e7b89 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -1,4 +1,4 @@
-;;; fontset.el --- commands for handling fontset
+;;; fontset.el --- commands for handling fontset -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index 8b5814e..2c7da2b 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -1,4 +1,4 @@
-;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8 -*-
+;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8;
lexical-binding: t; -*-
;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 662f211..64aac46 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1,4 +1,4 @@
-;;; mule-conf.el --- configure multilingual environment
+;;; mule-conf.el --- configure multilingual environment -*- lexical-binding:
t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
2007, 2008, 2009, 2010, 2011
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index d3a1005..6a32cff 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1,4 +1,4 @@
-;;; mule.el --- basic commands for multilingual environment
+;;; mule.el --- basic commands for multilingual environment -*-
lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/international/ucs-normalize.el
b/lisp/international/ucs-normalize.el
index d1b5c07..0f8dedf 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -1,4 +1,4 @@
-;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
+;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC -*-
lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -185,7 +185,7 @@
;; always returns nil, something the code here doesn't like.
(define-char-code-property 'decomposition "uni-decomposition.el")
(define-char-code-property 'canonical-combining-class "uni-combining.el")
- (let ((char 0) ccc decomposition)
+ (let (ccc decomposition)
(mapc
(lambda (start-end)
(cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index fefdd16..67cc7be 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -669,6 +669,10 @@ This is like `describe-bindings', but displays only
Isearch keys."
(if isearch-success 'isearch-abort binding))))
map))
+;; Note: Before adding more key bindings to this map, please keep in
+;; mind that any unbound key exits Isearch and runs the command bound
+;; to it in the local or global map. So in effect every key unbound
+;; in this map is implicitly bound.
(defvar isearch-mode-map
(let ((i 0)
(map (make-keymap)))
@@ -834,6 +838,10 @@ This is like `describe-bindings', but displays only
Isearch keys."
:image '(isearch-tool-bar-image "left-arrow")))
map))
+;; Note: Before adding more key bindings to this map, please keep in
+;; mind that any unbound key exits Isearch and runs the command bound
+;; to it in the local or global map. So in effect every key unbound
+;; in this map is implicitly bound.
(defvar minibuffer-local-isearch-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 3c7d2a0..11d93a6 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -1,4 +1,4 @@
-;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
+;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el -*-
lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software
;; Foundation, Inc.
@@ -93,6 +93,7 @@ Otherwise, it is nil.")
"\\)" file-name-version-regexp "?\\'"))))
;; Functions for accessing the return value of jka-compr-get-compression-info
+;; FIXME: Use cl-defstruct!
(defun jka-compr-info-regexp (info) (aref info 0))
(defun jka-compr-info-compress-message (info) (aref info 1))
(defun jka-compr-info-compress-program (info) (aref info 2))
diff --git a/lisp/json.el b/lisp/json.el
index f5659d8..1f1f608 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -55,7 +55,6 @@
;;; Code:
(require 'map)
-(require 'seq)
(require 'subr-x)
;; Parameters
@@ -655,7 +654,9 @@ become JSON objects."
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
- (not (seq-empty-p array)))
+ (if (listp array)
+ array
+ (> (length array) 0)))
(concat
"["
(json--with-indentation
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index 6b434fe..5cb8344 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -1,4 +1,4 @@
-;;; chinese.el --- support for Chinese -*- coding: utf-8; -*-
+;;; chinese.el --- support for Chinese -*- coding: utf-8; lexical-binding: t;
-*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index c491644..c12096f 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -1,4 +1,4 @@
-;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; -*-
+;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; lexical-binding:
t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/english.el b/lisp/language/english.el
index dfbec85..41d56be 100644
--- a/lisp/language/english.el
+++ b/lisp/language/english.el
@@ -1,4 +1,4 @@
-;;; english.el --- support for English
+;;; english.el --- support for English -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 1e409e3..8573f61 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -1,4 +1,4 @@
-;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*-
+;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs;
lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/european.el b/lisp/language/european.el
index 1f27ff0..bcd62a1 100644
--- a/lisp/language/european.el
+++ b/lisp/language/european.el
@@ -1,4 +1,4 @@
-;;; european.el --- support for European languages -*- coding: utf-8; -*-
+;;; european.el --- support for European languages -*- coding: utf-8;
lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 9f9a14a..3895656 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -1,4 +1,4 @@
-;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*-
+;;; hebrew.el --- support for Hebrew -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index b92fda5..5ff5796 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -1,4 +1,4 @@
-;;; indian.el --- Indian languages support -*- coding: utf-8; -*-
+;;; indian.el --- Indian languages support -*- coding: utf-8; lexical-binding:
t; -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index 8c724ee..bd8ef6e 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -1,4 +1,4 @@
-;;; japanese.el --- support for Japanese
+;;; japanese.el --- support for Japanese -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 997b8ae..22b33a4 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -1,4 +1,4 @@
-;;; korean.el --- support for Korean -*- coding: utf-8 -*-
+;;; korean.el --- support for Korean -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 44fe8d2..5252f1e 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -1,4 +1,4 @@
-;;; lao.el --- support for Lao -*- coding: utf-8 -*-
+;;; lao.el --- support for Lao -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 089b79c..0a274f1 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -1,4 +1,4 @@
-;;; misc-lang.el --- support for miscellaneous languages (characters)
+;;; misc-lang.el --- support for miscellaneous languages (characters) -*-
lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 44a9a31..be15db4 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -1,4 +1,4 @@
-;;; thai.el --- support for Thai -*- coding: utf-8 -*-
+;;; thai.el --- support for Thai -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index 5b8e29c..edd9d76 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -1,4 +1,4 @@
-;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*-
+;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs;
lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index f4de299..2e583a4 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -1,4 +1,4 @@
-;;; reporter.el --- customizable bug reporting of lisp programs
+;;; reporter.el --- customizable bug reporting of lisp programs -*-
lexical-binding: t; -*-
;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc.
@@ -158,7 +158,7 @@ composed.")
t)
(error indent-enclosing-p))))
-(defun reporter-lisp-indent (indent-point state)
+(defun reporter-lisp-indent (_indent-point state)
"A better lisp indentation style for bug reporting."
(save-excursion
(goto-char (1+ (nth 1 state)))
@@ -193,7 +193,7 @@ MAILBUF is the mail buffer being composed."
(<= maxwidth (current-column)))
(save-excursion
(let ((compact-p (not (memq varsym reporter-dont-compact-list)))
- (lisp-indent-function 'reporter-lisp-indent))
+ (lisp-indent-function #'reporter-lisp-indent))
(goto-char here)
(reporter-beautify-list maxwidth compact-p))))
(insert "\n"))
@@ -206,6 +206,11 @@ MAILBUF is the mail buffer being composed."
(error
(error ""))))
+(defun reporter--run-functions (funs)
+ (if (functionp funs)
+ (funcall funs)
+ (mapc #'funcall funs)))
+
(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
"Dump the state of the mode specific variables.
PKGNAME contains the name of the mode as it will appear in the bug
@@ -230,42 +235,39 @@ properly.
PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but
before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is
dumped."
- (let ((buffer (current-buffer)))
- (set-buffer buffer)
- (insert "Emacs : " (emacs-version) "\n")
- (and pkgname
- (insert "Package: " pkgname "\n"))
- (run-hooks 'pre-hooks)
- (if (not varlist)
- nil
- (insert "\ncurrent state:\n==============\n")
- ;; create an emacs-lisp-mode buffer to contain the output, which
- ;; we'll later insert into the mail buffer
- (condition-case fault
- (let ((mailbuf (current-buffer))
- (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
- (with-current-buffer elbuf
- (emacs-lisp-mode)
- (erase-buffer)
- (insert "(setq\n")
- (lisp-indent-line)
- (mapc
- (lambda (varsym-or-cons-cell)
- (let ((varsym (or (car-safe varsym-or-cons-cell)
- varsym-or-cons-cell))
- (printer (or (cdr-safe varsym-or-cons-cell)
- 'reporter-dump-variable)))
- (funcall printer varsym mailbuf)))
- varlist)
- (lisp-indent-line)
- (insert ")\n"))
- (insert-buffer-substring elbuf))
- (error
- (insert "State could not be dumped due to the following error:\n\n"
- (format "%s" fault)
- "\n\nYou should still send this bug report."))))
- (run-hooks 'post-hooks)
- ))
+ (insert "Emacs : " (emacs-version) "\n")
+ (and pkgname
+ (insert "Package: " pkgname "\n"))
+ (reporter--run-functions pre-hooks)
+ (if (not varlist)
+ nil
+ (insert "\ncurrent state:\n==============\n")
+ ;; create an emacs-lisp-mode buffer to contain the output, which
+ ;; we'll later insert into the mail buffer
+ (condition-case fault
+ (let ((mailbuf (current-buffer))
+ (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
+ (with-current-buffer elbuf
+ (emacs-lisp-mode)
+ (erase-buffer)
+ (insert "(setq\n")
+ (lisp-indent-line)
+ (mapc
+ (lambda (varsym-or-cons-cell)
+ (let ((varsym (or (car-safe varsym-or-cons-cell)
+ varsym-or-cons-cell))
+ (printer (or (cdr-safe varsym-or-cons-cell)
+ 'reporter-dump-variable)))
+ (funcall printer varsym mailbuf)))
+ varlist)
+ (lisp-indent-line)
+ (insert ")\n"))
+ (insert-buffer-substring elbuf))
+ (error
+ (insert "State could not be dumped due to the following error:\n\n"
+ (format "%s" fault)
+ "\n\nYou should still send this bug report."))))
+ (reporter--run-functions post-hooks))
(defun reporter-compose-outgoing ()
@@ -365,7 +367,7 @@ mail-sending package is used for editing and sending the
message."
(skip-chars-backward " \t\n")
(setq reporter-initial-text (buffer-substring after-sep-pos (point))))
(if (setq hookvar (get agent 'hookvar))
- (add-hook hookvar 'reporter-bug-hook nil t))
+ (add-hook hookvar #'reporter-bug-hook nil t))
;; compose the minibuf message and display this.
(let* ((sendkey-whereis (where-is-internal
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 6979783..29460cc 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -161,13 +161,6 @@ its character representation and its display
representation.")
:version "21.1")
;;;###autoload
-(put 'rmail-spool-directory 'standard-value
- '((cond ((file-exists-p "/var/mail") "/var/mail/")
- ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
- ((memq system-type '(hpux usg-unix-v)) "/usr/mail/")
- (t "/usr/spool/mail/"))))
-
-;;;###autoload
(defcustom rmail-spool-directory
(purecopy
(cond ((file-exists-p "/var/mail")
@@ -181,12 +174,10 @@ its character representation and its display
representation.")
(t "/usr/spool/mail/")))
"Name of directory used by system mailer for delivering new mail.
Its name should end with a slash."
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:type 'directory
:group 'rmail)
-;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
-
(defcustom rmail-movemail-program nil
"If non-nil, the file name of the `movemail' program."
:group 'rmail-retrieve
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index 06da073..f9a24e3 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -35,6 +35,11 @@
It is called with one argument, the minibuffer depth,
and must return a string.")
+(defface minibuffer-depth-indicator '((t :inherit highlight))
+ "Face to use for minibuffer depth indicator."
+ :group 'minibuffer
+ :version "28.1")
+
;; An overlay covering the prompt. This is a buffer-local variable in
;; each affected minibuffer.
;;
@@ -52,7 +57,10 @@ The prompt should already have been inserted."
(overlay-put minibuffer-depth-overlay 'before-string
(if minibuffer-depth-indicator-function
(funcall minibuffer-depth-indicator-function depth)
- (propertize (format "[%d]" depth) 'face 'highlight)))
+ (concat (propertize (format "[%d]" depth)
+ 'face
+ 'minibuffer-depth-indicator)
+ " ")))
(overlay-put minibuffer-depth-overlay 'evaporate t))))
;;;###autoload
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 65fdccd..20dbb5e 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1,4 +1,4 @@
-;;; menu-bar.el --- define a default menu bar
+;;; menu-bar.el --- define a default menu bar -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
@@ -229,7 +229,8 @@
(filename (car (find-file-read-args "Find file: " mustmatch))))
(if mustmatch
(find-file-existing filename)
- (find-file filename))))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename)))))
;; The "Edit->Search" submenu
(defvar menu-bar-last-search-type nil
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index aa34fe7..dcac36f 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -463,7 +463,7 @@ Return non-nil if it is necessary to update the local UIDL
file."
(when (cdr elt)
(insert "(\"" (pop elt) "\"\n ")
(while elt
- (insert (format "\"%s\" %s\n " (pop elt) (pop elt))))
+ (insert (format "%S %s\n " (pop elt) (pop elt))))
(delete-char -4)
(insert ")\n ")))
(delete-char -3)
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 0d48fd7..96fafc8 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -385,6 +385,7 @@
)
)
(process-put proc 'socks-state socks-state-authenticated)
+ (process-put proc 'socks-scratch "")
(set-process-filter proc #'socks-filter)))
proc)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 865ea4e..b43b448 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2672,7 +2672,8 @@ The method used must be an out-of-band method."
(tramp-get-remote-null-device v))))
(save-restriction
- (let ((beg (point)))
+ (let ((beg (point))
+ (emc enable-multibyte-characters))
(narrow-to-region (point) (point))
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
@@ -2681,7 +2682,9 @@ The method used must be an out-of-band method."
(with-current-buffer (tramp-get-buffer v)
(buffer-string)))
- ;; Check for "--dired" output.
+ ;; Check for "--dired" output. We must enable unibyte
+ ;; strings, because the "--dired" output counts in bytes.
+ (set-buffer-multibyte nil)
(forward-line -2)
(when (looking-at-p "//SUBDIRED//")
(forward-line -1))
@@ -2701,6 +2704,8 @@ The method used must be an out-of-band method."
(while (looking-at "//")
(forward-line 1)
(delete-region (match-beginning 0) (point)))
+ ;; Reset multibyte if needed.
+ (set-buffer-multibyte emc)
;; Some busyboxes are reluctant to discard colors.
(unless
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index e328b6e..3916e35 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -25,7 +25,8 @@
;;; Commentary:
;; This game can be run in batch mode. To do this, use:
-;; emacs -batch -l dunnet
+;;
+;; emacs --batch -f dunnet
;;; Code:
@@ -1170,11 +1171,13 @@ treasures for points?" "4" "four")
(defun dunnet ()
"Switch to *dungeon* buffer and start game."
(interactive)
- (pop-to-buffer-same-window "*dungeon*")
- (dun-mode)
- (setq dun-dead nil)
- (setq dun-room 0)
- (dun-messages))
+ (if noninteractive
+ (dun--batch)
+ (pop-to-buffer-same-window "*dungeon*")
+ (dun-mode)
+ (setq dun-dead nil)
+ (setq dun-room 0)
+ (dun-messages)))
;;;;
;;;; This section contains all of the verbs and commands.
@@ -3126,8 +3129,7 @@ File not found")))
(dun-mprinc "\n")
(dun-batch-loop))
-;;;###autoload
-(defun dun-batch ()
+(defun dun--batch ()
"Start `dunnet' in batch mode."
(fset 'dun-mprinc #'dun-batch-mprinc)
(fset 'dun-mprincl #'dun-batch-mprincl)
@@ -3140,6 +3142,17 @@ File not found")))
(setq dun-batch-mode t)
(dun-batch-loop))
+;; Apparently, there are many references out there to running us via
+;;
+;; emacs --batch -l dunnet
+;;
+;; So try and accommodate those without interfering with other cases
+;; where `dunnet.el' might be loaded in batch mode with no intention
+;; to run the game.
+(when (and noninteractive
+ (equal '("-l" "dunnet") (member "-l" command-line-args)))
+ (dun--batch))
+
(provide 'dunnet)
;; Local Variables:
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index fddc13f..460af71 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,7 +4,7 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
-;; Version: 1.1.0
+;; Version: 1.1.1
;; Keywords: c languages tools
;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
@@ -1283,6 +1283,8 @@ correctly.")
(when (flymake-running-backends) flymake-mode-line-counter-format))
(defun flymake--mode-line-counter (type &optional no-space)
+ "Compute number of diagnostics in buffer with TYPE's severity.
+TYPE is usually keyword `:error', `:warning' or `:note'."
(let ((count 0)
(face (flymake--lookup-type-property type
'mode-line-face
@@ -1290,7 +1292,8 @@ correctly.")
(maphash (lambda
(_b state)
(dolist (d (flymake--backend-state-diags state))
- (when (eq type (flymake--diag-type d))
+ (when (= (flymake--severity type)
+ (flymake--severity (flymake--diag-type d)))
(cl-incf count))))
flymake--backend-state)
(when (or (cl-plusp count)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index ec20b01..2a2a497 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -324,13 +324,33 @@
;; disambiguate with the left-bitshift operator.
"\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
- (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table))
+ (4 (let* ((eol (match-beginning 4))
+ (st (get-text-property eol 'syntax-table))
(name (match-string 2))
(indented (match-beginning 1)))
(goto-char (match-end 2))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ ;; '<<' occurred in a string, or in a comment.
;; Leave the property of the newline unchanged.
st
+ ;; Beware of `foo <<'BAR' #baz` because
+ ;; the newline needs to start the here-doc
+ ;; and can't be used to close the comment.
+ (let ((eol-state (save-excursion (syntax-ppss eol))))
+ (when (nth 4 eol-state)
+ (if (/= (1- eol) (nth 8 eol-state))
+ ;; make the last char of the comment closing it
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax ">"))
+ ;; In `foo <<'BAR' #` the # is the last character
+ ;; before eol and can't both open and close the
+ ;; comment. Workaround: disguise the "#" as
+ ;; whitespace and fontify it as a comment.
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax "-"))
+ (put-text-property (1- eol) eol
+ 'font-lock-face
+ 'font-lock-comment-face))))
(cons (car (string-to-syntax "< c"))
;; Remember the names of heredocs found on this line.
(cons (cons (pcase (aref name 0)
@@ -483,8 +503,15 @@
;; as twoarg).
(perl-syntax-propertize-special-constructs limit)))))))))
+(defface perl-heredoc
+ '((t (:inherit font-lock-string-face)))
+ "The face for here-documents. Inherits from font-lock-string-face.")
+
(defun perl-font-lock-syntactic-face-function (state)
(cond
+ ((and (eq 2 (nth 7 state)) ; c-style comment
+ (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc
+ 'perl-heredoc)
((and (nth 3 state)
(eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
;; This is a second-arg of s{..}{...} form; let's check if this second
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index d417382..62c3cf4 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -291,7 +291,8 @@ to find the list of ignores for each directory."
(localdir (file-local-name (expand-file-name dir)))
(command (format "%s %s %s -type f %s -print0"
find-program
- localdir
+ ;; In case DIR is a symlink.
+ (file-name-as-directory localdir)
(xref--find-ignores-arguments ignores localdir)
(if files
(concat (shell-quote-argument "(")
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 3effb6ed..a8667ac 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1598,13 +1598,16 @@ See `add-log-current-defun-function'."
(let* ((indent 0) mname mlist
(start (point))
(make-definition-re
- (lambda (re)
+ (lambda (re &optional method-name?)
(concat "^[ \t]*" re "[ \t]+"
"\\("
;; \\. and :: for class methods
- "\\([A-Za-z_]" ruby-symbol-re "*[?!]?\\|\\.\\|::"
"\\)"
+ "\\([A-Za-z_]" ruby-symbol-re "*[?!]?"
+ "\\|"
+ (if method-name? ruby-operator-re "\\.")
+ "\\|::" "\\)"
"+\\)")))
- (definition-re (funcall make-definition-re ruby-defun-beg-re))
+ (definition-re (funcall make-definition-re ruby-defun-beg-re t))
(module-re (funcall make-definition-re "\\(class\\|module\\)")))
;; Get the current method definition (or class/module).
(when (re-search-backward definition-re nil t)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 2fefc23..d3b6ae7 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -928,8 +928,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(or
(assoc-default 'fetched-xrefs alist)
(funcall fetcher)))
- (xref-alist (xref--analyze xrefs)))
+ (xref-alist (xref--analyze xrefs))
+ (dd default-directory))
(with-current-buffer (get-buffer-create xref-buffer-name)
+ (setq default-directory dd)
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer))
@@ -992,13 +994,15 @@ When only one definition found, jump to it right away
instead."
When there is more than one definition, split the selected window
and show the list in a small window at the bottom. And use a
local keymap that binds `RET' to `xref-quit-and-goto-xref'."
- (let ((xrefs (funcall fetcher)))
+ (let ((xrefs (funcall fetcher))
+ (dd default-directory))
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
(with-current-buffer (get-buffer-create xref-buffer-name)
+ (setq default-directory dd)
(xref--transient-buffer-mode)
(xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
(pop-to-buffer (current-buffer)
@@ -1374,7 +1378,8 @@ IGNORES is a list of glob patterns for files to ignore."
;; do that reliably enough, without creating false negatives?
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
files
- (file-local-name (expand-file-name dir))
+ (file-name-as-directory
+ (file-local-name (expand-file-name dir)))
ignores))
(def default-directory)
(buf (get-buffer-create " *xref-grep*"))
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index f9842b5..378358f 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -1,4 +1,4 @@
-;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
+;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
-*- lexical-binding: t; -*-
;;
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 802cb30..eecdb60 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -1,4 +1,4 @@
-;;; scroll-bar.el --- window system-independent scroll bar support
+;;; scroll-bar.el --- window system-independent scroll bar support -*-
lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc.
diff --git a/lisp/startup.el b/lisp/startup.el
index 30ce379..4b82f73 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1230,17 +1230,7 @@ please check its value")
package-enable-at-startup
(not (bound-and-true-p package--activated))
(catch 'package-dir-found
- (let (dirs)
- (if (boundp 'package-directory-list)
- (setq dirs package-directory-list)
- (dolist (f load-path)
- (and (stringp f)
- (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) dirs))))
- (push (if (boundp 'package-user-dir)
- package-user-dir
- (locate-user-emacs-file "elpa"))
- dirs)
+ (let ((dirs (cons package-user-dir package-directory-list)))
(dolist (dir dirs)
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
diff --git a/lisp/subr.el b/lisp/subr.el
index 1acc3c3..2602029 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -995,6 +995,22 @@ a menu, so this function is not useful for non-menu
keymaps."
(setq inserted t)))
(setq tail (cdr tail)))))
+(defun define-prefix-command (command &optional mapvar name)
+ "Define COMMAND as a prefix command. COMMAND should be a symbol.
+A new sparse keymap is stored as COMMAND's function definition and its
+value.
+This prepares COMMAND for use as a prefix key's binding.
+If a second optional argument MAPVAR is given, it should be a symbol.
+The map is then stored as MAPVAR's value instead of as COMMAND's
+value; but COMMAND is still defined as a function.
+The third optional argument NAME, if given, supplies a menu name
+string for the map. This is required to use the keymap as a menu.
+This function returns COMMAND."
+ (let ((map (make-sparse-keymap name)))
+ (fset command map)
+ (set (or mapvar command) map)
+ command))
+
(defun map-keymap-sorted (function keymap)
"Implement `map-keymap' with sorting.
Don't call this function; it is for internal use only."
@@ -1239,35 +1255,83 @@ in a cleaner way with command remapping, like this:
;;;; The global keymap tree.
-;; global-map, esc-map, and ctl-x-map have their values set up in
-;; keymap.c; we just give them docstrings here.
-
-(defvar global-map nil
- "Default global keymap mapping Emacs keyboard input into commands.
-The value is a keymap that is usually (but not necessarily) Emacs's
-global map.")
-
-(defvar esc-map nil
+(defvar esc-map
+ (let ((map (make-keymap)))
+ (define-key map "u" #'upcase-word)
+ (define-key map "l" #'downcase-word)
+ (define-key map "c" #'capitalize-word)
+ (define-key map "x" #'execute-extended-command)
+ map)
"Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")
-
-(defvar ctl-x-map nil
- "Default keymap for C-x commands.
-The normal global definition of the character C-x indirects to this keymap.")
+(fset 'ESC-prefix esc-map)
+(make-obsolete 'ESC-prefix 'esc-map "28.1")
(defvar ctl-x-4-map (make-sparse-keymap)
"Keymap for subcommands of C-x 4.")
(defalias 'ctl-x-4-prefix ctl-x-4-map)
-(define-key ctl-x-map "4" 'ctl-x-4-prefix)
(defvar ctl-x-5-map (make-sparse-keymap)
"Keymap for frame commands.")
(defalias 'ctl-x-5-prefix ctl-x-5-map)
-(define-key ctl-x-map "5" 'ctl-x-5-prefix)
(defvar tab-prefix-map (make-sparse-keymap)
"Keymap for tab-bar related commands.")
-(define-key ctl-x-map "t" tab-prefix-map)
+
+(defvar ctl-x-map
+ (let ((map (make-keymap)))
+ (define-key map "4" 'ctl-x-4-prefix)
+ (define-key map "5" 'ctl-x-5-prefix)
+ (define-key map "t" tab-prefix-map)
+
+ (define-key map "b" #'switch-to-buffer)
+ (define-key map "k" #'kill-buffer)
+ (define-key map "\C-u" #'upcase-region) (put 'upcase-region 'disabled
t)
+ (define-key map "\C-l" #'downcase-region) (put 'downcase-region 'disabled
t)
+ (define-key map "<" #'scroll-left)
+ (define-key map ">" #'scroll-right)
+ map)
+ "Default keymap for C-x commands.
+The normal global definition of the character C-x indirects to this keymap.")
+(fset 'Control-X-prefix ctl-x-map)
+(make-obsolete 'Control-X-prefix 'ctl-x-map "28.1")
+
+(defvar global-map
+ (let ((map (make-keymap)))
+ (define-key map "\C-[" 'ESC-prefix)
+ (define-key map "\C-x" 'Control-X-prefix)
+
+ (define-key map "\C-i" #'self-insert-command)
+ (let* ((vec1 (make-vector 1 nil))
+ (f (lambda (from to)
+ (while (< from to)
+ (aset vec1 0 from)
+ (define-key map vec1 #'self-insert-command)
+ (setq from (1+ from))))))
+ (funcall f #o040 #o0177)
+ (when (eq system-type 'ms-dos) ;FIXME: Why?
+ (funcall f #o0200 #o0240))
+ (funcall f #o0240 #o0400))
+
+ (define-key map "\C-a" #'beginning-of-line)
+ (define-key map "\C-b" #'backward-char)
+ (define-key map "\C-e" #'end-of-line)
+ (define-key map "\C-f" #'forward-char)
+
+ (define-key map "\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
+ (define-key map "\C-x\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
+
+ (define-key map "\C-v" #'scroll-up-command)
+ (define-key map "\M-v" #'scroll-down-command)
+ (define-key map "\M-\C-v" #'scroll-other-window)
+
+ (define-key map "\M-\C-c" #'exit-recursive-edit)
+ (define-key map "\C-]" #'abort-recursive-edit)
+ map)
+ "Default global keymap mapping Emacs keyboard input into commands.
+The value is a keymap that is usually (but not necessarily) Emacs's
+global map.")
+(use-global-map global-map)
;;;; Event manipulation functions.
@@ -1749,7 +1813,11 @@ unless HOOK has both local and global functions). If
multiple
functions have the same representation under `princ', the first
one will be removed."
(interactive
- (let* ((hook (intern (completing-read "Hook variable: " obarray #'boundp
t)))
+ (let* ((default (and (symbolp (variable-at-point))
+ (symbol-name (variable-at-point))))
+ (hook (intern (completing-read
+ (format-prompt "Hook variable" default)
+ obarray #'boundp t nil nil default)))
(local
(and
(local-variable-p hook)
@@ -1806,9 +1874,33 @@ all symbols are bound before any of the VALUEFORMs are
evalled."
;; As a special-form, we could implement it more efficiently (and cleanly,
;; making the vars actually unbound during evaluation of the binders).
(declare (debug let) (indent 1))
- `(let ,(mapcar #'car binders)
- ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
- ,@body))
+ ;; Use plain `let*' for the non-recursive definitions.
+ ;; This only handles the case where the first few definitions are not
+ ;; recursive. Nothing as fancy as an SCC analysis.
+ (let ((seqbinds nil))
+ ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
+ ;; may fail to see references that will be introduced later by
+ ;; macroexpansion. We could call `macroexpand-all' to avoid that,
+ ;; but in order to avoid that, we instead check to see if the binders
+ ;; appear in the macroexp environment, since that's how references can be
+ ;; introduced later on.
+ (unless (macroexp--fgrep binders macroexpand-all-environment)
+ (while (and binders
+ (null (macroexp--fgrep binders (nth 1 (car binders)))))
+ (push (pop binders) seqbinds)))
+ (let ((nbody (if (null binders)
+ (macroexp-progn body)
+ `(let ,(mapcar #'car binders)
+ ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
+ ,@body))))
+ (cond
+ ;; All bindings are recursive.
+ ((null seqbinds) nbody)
+ ;; Special case for trivial uses.
+ ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
+ (nth 1 (car seqbinds)))
+ ;; General case.
+ (t `(let* ,(nreverse seqbinds) ,nbody))))))
(defmacro dlet (binders &rest body)
"Like `let*' but using dynamic scoping."
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 935c97e..7e55655 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -95,23 +95,26 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
:version "27.1")
-(define-minor-mode tab-bar-mode
- "Toggle the tab bar in all graphical frames (Tab Bar mode)."
- :global t
- ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
- :variable tab-bar-mode
- (let ((val (if tab-bar-mode 1 0)))
- (dolist (frame (frame-list))
- (set-frame-parameter frame 'tab-bar-lines val))
- ;; If the user has given `default-frame-alist' a `tab-bar-lines'
- ;; parameter, replace it.
- (if (assq 'tab-bar-lines default-frame-alist)
- (setq default-frame-alist
- (cons (cons 'tab-bar-lines val)
- (assq-delete-all 'tab-bar-lines
- default-frame-alist)))))
-
- (when (and tab-bar-mode tab-bar-new-button
+(defun tab-bar--define-keys ()
+ "Install key bindings for switching between tabs if the user has configured
them."
+ (when tab-bar-select-tab-modifiers
+ (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
+ 'tab-bar-switch-to-recent-tab)
+ (dotimes (i 9)
+ (global-set-key (vector (append tab-bar-select-tab-modifiers
+ (list (+ i 1 ?0))))
+ 'tab-bar-select-tab)))
+ ;; Don't override user customized key bindings
+ (unless (global-key-binding [(control tab)])
+ (global-set-key [(control tab)] 'tab-next))
+ (unless (global-key-binding [(control shift tab)])
+ (global-set-key [(control shift tab)] 'tab-previous))
+ (unless (global-key-binding [(control shift iso-lefttab)])
+ (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
+
+(defun tab-bar--load-buttons ()
+ "Load the icons for the tab buttons."
+ (when (and tab-bar-new-button
(not (get-text-property 0 'display tab-bar-new-button)))
;; This file is pre-loaded so only here we can use the right
data-directory:
(add-text-properties 0 (length tab-bar-new-button)
@@ -121,7 +124,7 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
:ascent center))
tab-bar-new-button))
- (when (and tab-bar-mode tab-bar-close-button
+ (when (and tab-bar-close-button
(not (get-text-property 0 'display tab-bar-close-button)))
;; This file is pre-loaded so only here we can use the right
data-directory:
(add-text-properties 0 (length tab-bar-close-button)
@@ -129,24 +132,27 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
:file "tabs/close.xpm"
:margin (2 . 0)
:ascent center))
- tab-bar-close-button))
+ tab-bar-close-button)))
+(define-minor-mode tab-bar-mode
+ "Toggle the tab bar in all graphical frames (Tab Bar mode)."
+ :global t
+ ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
+ :variable tab-bar-mode
+ (let ((val (if tab-bar-mode 1 0)))
+ (dolist (frame (frame-list))
+ (set-frame-parameter frame 'tab-bar-lines val))
+ ;; If the user has given `default-frame-alist' a `tab-bar-lines'
+ ;; parameter, replace it.
+ (if (assq 'tab-bar-lines default-frame-alist)
+ (setq default-frame-alist
+ (cons (cons 'tab-bar-lines val)
+ (assq-delete-all 'tab-bar-lines
+ default-frame-alist)))))
+ (when tab-bar-mode
+ (tab-bar--load-buttons))
(if tab-bar-mode
- (progn
- (when tab-bar-select-tab-modifiers
- (global-set-key (vector (append tab-bar-select-tab-modifiers (list
?0)))
- 'tab-bar-switch-to-recent-tab)
- (dotimes (i 9)
- (global-set-key (vector (append tab-bar-select-tab-modifiers
- (list (+ i 1 ?0))))
- 'tab-bar-select-tab)))
- ;; Don't override user customized key bindings
- (unless (global-key-binding [(control tab)])
- (global-set-key [(control tab)] 'tab-next))
- (unless (global-key-binding [(control shift tab)])
- (global-set-key [(control shift tab)] 'tab-previous))
- (unless (global-key-binding [(control shift iso-lefttab)])
- (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
+ (tab-bar--define-keys)
;; Unset only keys bound by tab-bar
(when (eq (global-key-binding [(control tab)]) 'tab-next)
(global-unset-key [(control tab)]))
@@ -181,15 +187,27 @@ on a console which has no window system but does have a
mouse."
;; Clicking anywhere outside existing tabs will add a new tab
(tab-bar-new-tab)))))
-;; Used in the Show/Hide menu, to have the toggle reflect the current frame.
(defun toggle-tab-bar-mode-from-frame (&optional arg)
"Toggle tab bar on or off, based on the status of the current frame.
+Used in the Show/Hide menu, to have the toggle reflect the current frame.
See `tab-bar-mode' for more information."
(interactive (list (or current-prefix-arg 'toggle)))
(if (eq arg 'toggle)
(tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1))
(tab-bar-mode arg)))
+(defun toggle-frame-tab-bar (&optional frame)
+ "Toggle tab bar of FRAME.
+This is useful when you want to enable the tab bar individually
+on each new frame when the global `tab-bar-mode' is disabled,
+or when you want to disable the tab bar individually on each
+new frame when the global `tab-bar-mode' is enabled, by using
+
+ (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
+ (interactive)
+ (set-frame-parameter frame 'tab-bar-lines
+ (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)))
+
(defvar tab-bar-map (make-sparse-keymap)
"Keymap for the tab bar.
Define this locally to override the global tab bar.")
@@ -218,18 +236,31 @@ If the value is `1', then hide the tab bar when it has
only one tab,
and show it again once more tabs are created.
If nil, always keep the tab bar hidden. In this case it's still
possible to use persistent named window configurations by relying on
-keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc."
+keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc.
+
+Setting this variable directly does not take effect; please customize
+it (see the info node `Easy Customization'), then it will automatically
+update the tab bar on all frames according to the new value.
+
+To enable or disable the tab bar individually on each frame,
+you can use the command `toggle-frame-tab-bar'."
:type '(choice (const :tag "Always" t)
(const :tag "When more than one tab" 1)
(const :tag "Never" nil))
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
- (tab-bar-mode
- (if (or (eq val t)
- (and (natnump val)
- (> (length (funcall tab-bar-tabs-function)) val)))
- 1 -1)))
+ ;; Preload button images
+ (tab-bar-mode 1)
+ ;; Then handle each frame individually
+ (dolist (frame (frame-list))
+ (set-frame-parameter
+ frame 'tab-bar-lines
+ (if (or (eq val t)
+ (and (natnump val)
+ (> (length (funcall tab-bar-tabs-function frame))
+ val)))
+ 1 0))))
:group 'tab-bar
:version "27.1")
@@ -418,6 +449,30 @@ Return its existing value or a new value."
tabs))
+(defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default
+ "Function to format a tab name.
+Function gets two arguments, the tab and its number, and should return
+the formatted tab name to display in the tab bar."
+ :type 'function
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-name-format-default (tab i)
+ (let ((current-p (eq (car tab) 'current-tab)))
+ (propertize
+ (concat (if tab-bar-tab-hints (format "%d " i) "")
+ (alist-get 'name tab)
+ (or (and tab-bar-close-button-show
+ (not (eq tab-bar-close-button-show
+ (if current-p 'non-selected 'selected)))
+ tab-bar-close-button)
+ ""))
+ 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive))))
+
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
(let* ((separator (or tab-bar-separator (if window-system " " "|")))
@@ -443,25 +498,13 @@ Return its existing value or a new value."
((eq (car tab) 'current-tab)
`((current-tab
menu-item
- ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
- (alist-get 'name tab)
- (or (and tab-bar-close-button-show
- (not (eq tab-bar-close-button-show
- 'non-selected))
- tab-bar-close-button) ""))
- 'face 'tab-bar-tab)
+ ,(funcall tab-bar-tab-name-format-function tab i)
ignore
:help "Current tab")))
(t
`((,(intern (format "tab-%i" i))
menu-item
- ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
- (alist-get 'name tab)
- (or (and tab-bar-close-button-show
- (not (eq tab-bar-close-button-show
- 'selected))
- tab-bar-close-button) ""))
- 'face 'tab-bar-tab-inactive)
+ ,(funcall tab-bar-tab-name-format-function tab i)
,(or
(alist-get 'binding tab)
`(lambda ()
@@ -815,7 +858,10 @@ After the tab is created, the hooks in
((and (natnump tab-bar-show)
(> (length (funcall tab-bar-tabs-function)) tab-bar-show)
(zerop (frame-parameter nil 'tab-bar-lines)))
- (set-frame-parameter nil 'tab-bar-lines 1)))
+ (progn
+ (tab-bar--load-buttons)
+ (tab-bar--define-keys)
+ (set-frame-parameter nil 'tab-bar-lines 1))))
(force-mode-line-update)
(unless tab-bar-mode
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 8d5cb19..8ae5871 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -1,4 +1,4 @@
-;;; common-win.el --- common part of handling window systems
+;;; common-win.el --- common part of handling window systems -*-
lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 1aeaffb..740d065 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -1,4 +1,4 @@
-;;; tty-colors.el --- color support for character terminals
+;;; tty-colors.el --- color support for character terminals -*-
lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index e9bef6e..3346c55 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,4 +1,4 @@
-;;; fill.el --- fill commands for Emacs
+;;; fill.el --- fill commands for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free
;; Software Foundation, Inc.
@@ -40,13 +40,11 @@ Non-nil means changing indent doesn't end a paragraph.
That mode can handle paragraphs with extra indentation on the first line,
but it requires separator lines between paragraphs.
A value of nil means that any change in indentation starts a new paragraph."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defcustom colon-double-space nil
"Non-nil means put two spaces after a colon when filling."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(put 'colon-double-space 'safe-local-variable 'booleanp)
(defcustom fill-separate-heterogeneous-words-with-space nil
@@ -56,7 +54,6 @@ the beginning of the next line when concatenating them for
filling those lines. Whether to use a space depends on how the
words are categorized."
:type 'boolean
- :group 'fill
:version "26.1")
(defvar fill-paragraph-function nil
@@ -75,8 +72,7 @@ such as `fill-forward-paragraph-function'.")
Kinsoku processing is designed to prevent certain characters from being
placed at the beginning or end of a line by filling.
See the documentation of `kinsoku' for more information."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defun set-fill-prefix ()
"Set the fill prefix to the current line up to point.
@@ -96,8 +92,7 @@ reinserts the fill prefix in each resulting line."
(defcustom adaptive-fill-mode t
"Non-nil means determine a paragraph's fill prefix from its text."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defcustom adaptive-fill-regexp
;; Added `!' for doxygen comments starting with `//!' or `/*!'.
@@ -113,8 +108,7 @@ standard indentation for the whole paragraph.
If the paragraph has just one line, the indentation is taken from that
line, but in that case `adaptive-fill-first-line-regexp' also plays
a role."
- :type 'regexp
- :group 'fill)
+ :type 'regexp)
(defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'")
"Regexp specifying whether to set fill prefix from a one-line paragraph.
@@ -126,15 +120,13 @@ By default, this regexp matches sequences of just spaces
and tabs.
However, we never use a prefix from a one-line paragraph
if it would act as a paragraph-starter on the second line."
- :type 'regexp
- :group 'fill)
+ :type 'regexp)
(defcustom adaptive-fill-function #'ignore
"Function to call to choose a fill prefix for a paragraph.
A nil return value means the function has not determined the fill prefix."
:version "27.1"
- :type 'function
- :group 'fill)
+ :type 'function)
(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
"Whether or not filling should try to use the major mode's indentation.")
@@ -367,15 +359,13 @@ which is an error according to some typographical
conventions."
The predicates are called with no arguments, with point at the place to
be tested. If it returns a non-nil value, fill commands do not break
the line there."
- :group 'fill
:type 'hook
:options '(fill-french-nobreak-p fill-single-word-nobreak-p
fill-single-char-nobreak-p))
(defcustom fill-nobreak-invisible nil
"Non-nil means that fill commands do not break lines in invisible text."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defun fill-nobreak-p ()
"Return nil if breaking the line at point is allowed.
@@ -1110,8 +1100,7 @@ The `justification' text-property can locally override
this variable."
(const full)
(const center)
(const none))
- :safe 'symbolp
- :group 'fill)
+ :safe 'symbolp)
(make-variable-buffer-local 'default-justification)
(defun current-justification ()
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 217ae10..96edfd6 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -371,50 +371,33 @@ See `forward-paragraph' for more information."
(defun mark-paragraph (&optional arg allow-extend)
"Put point at beginning of this paragraph, mark at end.
-The paragraph marked is the one that contains point or follows
-point.
+The paragraph marked is the one that contains point or follows point.
-With argument ARG, puts mark at the end of this or a following
-paragraph, so that the number of paragraphs marked equals ARG.
+With argument ARG, puts mark at end of a following paragraph, so that
+the number of paragraphs marked equals ARG.
-If ARG is negative, point is put at the end of this paragraph,
-mark is put at the beginning of this or a previous paragraph.
+If ARG is negative, point is put at end of this paragraph, mark is put
+at beginning of this or a previous paragraph.
Interactively (or if ALLOW-EXTEND is non-nil), if this command is
-repeated or (in Transient Mark mode) if the mark is active, it
-marks the next ARG paragraphs after the region already marked.
-This also means when activating the mark immediately before using
-this command, the current paragraph is only marked from point."
- (interactive "P\np")
- (let ((numeric-arg (prefix-numeric-value arg)))
- (cond ((zerop numeric-arg))
- ((and allow-extend
- (or (and (eq last-command this-command) mark-active)
- (region-active-p)))
- (if arg
- (setq arg numeric-arg)
- (if (< (mark) (point))
- (setq arg -1)
- (setq arg 1)))
- (set-mark
- (save-excursion
- (goto-char (mark))
- (forward-paragraph arg)
- (point))))
- ;; don't activate the mark when at eob
- ((and (eobp) (> numeric-arg 0)))
- (t
- (unless (save-excursion
- (forward-line 0)
- (looking-at paragraph-start))
- (backward-paragraph (cond ((> numeric-arg 0) 1)
- ((< numeric-arg 0) -1)
- (t 0))))
- (push-mark
- (save-excursion
- (forward-paragraph numeric-arg)
- (point))
- t t)))))
+repeated or (in Transient Mark mode) if the mark is active,
+it marks the next ARG paragraphs after the ones already marked."
+ (interactive "p\np")
+ (unless arg (setq arg 1))
+ (when (zerop arg)
+ (error "Cannot mark zero paragraphs"))
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-paragraph arg)
+ (point))))
+ (t
+ (forward-paragraph arg)
+ (push-mark nil t t)
+ (backward-paragraph arg))))
(defun kill-paragraph (arg)
"Kill forward to end of paragraph.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 073059d..d4c1b87 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -906,7 +906,8 @@ DOWNCASE t: Downcase words before using them."
;; begin, optional spaces and opening brace
"begin[[:space:]]*{"
;; Build a regexp for env names
- (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray"))
+ (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
+ "darray" "frame"))
;; closing brace, optional spaces
"}[[:space:]]*"
;; Now for macros
@@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them."
"\\[[^][]*"
;; Allow nested levels of chars enclosed in braces
"\\(?:{[^}{]*"
- "\\(?:{[^}{]*"
- "\\(?:{[^}{]*}[^}{]*\\)*"
- "}[^}{]*\\)*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*}[^}{]*\\)*"
+ "}[^}{]*\\)*"
"}[^][]*\\)*"
;; Match the label key
"\\<label[[:space:]]*=[[:space:]]*"
@@ -944,7 +945,7 @@ you have to define it using \\(?1:...\\) when adding new
regexps.
When changed from Lisp, make sure to call
`reftex-compile-variables' afterwards to make the change
effective."
- :version "27.1"
+ :version "28.1"
:set (lambda (symbol value)
(set symbol value)
(when (fboundp 'reftex-compile-variables)
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 3da24c8..9ef2da7 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -1,4 +1,4 @@
-;;; w32-fns.el --- Lisp routines for 32-bit Windows
+;;; w32-fns.el --- Lisp routines for 32-bit Windows -*- lexical-binding: t;
-*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@@ -383,10 +383,10 @@ for any permissions.
This is required because the Windows build environment is not required
to include Sed, which is used by leim/Makefile.in to do the job."
- (find-file orig)
- (goto-char (point-max))
- (insert-file-contents extra)
- (delete-matching-lines "^$\\|^;")
- (save-buffers-kill-emacs t))
+ (with-current-buffer (find-file-noselect orig)
+ (goto-char (point-max))
+ (insert-file-contents extra)
+ (delete-matching-lines "^$\\|^;")
+ (save-buffers-kill-emacs t)))
;;; w32-fns.el ends here
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index f920130..8b10d71 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1204,7 +1204,6 @@ This is much faster.")
ARG may be negative to move backward.
When the second optional argument is non-nil,
nothing is shown in the echo area."
- (or (bobp) (> arg 0) (backward-char))
(let ((wrapped 0)
(number arg)
(old (widget-tabable-at)))
diff --git a/lisp/widget.el b/lisp/widget.el
index de690ad..401b4cf 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -1,4 +1,4 @@
-;;; widget.el --- a library of user interface components
+;;; widget.el --- a library of user interface components -*- lexical-binding:
t; -*-
;;
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;;
diff --git a/lisp/window.el b/lisp/window.el
index cd13e66..38be778 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -7243,6 +7243,7 @@ The actual non-nil value of this variable will be copied
to the
(const display-buffer-below-selected)
(const display-buffer-at-bottom)
(const display-buffer-in-previous-window)
+ (const display-buffer-use-least-recent-window)
(const display-buffer-use-some-window)
(const display-buffer-use-some-frame)
(function :tag "Other function"))
@@ -7378,6 +7379,37 @@ fails, call `display-buffer-pop-up-frame'.")
(defun display-buffer (buffer-or-name &optional action frame)
"Display BUFFER-OR-NAME in some window, without selecting it.
+To change which window is used, set `display-buffer-alist'
+to an expression containing one of these \"action\" functions:
+
+ `display-buffer-same-window' -- Use the selected window.
+ `display-buffer-reuse-window' -- Use a window already showing
+ the buffer.
+ `display-buffer-in-previous-window' -- Use a window that did
+ show the buffer before.
+ `display-buffer-use-some-window' -- Use some existing window.
+ `display-buffer-use-least-recent-window' -- Try to avoid re-using
+ windows that have recently been switched to.
+ `display-buffer-pop-up-window' -- Pop up a new window.
+ `display-buffer-below-selected' -- Use or pop up a window below
+ the selected one.
+ `display-buffer-at-bottom' -- Use or pop up a window at the
+ bottom of the selected frame.
+ `display-buffer-pop-up-frame' -- Show the buffer on a new frame.
+ `display-buffer-in-child-frame' -- Show the buffer in a
+ child frame.
+ `display-buffer-no-window' -- Do not display the buffer and
+ have `display-buffer' return nil immediately.
+
+For instance:
+
+ (setq display-buffer-alist '((\".*\" display-buffer-at-bottom)))
+
+Buffer display can be further customized to a very high degree;
+the rest of this docstring explains some of the many
+possibilities, and also see `(emacs)Window Choice' for more
+information.
+
BUFFER-OR-NAME must be a buffer or a string naming a live buffer.
Return the window chosen for displaying that buffer, or nil if no
such window is found.
@@ -7403,23 +7435,8 @@ function in the combined function list in turn, passing
the
buffer as the first argument and the combined action alist as the
second argument, until one of the functions returns non-nil.
-Action functions and the action they try to perform are:
- `display-buffer-same-window' -- Use the selected window.
- `display-buffer-reuse-window' -- Use a window already showing
- the buffer.
- `display-buffer-in-previous-window' -- Use a window that did
- show the buffer before.
- `display-buffer-use-some-window' -- Use some existing window.
- `display-buffer-pop-up-window' -- Pop up a new window.
- `display-buffer-below-selected' -- Use or pop up a window below
- the selected one.
- `display-buffer-at-bottom' -- Use or pop up a window at the
- bottom of the selected frame.
- `display-buffer-pop-up-frame' -- Show the buffer on a new frame.
- `display-buffer-in-child-frame' -- Show the buffer in a
- child frame.
- `display-buffer-no-window' -- Do not display the buffer and
- have `display-buffer' return nil immediately.
+See above for the action functions and the action they try to
+perform.
Action alist entries are:
`inhibit-same-window' -- A non-nil value prevents the same
@@ -8242,6 +8259,16 @@ indirectly called by the latter."
(when (setq window (or best-window second-best-window))
(window--display-buffer buffer window 'reuse alist))))
+(defun display-buffer-use-least-recent-window (buffer alist)
+ "Display BUFFER in an existing window, but that hasn't been used lately.
+This `display-buffer' action function is like
+`display-buffer-use-some-window', but will cycle through windows
+when displaying buffers repeatedly, and if there's only a single
+window, it will split the window."
+ (when-let ((window (display-buffer-use-some-window
+ buffer (cons (cons 'inhibit-same-window t) alist))))
+ (window-bump-use-time window)))
+
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
Search for a usable window, set that window to the buffer, and
diff --git a/src/buffer.c b/src/buffer.c
index 81f7d92..71ad5ed 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2602,8 +2602,6 @@ current buffer is cleared. */)
p += bytes, pos += bytes;
}
}
- if (narrowed)
- Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
}
else
{
@@ -2682,9 +2680,6 @@ current buffer is cleared. */)
if (pt != PT)
TEMP_SET_PT (pt);
- if (narrowed)
- Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
-
/* Do this first, so that chars_in_text asks the right question.
set_intervals_multibyte needs it too. */
bset_enable_multibyte_characters (current_buffer, Qt);
@@ -6385,10 +6380,3 @@ nil NORECORD argument since it may lead to infinite
recursion. */);
Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
}
-
-void
-keys_of_buffer (void)
-{
- initial_define_key (control_x_map, 'b', "switch-to-buffer");
- initial_define_key (control_x_map, 'k', "kill-buffer");
-}
diff --git a/src/callproc.c b/src/callproc.c
index 8d2a561..1da315b 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -314,6 +314,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
char *tempfile = NULL;
#else
+ sigset_t oldset;
pid_t pid = -1;
#endif
int child_errno;
@@ -601,9 +602,12 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
#ifndef MSDOS
+ block_input ();
+ block_child_signal (&oldset);
+
child_errno
= emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
- SSDATA (current_dir), NULL);
+ SSDATA (current_dir), NULL, &oldset);
eassert ((child_errno == 0) == (0 < pid));
if (pid > 0)
@@ -624,6 +628,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
}
}
+ unblock_child_signal (&oldset);
+ unblock_input ();
+
if (pid < 0)
report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
@@ -1227,17 +1234,21 @@ child_setup (int in, int out, int err, char **new_argv,
char **env,
process image file ARGV[0]. Use ENVP for the environment block for
the new process. Use CWD as working directory for the new process.
If PTY is not NULL, it must be a pseudoterminal device. If PTY is
- NULL, don't perform any terminal setup. */
+ NULL, don't perform any terminal setup. OLDSET must be a pointer
+ to a signal set initialized by `block_child_signal'. Before
+ calling this function, call `block_input' and `block_child_signal';
+ afterwards, call `unblock_input' and `unblock_child_signal'. Be
+ sure to call `unblock_child_signal' only after registering NEWPID
+ in a list where `handle_child_signal' can find it! */
int
emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
- char **argv, char **envp, const char *cwd, const char *pty)
+ char **argv, char **envp, const char *cwd,
+ const char *pty, const sigset_t *oldset)
{
- sigset_t oldset;
int pid;
- block_input ();
- block_child_signal (&oldset);
+ eassert (input_blocked_p ());
#ifndef WINDOWSNT
/* vfork, and prevent local vars from being clobbered by the vfork. */
@@ -1249,6 +1260,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
int volatile stdout_volatile = std_out;
int volatile stderr_volatile = std_err;
char **volatile envp_volatile = envp;
+ const sigset_t *volatile oldset_volatile = oldset;
#ifdef DARWIN_OS
/* Darwin doesn't let us run setsid after a vfork, so use fork when
@@ -1270,6 +1282,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
std_out = stdout_volatile;
std_err = stderr_volatile;
envp = envp_volatile;
+ oldset = oldset_volatile;
if (pid == 0)
#endif /* not WINDOWSNT */
@@ -1364,7 +1377,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
#endif
/* Stop blocking SIGCHLD in the child. */
- unblock_child_signal (&oldset);
+ unblock_child_signal (oldset);
if (pty_flag)
child_setup_tty (std_out);
@@ -1382,10 +1395,6 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int
std_err,
int vfork_error = pid < 0 ? errno : 0;
- /* Stop blocking in the parent. */
- unblock_child_signal (&oldset);
- unblock_input ();
-
if (pid < 0)
{
eassert (0 < vfork_error);
diff --git a/src/casefiddle.c b/src/casefiddle.c
index a948bb3..a7a2541 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -682,16 +682,3 @@ Called with one argument METHOD which can be:
defsubr (&Sdowncase_word);
defsubr (&Scapitalize_word);
}
-
-void
-keys_of_casefiddle (void)
-{
- initial_define_key (control_x_map, Ctl ('U'), "upcase-region");
- Fput (intern ("upcase-region"), Qdisabled, Qt);
- initial_define_key (control_x_map, Ctl ('L'), "downcase-region");
- Fput (intern ("downcase-region"), Qdisabled, Qt);
-
- initial_define_key (meta_map, 'u', "upcase-word");
- initial_define_key (meta_map, 'l', "downcase-word");
- initial_define_key (meta_map, 'c', "capitalize-word");
-}
diff --git a/src/cmds.c b/src/cmds.c
index 798fd68..1547db8 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -529,24 +529,3 @@ This is run after inserting the character. */);
defsubr (&Sdelete_char);
defsubr (&Sself_insert_command);
}
-
-void
-keys_of_cmds (void)
-{
- int n;
-
- initial_define_key (global_map, Ctl ('I'), "self-insert-command");
- for (n = 040; n < 0177; n++)
- initial_define_key (global_map, n, "self-insert-command");
-#ifdef MSDOS
- for (n = 0200; n < 0240; n++)
- initial_define_key (global_map, n, "self-insert-command");
-#endif
- for (n = 0240; n < 0400; n++)
- initial_define_key (global_map, n, "self-insert-command");
-
- initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
- initial_define_key (global_map, Ctl ('B'), "backward-char");
- initial_define_key (global_map, Ctl ('E'), "end-of-line");
- initial_define_key (global_map, Ctl ('F'), "forward-char");
-}
diff --git a/src/commands.h b/src/commands.h
index a09858d..2205ebf 100644
--- a/src/commands.h
+++ b/src/commands.h
@@ -23,14 +23,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#define Ctl(c) ((c)&037)
-/* Define the names of keymaps, just so people can refer to them in
- calls to initial_define_key. These should *not* be used after
- initialization; use-global-map doesn't affect these; it sets
- current_global_map instead. */
-extern Lisp_Object global_map;
-extern Lisp_Object meta_map;
-extern Lisp_Object control_x_map;
-
/* If not Qnil, this is a switch-frame event which we decided to put
off until the end of a key sequence. This should be read as the
next command input, after any Vunread_command_events.
diff --git a/src/emacs.c b/src/emacs.c
index 61d2023..461d1b7 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1969,12 +1969,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
syms_of_json ();
#endif
- keys_of_casefiddle ();
- keys_of_cmds ();
- keys_of_buffer ();
keys_of_keyboard ();
- keys_of_keymap ();
- keys_of_window ();
}
else
{
diff --git a/src/keyboard.c b/src/keyboard.c
index 2446f07..4540b31 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -285,7 +285,7 @@ bool input_pending;
with the input rate, but if it can keep up just enough that there's no
input_pending when we begin the command, then redisplay is not skipped
which results in better feedback to the user. */
-static bool input_was_pending;
+bool input_was_pending;
/* Circular buffer for pre-read keyboard input. */
@@ -12396,12 +12396,6 @@ syms_of_keyboard_for_pdumper (void)
void
keys_of_keyboard (void)
{
- initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
- initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
- initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
- initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
- initial_define_key (meta_map, 'x', "execute-extended-command");
-
initial_define_lispy_key (Vspecial_event_map, "delete-frame",
"handle-delete-frame");
#ifdef HAVE_NTGUI
diff --git a/src/keyboard.h b/src/keyboard.h
index 91c6f46..8bdffaa 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -432,7 +432,7 @@ extern int parse_solitary_modifier (Lisp_Object symbol);
extern Lisp_Object real_this_command;
extern int quit_char;
-
+extern bool input_was_pending;
extern unsigned int timers_run;
extern bool menu_separator_name_p (const char *);
diff --git a/src/keymap.c b/src/keymap.c
index 1eeea81..1197f6f 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -59,22 +59,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
Lisp_Object current_global_map; /* Current global keymap. */
-Lisp_Object global_map; /* Default global key bindings. */
-
-Lisp_Object meta_map; /* The keymap used for globally bound
- ESC-prefixed default commands. */
-
-Lisp_Object control_x_map; /* The keymap used for globally bound
- C-x-prefixed default commands. */
-
- /* The keymap used by the minibuf for local
- bindings when spaces are allowed in the
- minibuf. */
-
- /* The keymap used by the minibuf for local
- bindings when spaces are not encouraged
- in the minibuf. */
-
/* Alist of elements like (DEL . "\d"). */
static Lisp_Object exclude_keys;
@@ -140,19 +124,6 @@ in case you use it as a menu with `x-popup-menu'. */)
return list1 (Qkeymap);
}
-/* This function is used for installing the standard key bindings
- at initialization time.
-
- For example:
-
- initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
-
-void
-initial_define_key (Lisp_Object keymap, int key, const char *defname)
-{
- store_in_keymap (keymap, make_fixnum (key), intern_c_string (defname));
-}
-
void
initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char
*defname)
{
@@ -1741,28 +1712,6 @@ bindings; see the description of `lookup-key' for more
details about this. */)
return Flist (j, maps);
}
-DEFUN ("define-prefix-command", Fdefine_prefix_command,
Sdefine_prefix_command, 1, 3, 0,
- doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
-A new sparse keymap is stored as COMMAND's function definition and its
-value.
-This prepares COMMAND for use as a prefix key's binding.
-If a second optional argument MAPVAR is given, it should be a symbol.
-The map is then stored as MAPVAR's value instead of as COMMAND's
-value; but COMMAND is still defined as a function.
-The third optional argument NAME, if given, supplies a menu name
-string for the map. This is required to use the keymap as a menu.
-This function returns COMMAND. */)
- (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
-{
- Lisp_Object map = Fmake_sparse_keymap (name);
- Ffset (command, map);
- if (!NILP (mapvar))
- Fset (mapvar, map);
- else
- Fset (command, map);
- return command;
-}
-
DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
doc: /* Select KEYMAP as the global keymap. */)
(Lisp_Object keymap)
@@ -2217,11 +2166,21 @@ See `text-char-description' for describing character
codes. */)
{
if (NILP (no_angles))
{
- Lisp_Object result;
- char *buffer = SAFE_ALLOCA (sizeof "<>"
- + SBYTES (SYMBOL_NAME (key)));
- esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
- result = build_string (buffer);
+ Lisp_Object namestr = SYMBOL_NAME (key);
+ const char *sym = SSDATA (namestr);
+ ptrdiff_t len = SBYTES (namestr);
+ /* Find the extent of the modifier prefix, like "C-M-". */
+ int i = 0;
+ while (i < len - 3 && sym[i + 1] == '-' && strchr ("CMSsHA", sym[i]))
+ i += 2;
+ /* First I bytes of SYM are modifiers; put <> around the rest. */
+ char *buffer = SAFE_ALLOCA (len + 3);
+ memcpy (buffer, sym, i);
+ buffer[i] = '<';
+ memcpy (buffer + i + 1, sym + i, len - i);
+ buffer [len + 1] = '>';
+ buffer [len + 2] = '\0';
+ Lisp_Object result = build_string (buffer);
SAFE_FREE ();
return result;
}
@@ -3195,21 +3154,9 @@ syms_of_keymap (void)
Each one is the value of a Lisp variable, and is also
pointed to by a C variable */
- global_map = Fmake_keymap (Qnil);
- Fset (intern_c_string ("global-map"), global_map);
-
- current_global_map = global_map;
- staticpro (&global_map);
+ current_global_map = Qnil;
staticpro (¤t_global_map);
- meta_map = Fmake_keymap (Qnil);
- Fset (intern_c_string ("esc-map"), meta_map);
- Ffset (intern_c_string ("ESC-prefix"), meta_map);
-
- control_x_map = Fmake_keymap (Qnil);
- Fset (intern_c_string ("ctl-x-map"), control_x_map);
- Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
-
exclude_keys = pure_list
(pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
@@ -3311,7 +3258,6 @@ be preferred. */);
defsubr (&Sminor_mode_key_binding);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);
- defsubr (&Sdefine_prefix_command);
defsubr (&Suse_global_map);
defsubr (&Suse_local_map);
defsubr (&Scurrent_local_map);
@@ -3328,10 +3274,3 @@ be preferred. */);
defsubr (&Swhere_is_internal);
defsubr (&Sdescribe_buffer_bindings);
}
-
-void
-keys_of_keymap (void)
-{
- initial_define_key (global_map, 033, "ESC-prefix");
- initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
-}
diff --git a/src/keymap.h b/src/keymap.h
index 072c093..f417301 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -37,10 +37,8 @@ extern char *push_key_description (EMACS_INT, char *);
extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
-extern void initial_define_key (Lisp_Object, int, const char *);
extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);
extern void syms_of_keymap (void);
-extern void keys_of_keymap (void);
typedef void (*map_keymap_function_t)
(Lisp_Object key, Lisp_Object val, Lisp_Object args, void *data);
diff --git a/src/lisp.h b/src/lisp.h
index 0ad788c..d139df9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1478,8 +1478,8 @@ struct Lisp_String
{
struct
{
- ptrdiff_t size;
- ptrdiff_t size_byte;
+ ptrdiff_t size; /* MSB is used as the markbit. */
+ ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */
INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
} s;
@@ -3561,7 +3561,6 @@ extern void swap_in_global_binding (struct Lisp_Symbol *);
/* Defined in cmds.c */
extern void syms_of_cmds (void);
-extern void keys_of_cmds (void);
/* Defined in coding.c. */
extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
@@ -4262,7 +4261,6 @@ extern Lisp_Object get_truename_buffer (Lisp_Object);
extern void init_buffer_once (void);
extern void init_buffer (void);
extern void syms_of_buffer (void);
-extern void keys_of_buffer (void);
/* Defined in marker.c. */
@@ -4359,7 +4357,6 @@ extern void syms_of_callint (void);
/* Defined in casefiddle.c. */
extern void syms_of_casefiddle (void);
-extern void keys_of_casefiddle (void);
/* Defined in casetab.c. */
@@ -4498,8 +4495,8 @@ extern void setup_process_coding_systems (Lisp_Object);
# define CHILD_SETUP_ERROR_DESC "Doing vfork"
#endif
-extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *,
- const char *);
+extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
+ const char *, const char *, const sigset_t *);
extern char **make_environment_block (Lisp_Object);
extern void init_callproc_1 (void);
extern void init_callproc (void);
diff --git a/src/minibuf.c b/src/minibuf.c
index 8b23569..5ee440f 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -2013,9 +2013,6 @@ syms_of_minibuf (void)
DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
- /* The maximum length of a minibuffer history. */
- DEFSYM (Qhistory_length, "history-length");
-
DEFSYM (Qcurrent_input_method, "current-input-method");
DEFSYM (Qactivate_input_method, "activate-input-method");
DEFSYM (Qcase_fold_search, "case-fold-search");
diff --git a/src/nsfns.m b/src/nsfns.m
index ee2daea..ae114f8 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1485,14 +1485,14 @@ Some window managers may refuse to restack windows. */)
if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2))
{
- NSWindow *window = [FRAME_NS_VIEW (f1) window];
- NSInteger window2 = [[FRAME_NS_VIEW (f2) window] windowNumber];
- NSWindowOrderingMode flag = NILP (above) ? NSWindowBelow : NSWindowAbove;
+ EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f1) window];
+ NSWindow *window2 = [FRAME_NS_VIEW (f2) window];
+ BOOL flag = !NILP (above);
- [window orderWindow: flag
- relativeTo: window2];
-
- return Qt;
+ if ([window restackWindow:window2 above:!NILP (above)])
+ return Qt;
+ else
+ return Qnil;
}
else
{
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 9b56958..8086f56 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -145,6 +145,10 @@ ns_update_menubar (struct frame *f, bool deep_p)
t = -(1000*tb.time+tb.millitm);
#endif
+#ifdef NS_IMPL_GNUSTEP
+ deep_p = 1; /* See comment in menuNeedsUpdate. */
+#endif
+
if (deep_p)
{
/* Make a widget-value tree representing the entire menu trees. */
@@ -433,21 +437,22 @@ set_frame_menubar (struct frame *f, bool first_time, bool
deep_p)
}
-/* Delegate method called when a submenu is being opened: run a 'deep' call
- to set_frame_menubar. */
-
-/* TODO: GNUstep calls this method when the menu is still being built
- which throws it into an infinite loop. One possible solution is to
- use menuWillOpen instead, but the Apple docs explicitly warn
- against changing the contents of the menu in it. I don't know what
- the right thing to do for GNUstep is. */
+/* Delegate method called when a submenu is being opened: run a 'deep'
+ call to ns_update_menubar. */
- (void)menuNeedsUpdate: (NSMenu *)menu
{
if (!FRAME_LIVE_P (SELECTED_FRAME ()))
return;
+#ifdef NS_IMPL_COCOA
+/* TODO: GNUstep calls this method when the menu is still being built
+ which results in a recursive stack overflow. One possible solution
+ is to use menuWillOpen instead, but the Apple docs explicitly warn
+ against changing the contents of the menu in it. I don't know what
+ the right thing to do for GNUstep is. */
if (needsUpdate)
ns_update_menubar (SELECTED_FRAME (), true);
+#endif
}
diff --git a/src/nsterm.h b/src/nsterm.h
index 3fb6449..2c9d8e8 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -498,6 +498,7 @@ typedef id instancetype;
NSPoint grabOffset;
}
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
- (void)setAppearance;
@end
diff --git a/src/nsterm.m b/src/nsterm.m
index 2731063..2defb9e 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -8693,6 +8693,112 @@ not_in_argv (NSString *arg)
@implementation EmacsWindow
+/* It seems the only way to reorder child frames is by removing them
+ from the parent and then reattaching them in the correct order. */
+
+- (void)orderFront:(id)sender
+{
+ NSTRACE ("[EmacsWindow orderFront:]");
+
+ NSWindow *parent = [self parentWindow];
+ if (parent)
+ {
+ [parent removeChildWindow:self];
+ [parent addChildWindow:self ordered:NSWindowAbove];
+ }
+ else
+ [super orderFront:sender];
+}
+
+- (void)makeKeyAndOrderFront:(id)sender
+{
+ NSTRACE ("[EmacsWindow makeKeyAndOrderFront:]");
+
+ if ([self parentWindow])
+ {
+ [self orderFront:sender];
+ [self makeKeyWindow];
+ }
+ else
+ [super makeKeyAndOrderFront:sender];
+}
+
+
+/* The array returned by [NSWindow parentWindow] may already be
+ sorted, but the documentation doesn't tell us whether or not it is,
+ so to be safe we'll sort it. */
+NSInteger nswindow_orderedIndex_sort (id w1, id w2, void *c)
+{
+ NSInteger i1 = [w1 orderedIndex];
+ NSInteger i2 = [w2 orderedIndex];
+
+ if (i1 > i2)
+ return NSOrderedAscending;
+ if (i1 < i2)
+ return NSOrderedDescending;
+
+ return NSOrderedSame;
+}
+
+- (void)orderBack:(id)sender
+{
+ NSTRACE ("[EmacsWindow orderBack:]");
+
+ NSWindow *parent = [self parentWindow];
+ if (parent)
+ {
+ NSArray *children = [[parent childWindows]
+ sortedArrayUsingFunction:nswindow_orderedIndex_sort
+ context:nil];
+ [parent removeChildWindow:self];
+ [parent addChildWindow:self ordered:NSWindowAbove];
+
+ for (NSWindow *win in children)
+ {
+ if (win != self)
+ {
+ [parent removeChildWindow:win];
+ [parent addChildWindow:win ordered:NSWindowAbove];
+ }
+ }
+ }
+ else
+ [super orderBack:sender];
+}
+
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above
+{
+ NSTRACE ("[EmacsWindow restackWindow:above:]");
+
+ /* If parent windows don't match we can't restack these frames
+ without changing the parents. */
+ if ([self parentWindow] != [win parentWindow])
+ return NO;
+ else if (![self parentWindow])
+ [self orderWindow:(above ? NSWindowAbove : NSWindowBelow)
+ relativeTo:[win windowNumber]];
+ else
+ {
+ NSInteger index;
+ NSWindow *parent = [self parentWindow];
+ NSMutableArray *children = [[[parent childWindows]
+
sortedArrayUsingFunction:nswindow_orderedIndex_sort
+ context:nil]
+ mutableCopy];
+ [children removeObject:self];
+ index = [children indexOfObject:win];
+ [children insertObject:self atIndex:(above ? index+1 : index)];
+
+ for (NSWindow *w in children)
+ {
+ [parent removeChildWindow:w];
+ [parent addChildWindow:w ordered:NSWindowAbove];
+ }
+ }
+
+ return YES;
+}
+
#ifdef NS_IMPL_COCOA
- (id)accessibilityAttributeValue:(NSString *)attribute
{
diff --git a/src/pdumper.c b/src/pdumper.c
index 6956ee3..116cc28 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2058,7 +2058,7 @@ dump_interval_tree (struct dump_context *ctx,
static dump_off
dump_string (struct dump_context *ctx, const struct Lisp_String *string)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB)
# error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
#endif
/* If we have text properties, write them _after_ the string so that
diff --git a/src/print.c b/src/print.c
index 94a8bcb..14af919 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1557,7 +1557,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */
- int len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
+ int len = sprintf (buf, "#s(hash-table size %"pD"d",
+ HASH_TABLE_SIZE (h));
strout (buf, len, len, printcharfun);
if (!NILP (h->test.name))
diff --git a/src/process.c b/src/process.c
index 3550f62..25883f9 100644
--- a/src/process.c
+++ b/src/process.c
@@ -692,8 +692,7 @@ status_convert (int w)
if (WIFSTOPPED (w))
return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil));
else if (WIFEXITED (w))
- return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)),
- WCOREDUMP (w) ? Qt : Qnil));
+ return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil));
else if (WIFSIGNALED (w))
return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)),
WCOREDUMP (w) ? Qt : Qnil));
@@ -2059,6 +2058,7 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
bool pty_flag = 0;
char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
+ sigset_t oldset;
inchannel = outchannel = -1;
@@ -2139,13 +2139,16 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
setup_process_coding_systems (process);
char **env = make_environment_block (current_dir);
+ block_input ();
+ block_child_signal (&oldset);
+
pty_flag = p->pty_flag;
eassert (pty_flag == ! NILP (lisp_pty_name));
vfork_errno
= emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
SSDATA (current_dir),
- pty_flag ? SSDATA (lisp_pty_name) : NULL);
+ pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
eassert ((vfork_errno == 0) == (0 < pid));
@@ -2153,6 +2156,10 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
if (pid >= 0)
p->alive = 1;
+ /* Stop blocking in the parent. */
+ unblock_child_signal (&oldset);
+ unblock_input ();
+
/* Environment block no longer needed. */
unbind_to (count, Qnil);
diff --git a/src/terminfo.c b/src/terminfo.c
index 15aff31..a9c9572 100644
--- a/src/terminfo.c
+++ b/src/terminfo.c
@@ -23,10 +23,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* Define these variables that serve as global parameters to termcap,
so that we do not need to conditionalize the places in Emacs
- that set them. But don't do that for terminfo, as that could
- cause link errors when using -fno-common. */
+ that set them. But don't do that if terminfo defines them, as that
+ could cause link errors when using -fno-common. */
-#if !TERMINFO
+#ifndef TERMINFO_DEFINES_BC
char *UP, *BC, PC;
#endif
diff --git a/src/window.c b/src/window.c
index ba8682e..5e78aa4 100644
--- a/src/window.c
+++ b/src/window.c
@@ -8100,6 +8100,18 @@ and scrolling positions. */)
return Qt;
return Qnil;
}
+
+DEFUN ("window-bump-use-time", Fwindow_bump_use_time,
+ Swindow_bump_use_time, 1, 1, 0,
+ doc: /* Mark WINDOW as having been recently used. */)
+ (Lisp_Object window)
+{
+ struct window *w = decode_valid_window (window);
+
+ w->use_time = ++window_select_count;
+ return Qnil;
+}
+
static void init_window_once_for_pdumper (void);
@@ -8573,6 +8585,7 @@ displayed after a scrolling operation to be somewhat
inaccurate. */);
defsubr (&Swindow_vscroll);
defsubr (&Sset_window_vscroll);
defsubr (&Scompare_window_configurations);
+ defsubr (&Swindow_bump_use_time);
defsubr (&Swindow_list);
defsubr (&Swindow_list_1);
defsubr (&Swindow_prev_buffers);
@@ -8583,14 +8596,3 @@ displayed after a scrolling operation to be somewhat
inaccurate. */);
defsubr (&Swindow_parameter);
defsubr (&Sset_window_parameter);
}
-
-void
-keys_of_window (void)
-{
- initial_define_key (control_x_map, '<', "scroll-left");
- initial_define_key (control_x_map, '>', "scroll-right");
-
- initial_define_key (global_map, Ctl ('V'), "scroll-up-command");
- initial_define_key (meta_map, Ctl ('V'), "scroll-other-window");
- initial_define_key (meta_map, 'v', "scroll-down-command");
-}
diff --git a/src/window.h b/src/window.h
index fba98f4..fbdec0d 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1202,7 +1202,6 @@ extern bool window_outdated (struct window *);
extern void init_window_once (void);
extern void init_window (void);
extern void syms_of_window (void);
-extern void keys_of_window (void);
/* Move cursor to row/column position VPOS/HPOS, pixel coordinates
Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y
are window-relative pixel positions. This is always done during
diff --git a/src/xdisp.c b/src/xdisp.c
index b0f218d..d070c5a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4262,6 +4262,7 @@ handle_fontified_prop (struct it *it)
if (!STRINGP (it->string)
&& it->s == NULL
&& !NILP (Vfontification_functions)
+ && !(input_was_pending && redisplay_skip_fontification_on_input)
&& !NILP (Vrun_hooks)
&& (pos = make_fixnum (IT_CHARPOS (*it)),
prop = Fget_char_property (pos, Qfontified, Qnil),
@@ -25508,7 +25509,7 @@ display_mode_line (struct window *w, enum face_id
face_id, Lisp_Object format)
if (start < i)
display_string (NULL,
Fsubstring (mode_string, make_fixnum (start),
- make_fixnum (i - 1)),
+ make_fixnum (i)),
Qnil, 0, 0, &it, 0, 0, 0,
STRING_MULTIBYTE (mode_string));
}
@@ -35613,6 +35614,19 @@ best except in special circumstances such as running
redisplay tests
in batch mode. */);
redisplay_skip_initial_frame = true;
+ DEFVAR_BOOL ("redisplay-skip-fontification-on-input",
+ redisplay_skip_fontification_on_input,
+ doc: /* Skip `fontification_functions` when there is input pending.
+If non-nil and there was input pending at the beginning of the command,
+the `fontification_functions` hook is not run. This usually does not
+affect the display because redisplay is completely skipped anyway if input
+was pending, but it can make scrolling smoother by avoiding
+unnecessary fontification.
+It is similar to `fast-but-imprecise-scrolling' with similar tradeoffs,
+but with the advantage that it should only affect the behavior when Emacs
+has trouble keeping up with the incoming input rate. */);
+ redisplay_skip_fontification_on_input = false;
+
DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows",
redisplay_adhoc_scroll_in_resize_mini_windows,
doc: /* If nil always use normal scrolling in minibuffer windows.
diff --git a/src/xterm.c b/src/xterm.c
index 0a86738..b8374fe 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -13035,13 +13035,13 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
or larger than other for other applications, even if it is the same
font name (monospace-10 for example). */
+# ifdef HAVE_XRENDER
int event_base, error_base;
- char *v;
- double d;
-
XRenderQueryExtension (dpyinfo->display, &event_base, &error_base);
+# endif
- v = XGetDefault (dpyinfo->display, "Xft", "dpi");
+ char *v = XGetDefault (dpyinfo->display, "Xft", "dpi");
+ double d;
if (v != NULL && sscanf (v, "%lf", &d) == 1)
dpyinfo->resy = dpyinfo->resx = d;
}
diff --git a/test/Makefile.in b/test/Makefile.in
index 8aa37ca..fc40dad 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -161,11 +161,15 @@ endif
## Save logs, and show logs for failed tests.
WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
+## On Hydra or Emba, always show logs for certain problematic tests.
ifdef EMACS_HYDRA_CI
-## On Hydra, always show logs for certain problematic tests.
lisp/net/tramp-tests.log \
: WRITE_LOG = 2>&1 | tee $@
endif
+ifdef EMACS_EMBA_CI
+lisp/filenotify-tests.log lisp/net/tramp-tests.log \
+: WRITE_LOG = 2>&1 | tee $@
+endif
ifeq ($(TEST_LOAD_EL), yes)
testloadfile = $*.el
diff --git
a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
new file mode 100644
index 0000000..e65a541
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
@@ -0,0 +1,7 @@
+;;; -*- lexical-binding: t -*-
+
+(make-obsolete-variable 'bytecomp--tests-obsolete-var-2 nil "99.99")
+
+(defun foo ()
+ (let ((bytecomp--tests-obsolete-var-2 2))
+ bytecomp--tests-obsolete-var-2))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5e5f99d..a07af18 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -625,6 +625,9 @@ Subtests signal errors if something goes wrong."
(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
"bytecomp--tests-obs.*obsolete.*99.99")
+(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
+ "bytecomp--tests-obs.*obsolete.*99.99" t)
+
(bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el"
"as both function and macro")
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index 446983c..bcd63f7 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -610,4 +610,27 @@ collection clause."
;; Just make sure the function can be instrumented.
(edebug-defun)))
+;;; cl-labels
+
+(ert-deftest cl-macs--labels ()
+ ;; Simple recursive function.
+ (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
+ (should (equal (len (make-list 42 t)) 42)))
+
+ ;; Simple tail-recursive function.
+ (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
+ (should (equal (len (make-list 42 t) 0) 42))
+ ;; Should not bump into stack depth limits.
+ (should (equal (len (make-list 42000 t) 0) 42000)))
+
+ ;; Check that non-recursive functions are handled more efficiently.
+ (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
+ (`(let* ,_ (funcall ,_ 5)) t)))
+
+ ;; Case of "tail-recursive lambdas".
+ (should (pcase (macroexpand
+ '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
+ #'len))
+ (`(function (lambda (,_ ,_) . ,_)) t))))
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 047109a..d73b072 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -1265,7 +1265,7 @@ delivered."
;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286
(file-notify--deftest-remote file-notify-test07-many-events
"Check that events are not dropped for remote directories."
- (getenv "EMACS_HYDRA_CI"))
+ (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")))
(ert-deftest file-notify-test08-backup ()
"Check that backup keeps file notification."
diff --git a/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
new file mode 100644
index 0000000..0b193a2
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
@@ -0,0 +1,20 @@
+From: example <example@example.org>
+To: example <example@example.org>
+Content-Type: multipart/alternative;
boundary="===============2877195075946974246=="
+Date: Thu, 29 Oct 2020 14:47:55 +0100
+MIME-Version: 1.0
+Subject: test
+
+--===============2877195075946974246==
+Content-Type: text/plain; charset="utf-8"
+Content-Transfer-Encoding: 8bit
+
+ääää
+
+--===============2877195075946974246==
+Content-Type: text/html; charset="utf-8"
+Content-Transfer-Encoding: 8bit
+
+<!doctype html><html><head><meta http-equiv="content-type" content="text/html;
charset=UTF-8"></head><body>ääää</body></html>
+
+--===============2877195075946974246==--
diff --git a/test/lisp/gnus/mm-decode-tests.el
b/test/lisp/gnus/mm-decode-tests.el
new file mode 100644
index 0000000..74591f9
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -0,0 +1,89 @@
+;;; mm-decode-tests.el --- -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'mm-decode)
+
+(ert-deftest test-mm-dissect-buffer ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (should (equal (mm-handle-media-type handle) "multipart/alternative"))
+ ;; Skip multipart type.
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/plain"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/html"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "<!doctype html><html><head><meta
http-equiv=\"content-type\" content=\"text/html;
charset=UTF-8\"></head><body>ääää</body></html>\n")))))))
+
+(ert-deftest test-mm-with-part-unibyte ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (decode-coding-string
+ (mm-with-part part
+ (buffer-string))
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))))
+
+(ert-deftest test-mm-with-part-multibyte ()
+ (with-temp-buffer
+ (set-buffer-multibyte t)
+ (nnheader-insert-file-contents (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (decode-coding-string
+ (mm-with-part part
+ (buffer-string))
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))))
+
+;;; mm-decode-tests.el ends here
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 95557c95..835d9fe 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -102,7 +102,7 @@ RET minibuffer-complete-and-exit
ESC Prefix Command
SPC minibuffer-complete-word
? minibuffer-completion-help
-<C-tab> file-cache-minibuffer-complete
+C-<tab> file-cache-minibuffer-complete
<XF86Back> previous-history-element
<XF86Forward> next-history-element
<down> next-line-or-history-element
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 896b997..e1cb993 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4670,7 +4670,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
- :tags (if (getenv "EMACS_EMBA_CI")
+ :tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
'(:expensive-test :unstable) '(:expensive-test))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
@@ -5787,7 +5787,8 @@ This requires restrictions of file name syntax."
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
(files (delq nil files))
(process-environment process-environment)
- (sorted-files (sort (copy-sequence files) #'string-lessp)))
+ (sorted-files (sort (copy-sequence files) #'string-lessp))
+ buffer)
(unwind-protect
(progn
(make-directory tmp-name1)
@@ -5849,6 +5850,18 @@ This requires restrictions of file name syntax."
tmp-name2 nil directory-files-no-dot-files-regexp))
sorted-files))
+ ;; Check, that `insert-directory' works properly.
+ (with-current-buffer
+ (setq buffer (dired-noselect tmp-name1 "--dired -al"))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when-let ((name (dired-get-filename 'localp 'no-error)))
+ (unless
+ (string-match-p name directory-files-no-dot-files-regexp)
+ (should (member name files))))
+ (forward-line 1)))
+ (kill-buffer buffer)
+
;; `substitute-in-file-name' could return different
;; values. For `adb', there could be strange file
;; permissions preventing overwriting a file. We don't
@@ -5944,6 +5957,7 @@ This requires restrictions of file name syntax."
(regexp-quote (getenv envvar))))))))))
;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
new file mode 100644
index 0000000..8af4625
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
@@ -0,0 +1,143 @@
+use 5.020;
+
+=head1 NAME
+
+here-docs.pl - resource file for cperl-test-here-docs
+
+=head1 DESCRIPTION
+
+This file holds a couple of HERE documents, with a variety of normal
+and edge cases. For a formatted view of this description, run:
+
+ (cperl-perldoc "here-docs.pl")
+
+For each of the HERE documents, the following checks will done:
+
+=over 4
+
+=item *
+
+All occurrences of the string "look-here" are fontified correcty.
+Note that we deliberately test the face, not the syntax property:
+Users won't care for the syntax property, but they see the face.
+Different implementations with different syntax properties have been
+seen in the past.
+
+=item *
+
+Indentation of the line(s) containing "look-here" is 0, i.e. there are no
+leading spaces.
+
+=item *
+
+Indentation of the following perl statement containing "indent" should
+be 0 if the statement contains "noindent", and according to the mode's
+continued-statement-offset otherwise.
+
+=back
+
+=cut
+
+# Prologue to make the test file valid without warnings
+
+my $text;
+my $any;
+my $indentation;
+my $anywhere = 'back again';
+my $noindent;
+
+=head1 The Tests
+
+=head2 Test Case 1
+
+We have two HERE documents in one line with different quoting styles.
+
+=cut
+
+## test case
+
+$text = <<"HERE" . <<'THERE' . $any;
+#look-here and
+HERE
+$tlook-here and
+THERE
+
+$noindent = "This should be left-justified";
+
+=head2 Test case 2
+
+A HERE document followed by a continuation line
+
+=cut
+
+## test case
+
+$text = <<HERE
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+=head2 Test case 3
+
+A here document with a line-end comment in the starter line,
+after a complete statement
+
+=cut
+
+## test case
+
+$text = <<HERE; # start here
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 4
+
+A HERE document with a to-be-continued statement and a comment in the
+starter line.
+
+=cut
+
+## test case
+
+$text = <<HERE # start here
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+=head2 Test case 5
+
+A HERE document with a comment sign, but no comment to follow.
+
+
+=cut
+
+## test case
+
+$text = <<HERE; #
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 6
+
+A HERE document with a comment sign, but no comment to follow, with a
+statement to be continued. Also, the character before the comment
+sign has a relevant syntax property (end of string in our case) which
+must be preserved.
+
+=cut
+
+## test case
+
+$text = <<"HERE"#
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+__END__
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 46e687f..943c454 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -135,6 +135,37 @@ point in the distant past, and is still broken in
perl-mode. "
(should (equal (nth 3 (syntax-ppss)) nil))
(should (equal (nth 4 (syntax-ppss)) t))))))
+(ert-deftest cperl-test-heredocs ()
+ "Test that HERE-docs are fontified with the appropriate face."
+ (require 'perl-mode)
+ (let ((file (ert-resource-file "here-docs.pl"))
+ (cperl-continued-statement-offset perl-continued-statement-offset)
+ (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
+ 'font-lock-string-face))
+ (case-fold-search nil))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ (indent-region (point-min) (point-max))
+ (font-lock-ensure (point-min) (point-max))
+ (while (search-forward "## test case" nil t)
+ (save-excursion
+ (while (search-forward "look-here" nil t)
+ (should (equal
+ (get-text-property (match-beginning 0) 'face)
+ target-font))
+ (beginning-of-line)
+ (should (null (looking-at "[ \t]")))
+ (forward-line 1)))
+ (should (re-search-forward
+ (concat "^\\([ \t]*\\)" ; the actual indentation amount
+ "\\([^ \t\n].*?\\)\\(no\\)?indent")
+ nil t))
+ (should (equal (- (match-end 1) (match-beginning 1))
+ (if (match-beginning 3) 0
+ perl-indent-level)))))))
+
;;; Tests for issues reported in the Bug Tracker
(defun cperl-test--run-bug-10483 ()
@@ -164,6 +195,7 @@ under timeout control."
(interactive)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
(skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
(let* ((emacs (concat invocation-directory invocation-name))
(test-function 'cperl-test--run-bug-10483)
(test-function-name (symbol-name test-function))
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index 67b592e..42a011c 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -497,7 +497,8 @@ VALUES-PLIST is a list with alternating index and value
elements."
(ert-deftest ruby-add-log-current-method-examples ()
(let ((pairs '(("foo" . "#foo")
("C.foo" . ".foo")
- ("self.foo" . ".foo"))))
+ ("self.foo" . ".foo")
+ ("<<" . "#<<"))))
(dolist (pair pairs)
(let ((name (car pair))
(value (cdr pair)))
diff --git a/test/lisp/progmodes/xref-tests.el
b/test/lisp/progmodes/xref-tests.el
index eaafc58..b4b5e4d 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -99,13 +99,18 @@
(should (null (marker-position (cdr (nth 0 (cdr cons2))))))))
(ert-deftest xref--xref-file-name-display-is-abs ()
- (let ((xref-file-name-display 'abs))
- (should (equal (delete-dups
- (mapcar 'xref-location-group
- (xref-tests--locations-in-data-dir
"\\(bar\\|foo\\)")))
- (list
- (concat xref-tests--data-dir "file1.txt")
- (concat xref-tests--data-dir "file2.txt"))))))
+ (let ((xref-file-name-display 'abs)
+ ;; Some older BSD find versions can produce '//' in the output.
+ (expected (list
+ (concat xref-tests--data-dir "/?file1.txt")
+ (concat xref-tests--data-dir "/?file2.txt")))
+ (actual (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir
"\\(bar\\|foo\\)")))))
+ (should (and (= (length expected) (length actual))
+ (cl-every (lambda (e1 e2)
+ (string-match-p e1 e2))
+ expected actual)))))
(ert-deftest xref--xref-file-name-display-is-nondirectory ()
(let ((xref-file-name-display 'nondirectory))
@@ -121,10 +126,15 @@
(file-name-directory (directory-file-name xref-tests--data-dir)))
(project-find-functions
#'(lambda (_) (cons 'transient data-parent-dir)))
- (xref-file-name-display 'project-relative))
- (should (equal (delete-dups
- (mapcar 'xref-location-group
- (xref-tests--locations-in-data-dir
"\\(bar\\|foo\\)")))
- (list
- "xref-resources/file1.txt"
- "xref-resources/file2.txt")))))
+ (xref-file-name-display 'project-relative)
+ ;; Some older BSD find versions can produce '//' in the output.
+ (expected (list
+ "xref-resources//?file1.txt"
+ "xref-resources//?file2.txt"))
+ (actual (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir
"\\(bar\\|foo\\)")))))
+ (should (and (= (length expected) (length actual))
+ (cl-every (lambda (e1 e2)
+ (string-match-p e1 e2))
+ expected actual)))))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 2f5b38d..e082620 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -61,6 +61,35 @@
(quote
(0 font-lock-keyword-face))))))))
+
+;;;; Keymap support.
+
+(ert-deftest subr-test-kbd ()
+ (should (equal (kbd "f") "f"))
+ (should (equal (kbd "<f1>") [f1]))
+ (should (equal (kbd "RET") "\C-m"))
+ (should (equal (kbd "C-x a") "\C-xa"))
+ ;; Check that kbd handles both new and old style key descriptions
+ ;; (bug#45536).
+ (should (equal (kbd "s-<return>") [s-return]))
+ (should (equal (kbd "<s-return>") [s-return]))
+ (should (equal (kbd "C-M-<return>") [C-M-return]))
+ (should (equal (kbd "<C-M-return>") [C-M-return])))
+
+(ert-deftest subr-test-define-prefix-command ()
+ (define-prefix-command 'foo-prefix-map)
+ (should (keymapp foo-prefix-map))
+ (should (fboundp #'foo-prefix-map))
+ ;; With optional argument.
+ (define-prefix-command 'bar-prefix 'bar-prefix-map)
+ (should (keymapp bar-prefix-map))
+ (should (fboundp #'bar-prefix))
+ ;; Returns the symbol.
+ (should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
+
+
+;;;; Mode hooks.
+
(defalias 'subr-tests--parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
@@ -404,6 +433,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should (equal (flatten-tree '(1 ("foo" "bar") 2))
'(1 "foo" "bar" 2))))
+(ert-deftest subr--tests-letrec ()
+ ;; Test that simple cases of `letrec' get optimized back to `let*'.
+ (should (equal (macroexpand '(letrec ((subr-tests-var1 1)
+ (subr-tests-var2 subr-tests-var1))
+ (+ subr-tests-var1 subr-tests-var2)))
+ '(let* ((subr-tests-var1 1)
+ (subr-tests-var2 subr-tests-var1))
+ (+ subr-tests-var1 subr-tests-var2)))))
+
(defvar subr-tests--hook nil)
(ert-deftest subr-tests-add-hook-depth ()
diff --git a/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
new file mode 100644
index 0000000..1905477
--- /dev/null
+++ b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
@@ -0,0 +1,9 @@
+First
+paragraph
+
+Second
+
+Third
+paragraph
+
+No line end
\ No newline at end of file
diff --git a/test/lisp/textmodes/paragraphs-tests.el
b/test/lisp/textmodes/paragraphs-tests.el
index bf7f370..7121690 100644
--- a/test/lisp/textmodes/paragraphs-tests.el
+++ b/test/lisp/textmodes/paragraphs-tests.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
;; (require 'paragraphs) ; loaded by default
(ert-deftest paragraphs-tests-sentence-end ()
@@ -161,5 +162,27 @@
(should (equal (buffer-string)
"First sentence. Third sentence. Second sentence."))))
+(ert-deftest test-mark-paragraphs ()
+ (with-current-buffer
+ (find-file-noselect (ert-resource-file "mark-paragraph.bin"))
+ (goto-char (point-max))
+ ;; Just a sanity check that the file hasn't changed.
+ (should (= (point) 54))
+ (mark-paragraph)
+ (should (= (point) 42))
+ (should (= (mark) 54))
+ ;; Doesn't move.
+ (mark-paragraph)
+ (should (= (point) 42))
+ (should (= (mark) 54))
+ (forward-line -1)
+ (mark-paragraph)
+ (should (= (point) 25))
+ (should (= (mark) 42))
+ (goto-char (point-min))
+ (mark-paragraph)
+ (should (= (point) 1))
+ (should (= (mark) 17))))
+
(provide 'paragraphs-tests)
;;; paragraphs-tests.el ends here
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 35235c6..17fdfef 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -301,4 +301,25 @@ return nil, even with a non-nil bubblep argument."
(should child)
(should (equal (widget-value widget) '((1 "One")))))))
+(ert-deftest widget-test-widget-move ()
+ "Test moving with `widget-forward' and `widget-backward'."
+ (with-temp-buffer
+ (dolist (el '("First" "Second" "Third"))
+ (widget-create 'push-button el))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (goto-char (point-min))
+ ;; Check that moving from the widget's start works.
+ (widget-forward 2)
+ (should (string= "Third" (widget-value (widget-at))))
+ (widget-backward 1)
+ (should (string= "Second" (widget-value (widget-at))))
+ ;; Check that moving from inside the widget works.
+ (goto-char (point-min))
+ (widget-forward 2)
+ (forward-char)
+ (widget-backward 1)
+ (should (string= "Second" (widget-value (widget-at))))))
+
;;; wid-edit-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 74fb3c8..d4f5fc3 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -248,6 +248,18 @@ g .. h foo
0 .. 3 foo
")))))
+(ert-deftest keymap--key-description ()
+ (should (equal (key-description [right] [?\C-x])
+ "C-x <right>"))
+ (should (equal (key-description [M-H-right] [?\C-x])
+ "C-x M-H-<right>"))
+ (should (equal (single-key-description 'home)
+ "<home>"))
+ (should (equal (single-key-description 'home t)
+ "home"))
+ (should (equal (single-key-description 'C-s-home)
+ "C-s-<home>")))
+
(provide 'keymap-tests)
;;; keymap-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 5294bc0..921bcd5 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -560,8 +560,16 @@ FD_SETSIZE file descriptors (Bug#24325)."
;; We should have managed to start at least one process.
(should processes)
(dolist (process processes)
- (should (process-live-p process))
- (process-send-eof process)
+ ;; The process now should either be running, or have
+ ;; already failed before `exec'.
+ (should (memq (process-status process) '(run exit)))
+ (when (process-live-p process)
+ (process-send-eof process))
+ ;; FIXME: This `sleep-for' shouldn't be needed. It
+ ;; indicates a bug in Emacs; perhaps SIGCHLD is
+ ;; received in parallel with `accept-process-output',
+ ;; causing the latter to hang.
+ (sleep-for 0.1)
(while (accept-process-output process))
(should (eq (process-status process) 'exit))
;; If there's an error between fork and exec, Emacs
@@ -643,6 +651,8 @@ FD_SETSIZE file descriptors (Bug#24325)."
(ert-deftest process-tests/fd-setsize-no-crash/make-serial-process ()
"Check that Emacs doesn't crash when trying to use more than
FD_SETSIZE file descriptors (Bug#24325)."
+ ;; This test cannot be run if PTYs aren't supported.
+ (skip-unless (not (eq system-type 'windows-nt)))
(with-timeout (60 (ert-fail "Test timed out"))
(process-tests--with-processes processes
;; In order to use `make-serial-process', we need to create some
@@ -664,6 +674,15 @@ FD_SETSIZE file descriptors (Bug#24325)."
(tty-name (process-tty-name host)))
(should (processp host))
(push host processes)
+ ;; FIXME: The assumption below that using :connection 'pty
+ ;; in make-process necessarily produces a process with PTY
+ ;; connection is unreliable and non-portable.
+ ;; make-process can legitimately and silently fall back on
+ ;; pipes if allocating a PTY fails (and on MS-Windows it
+ ;; always fails). The following code also assumes that
+ ;; process-tty-name produces a file name that can be
+ ;; passed to 'stat' and to make-serial-process, which is
+ ;; also non-portable.
(should tty-name)
(should (file-exists-p tty-name))
(should-not (member tty-name tty-names))