[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/etags-regen 3098e47 4/8: Merge branch 'master' into scratch/etag
|
From: |
Dmitry Gutov |
|
Subject: |
scratch/etags-regen 3098e47 4/8: Merge branch 'master' into scratch/etags-regen |
|
Date: |
Sun, 7 Feb 2021 21:12:00 -0500 (EST) |
branch: scratch/etags-regen
commit 3098e4798dc49cc671fdff7a5aa31ce627a66ad6
Merge: 44f19c7 bbad790
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Merge branch 'master' into scratch/etags-regen
---
.clang-format | 2 +-
admin/notes/unicode | 10 +-
admin/unidata/unidata-gen.el | 6 +-
build-aux/config.guess | 8 +-
build-aux/config.sub | 10 +-
configure.ac | 2 +-
doc/emacs/glossary.texi | 8 +-
doc/emacs/kmacro.texi | 8 +
doc/emacs/maintaining.texi | 22 +-
doc/lispref/frames.texi | 48 ++-
doc/lispref/text.texi | 37 ++
doc/misc/org.texi | 6 +-
doc/misc/texinfo.tex | 163 +++-----
doc/misc/tramp.texi | 30 +-
etc/NEWS | 24 ++
leim/leim-ext.el | 12 +-
lib/_Noreturn.h | 16 +-
lib/canonicalize-lgpl.c | 25 +-
lib/cdefs.h | 192 ++++++---
lib/dirent.in.h | 3 +-
lib/{scratch_buffer.h => dynarray.h} | 22 +-
lib/explicit_bzero.c | 16 +-
lib/fchmodat.c | 17 +
lib/free.c | 14 +
lib/gnulib.mk.in | 27 ++
lib/libc-config.h | 171 ++++----
lib/malloc/dynarray-skeleton.c | 525 +++++++++++++++++++++++++
lib/malloc/dynarray.h | 178 +++++++++
lib/{timegm.c => malloc/dynarray_at_failure.c} | 55 +--
lib/malloc/dynarray_emplace_enlarge.c | 73 ++++
lib/malloc/dynarray_finalize.c | 62 +++
lib/malloc/dynarray_resize.c | 64 +++
lib/malloc/dynarray_resize_clear.c | 35 ++
lib/malloc/scratch_buffer_grow.c | 2 +-
lib/malloc/scratch_buffer_grow_preserve.c | 2 +-
lib/malloc/scratch_buffer_set_array_size.c | 2 +-
lib/mini-gmp.c | 2 +-
lib/mktime-internal.h | 2 +-
lib/nstrftime.c | 6 +-
lib/regex.c | 2 +-
lib/regex_internal.h | 26 +-
lib/regexec.c | 117 ++----
lib/scratch_buffer.h | 1 +
lib/stddef.in.h | 23 +-
lib/string.in.h | 20 +-
lib/sys_stat.in.h | 30 +-
lib/tempname.c | 27 +-
lib/time-internal.h | 2 +-
lib/time.in.h | 19 +
lib/time_rz.c | 16 +-
lib/timegm.c | 2 +-
lib/utimens.c | 19 +-
lib/utimensat.c | 101 +++--
lib/verify.h | 28 +-
lisp/autorevert.el | 105 +++--
lisp/calc/calc-graph.el | 6 +-
lisp/calc/calccomp.el | 13 +-
lisp/dired-aux.el | 4 +-
lisp/emacs-lisp/bindat.el | 112 +++---
lisp/emacs-lisp/byte-run.el | 16 +-
lisp/emacs-lisp/checkdoc.el | 4 +-
lisp/emacs-lisp/crm.el | 2 +-
lisp/emacs-lisp/derived.el | 2 +-
lisp/emacs-lisp/eieio-opt.el | 2 +-
lisp/emacs-lisp/generic.el | 9 +-
lisp/emacs-lisp/helper.el | 29 +-
lisp/emacs-lisp/lisp-mode.el | 81 ++--
lisp/emacs-lisp/macroexp.el | 53 ++-
lisp/emacs-lisp/package-x.el | 2 +-
lisp/emacs-lisp/pcase.el | 44 ++-
lisp/emacs-lisp/regi.el | 55 +--
lisp/emacs-lisp/shadow.el | 22 +-
lisp/emacs-lisp/tcover-ses.el | 28 +-
lisp/emacs-lisp/unsafep.el | 9 +-
lisp/ezimage.el | 2 +-
lisp/faces.el | 11 +-
lisp/files.el | 4 +-
lisp/find-cmd.el | 4 +-
lisp/flow-ctrl.el | 13 +-
lisp/generic-x.el | 109 +++--
lisp/gnus/gnus-agent.el | 383 ++++++++++++------
lisp/gnus/gnus-async.el | 9 +-
lisp/gnus/gnus-cache.el | 126 ++++--
lisp/gnus/gnus-cloud.el | 16 +-
lisp/gnus/gnus-icalendar.el | 1 +
lisp/gnus/gnus-search.el | 1 +
lisp/gnus/gnus-start.el | 10 +-
lisp/gnus/gnus-sum.el | 65 +--
lisp/gnus/gnus.el | 9 +-
lisp/gnus/nnml.el | 16 +
lisp/gnus/nnvirtual.el | 172 +++++---
lisp/hl-line.el | 58 ++-
lisp/image/gravatar.el | 15 +-
lisp/international/isearch-x.el | 5 +-
lisp/international/iso-cvt.el | 24 +-
lisp/international/ja-dic-cnv.el | 11 +-
lisp/international/ja-dic-utl.el | 2 +-
lisp/international/kinsoku.el | 2 +-
lisp/international/kkc.el | 2 +-
lisp/international/latexenc.el | 4 +-
lisp/international/latin1-disp.el | 19 +-
lisp/international/mule-cmds.el | 2 +-
lisp/international/mule-diag.el | 27 +-
lisp/international/ogonek.el | 2 +-
lisp/international/quail.el | 18 +-
lisp/international/robin.el | 2 +-
lisp/international/titdic-cnv.el | 254 ++++++------
lisp/international/utf-7.el | 2 +-
lisp/isearch.el | 3 +-
lisp/kmacro.el | 11 +
lisp/language/burmese.el | 4 +-
lisp/language/cham.el | 4 +-
lisp/language/china-util.el | 2 +-
lisp/language/cyril-util.el | 2 +-
lisp/language/ethio-util.el | 11 +-
lisp/language/ethiopic.el | 4 +-
lisp/language/hanja-util.el | 2 +-
lisp/language/hebrew.el | 6 +-
lisp/language/ind-util.el | 14 +-
lisp/language/indian.el | 2 +-
lisp/language/japan-util.el | 8 +-
lisp/language/khmer.el | 2 +-
lisp/language/korea-util.el | 6 +-
lisp/language/korean.el | 4 +-
lisp/language/lao-util.el | 8 +-
lisp/language/lao.el | 2 +-
lisp/language/misc-lang.el | 8 +-
lisp/language/sinhala.el | 2 +-
lisp/language/tai-viet.el | 2 +-
lisp/language/thai-util.el | 8 +-
lisp/language/thai-word.el | 5 +-
lisp/language/tibet-util.el | 66 ++--
lisp/language/tibetan.el | 2 +-
lisp/language/tv-util.el | 4 +-
lisp/language/viet-util.el | 2 +-
lisp/leim/quail/compose.el | 2 +-
lisp/leim/quail/viqr.el | 2 +-
lisp/mail/sendmail.el | 16 +-
lisp/mh-e/mh-speed.el | 6 +-
lisp/net/ange-ftp.el | 2 +-
lisp/net/dbus.el | 1 +
lisp/net/eww.el | 7 +
lisp/net/sasl-cram.el | 2 +-
lisp/net/sasl-digest.el | 2 +-
lisp/net/sasl-ntlm.el | 4 +-
lisp/net/sasl.el | 19 +-
lisp/net/sieve-mode.el | 18 +-
lisp/net/tramp-adb.el | 10 +-
lisp/net/tramp-sh.el | 25 +-
lisp/net/tramp-smb.el | 24 +-
lisp/net/webjump.el | 3 -
lisp/newcomment.el | 47 ++-
lisp/nxml/rng-util.el | 2 +-
lisp/obsolete/nnir.el | 1 +
lisp/org/ol.el | 8 +-
lisp/org/org.el | 2 +-
lisp/play/handwrite.el | 86 ++--
lisp/play/mpuz.el | 30 +-
lisp/progmodes/asm-mode.el | 3 +-
lisp/progmodes/bat-mode.el | 2 +-
lisp/progmodes/compile.el | 7 +-
lisp/progmodes/flymake.el | 16 +-
lisp/progmodes/perl-mode.el | 7 +-
lisp/progmodes/project.el | 4 +-
lisp/progmodes/sh-script.el | 14 +-
lisp/progmodes/xref.el | 12 +-
lisp/recentf.el | 9 +-
lisp/replace.el | 80 ++--
lisp/simple.el | 33 +-
lisp/startup.el | 2 +
lisp/subr.el | 10 +-
lisp/term/ns-win.el | 9 +
lisp/term/w32console.el | 2 +-
lisp/textmodes/nroff-mode.el | 9 +-
lisp/textmodes/remember.el | 2 +-
lisp/textmodes/tex-mode.el | 7 +-
lisp/thingatpt.el | 35 +-
lisp/tmm.el | 14 +-
lisp/url/url-about.el | 10 +-
lisp/url/url-cache.el | 2 +-
lisp/url/url-cid.el | 2 +-
lisp/url/url-dav.el | 18 +-
lisp/url/url-expand.el | 2 +-
lisp/url/url-file.el | 2 +-
lisp/url/url-gw.el | 15 +-
lisp/url/url-http.el | 25 +-
lisp/url/url-imap.el | 5 +-
lisp/url/url-ldap.el | 2 +-
lisp/url/url-mailto.el | 11 +-
lisp/url/url-methods.el | 4 +-
lisp/url/url-misc.el | 2 +-
lisp/url/url-news.el | 4 +-
lisp/url/url-nfs.el | 2 +-
lisp/url/url-privacy.el | 4 +-
lisp/url/url-proxy.el | 2 +-
lisp/url/url-tramp.el | 2 +-
lisp/url/url.el | 22 +-
lisp/vc/vc-dir.el | 11 +-
lisp/vc/vc-git.el | 3 +-
lisp/wdired.el | 24 +-
lisp/whitespace.el | 4 +-
lisp/window.el | 9 +-
m4/canonicalize.m4 | 60 ++-
m4/extensions.m4 | 14 +-
m4/fchmodat.m4 | 48 ++-
m4/gnulib-common.m4 | 15 +-
m4/gnulib-comp.m4 | 20 +
m4/nstrftime.m4 | 4 +-
m4/stddef_h.m4 | 16 +-
m4/string_h.m4 | 3 +-
m4/sys_stat_h.m4 | 4 +-
m4/time_h.m4 | 20 +-
m4/utimensat.m4 | 57 ++-
src/cmds.c | 1 +
src/conf_post.h | 4 +-
src/dispextern.h | 1 +
src/editfns.c | 11 +-
src/emacs-module.h.in | 4 +-
src/emacs.c | 10 +-
src/fns.c | 34 +-
src/frame.c | 12 +
src/frame.h | 22 +-
src/nsfns.m | 20 +-
src/nsmenu.m | 1 -
src/nsterm.m | 41 +-
src/process.c | 31 +-
src/term.c | 39 +-
src/w32common.h | 5 +
src/w32fns.c | 71 +++-
src/w32term.c | 27 +-
src/xdisp.c | 6 +-
src/xfaces.c | 3 +
src/xfns.c | 46 +++
src/xterm.c | 47 ++-
test/Makefile.in | 5 +-
test/infra/gitlab-ci.yml | 1 +
test/lisp/autorevert-tests.el | 25 +-
test/lisp/electric-tests.el | 15 +-
test/lisp/emacs-lisp/cl-lib-tests.el | 9 +-
test/lisp/emacs-lisp/seq-tests.el | 23 +-
test/lisp/find-cmd-tests.el | 45 +++
test/lisp/net/sasl-cram-tests.el | 46 +++
test/lisp/net/sasl-tests.el | 59 +++
test/lisp/net/tramp-tests.el | 52 ++-
test/lisp/progmodes/asm-mode-tests.el | 10 +
test/lisp/progmodes/elisp-mode-tests.el | 56 +++
test/manual/indent/shell.sh | 7 +
test/src/process-tests.el | 30 ++
248 files changed, 4414 insertions(+), 1981 deletions(-)
diff --git a/.clang-format b/.clang-format
index 9ab09a8..44200a3 100644
--- a/.clang-format
+++ b/.clang-format
@@ -1,5 +1,5 @@
Language: Cpp
-BasedOnStyle: LLVM
+BasedOnStyle: GNU
AlignEscapedNewlinesLeft: true
AlwaysBreakAfterReturnType: TopLevelDefinitions
BreakBeforeBinaryOperators: All
diff --git a/admin/notes/unicode b/admin/notes/unicode
index 45455d8..bcede9c 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -256,15 +256,6 @@ nontrivial changes to the build process.
etc/tutorials/TUTORIAL.ja
- * iso-2022-7bit
-
- This file contains multiple Chinese charsets, and converting it
- to UTF-8 would lose the charset property and would change the
- code's behavior. Although this could be worked around by
- propertizing the strings, that hasn't been done.
-
- lisp/international/titdic-cnv.el
-
* utf-8-emacs
These files contain characters that cannot be encoded in UTF-8.
@@ -276,6 +267,7 @@ nontrivial changes to the build process.
lisp/language/tibetan.el
lisp/leim/quail/ethiopic.el
lisp/leim/quail/tibetan.el
+ lisp/international/titdic-cnv.el
* binary files
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 3918853..221c9b1 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -1416,7 +1416,8 @@ Property value is a symbol `o' (Open), `c' (Close), or
`n' (None)."
(or elt (user-error "Unknown output file: %s" basename))
(or noninteractive (message "Generating %s..." file))
(with-temp-file file
- (insert ";; " copyright "
+ (insert ";;; " basename " -*- lexical-binding:t -*-
+;; " copyright "
;; Generated from Unicode data files by unidata-gen.el.
;; The sources for this file are found in the admin/unidata/ directory in
;; the Emacs sources. The Unicode data files are used under the
@@ -1451,7 +1452,8 @@ Property value is a symbol `o' (Open), `c' (Close), or
`n' (None)."
(defun unidata-gen-charprop (&optional charprop-file)
(or charprop-file (setq charprop-file (pop command-line-args-left)))
(with-temp-file charprop-file
- (insert ";; Automatically generated by unidata-gen.el.\n"
+ (insert ";; Automatically generated by unidata-gen.el."
+ " -*- lexical-binding: t -*-\n"
";; See the admin/unidata/ directory in the Emacs sources.\n")
(dolist (elt unidata-file-alist)
(dolist (proplist (cdr elt))
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 7f74817..f772702 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -1,8 +1,8 @@
#! /bin/sh
# Attempt to guess a canonical system name.
-# Copyright 1992-2020 Free Software Foundation, Inc.
+# Copyright 1992-2021 Free Software Foundation, Inc.
-timestamp='2020-12-22'
+timestamp='2021-01-01'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -50,7 +50,7 @@ version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2020 Free Software Foundation, Inc.
+Copyright 1992-2021 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -1087,7 +1087,7 @@ EOF
ppcle:Linux:*:*)
echo powerpcle-unknown-linux-"$LIBC"
exit ;;
- riscv32:Linux:*:* | riscv64:Linux:*:*)
+ riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* |
riscv64be:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
s390:Linux:*:* | s390x:Linux:*:*)
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 90bb8ae..b0f8492 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -1,8 +1,8 @@
#! /bin/sh
# Configuration validation subroutine script.
-# Copyright 1992-2020 Free Software Foundation, Inc.
+# Copyright 1992-2021 Free Software Foundation, Inc.
-timestamp='2020-12-22'
+timestamp='2021-01-07'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -67,7 +67,7 @@ Report bugs and patches to <config-patches@gnu.org>."
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2020 Free Software Foundation, Inc.
+Copyright 1992-2021 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -1230,7 +1230,7 @@ case $cpu-$vendor in
| powerpc | powerpc64 | powerpc64le | powerpcle |
powerpcspe \
| pru \
| pyramid \
- | riscv | riscv32 | riscv64 \
+ | riscv | riscv32 | riscv32be | riscv64 | riscv64be \
| rl78 | romp | rs6000 | rx \
| s390 | s390x \
| score \
@@ -1687,7 +1687,7 @@ case $os in
musl* | newlib* | uclibc*)
;;
# Likewise for "kernel-libc"
- eabi | eabihf | gnueabi | gnueabihf)
+ eabi* | gnueabi*)
;;
# Now accept the basic system types.
# The portable systems comes first.
diff --git a/configure.ac b/configure.ac
index bea2833..08f3c0c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5898,7 +5898,7 @@ if test $AUTO_DEPEND = yes; then
AS_MKDIR_P([$dir/deps])
done
fi
-if $gl_gnulib_enabled_scratch_buffer; then
+if $gl_gnulib_enabled_dynarray || $gl_gnulib_enabled_scratch_buffer; then
AS_MKDIR_P([lib/malloc])
if test $AUTO_DEPEND = yes; then
AS_MKDIR_P([lib/deps/malloc])
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 35df065..4f971eb 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -1369,10 +1369,14 @@ configurations. @xref{Tab Bars}.
The tab line is a line of tabs at the top of an Emacs window.
Clicking on one of these tabs switches window buffers. @xref{Tab Line}.
+@item Tag
+A tag is an identifier in a program source. @xref{Xref}.
+
@anchor{Glossary---Tags Table}
@item Tags Table
-A tags table is a file that serves as an index to the function
-definitions in one or more other files. @xref{Tags Tables}.
+A tags table is a file that serves as an index to identifiers: definitions
+of functions, macros, data structures, etc., in one or more other files.
+@xref{Tags Tables}.
@item Termscript File
A termscript file contains a record of all characters sent by Emacs to
diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi
index adb2ab8..e713c6e 100644
--- a/doc/emacs/kmacro.texi
+++ b/doc/emacs/kmacro.texi
@@ -179,6 +179,14 @@ itself counts as the first repetition, since it is
executed as you
define it, so @kbd{C-u 4 C-x )} executes the macro immediately 3
additional times.
+@findex kdb-macro-redisplay
+@kindex C-x C-k Q
+ While executing a long-running keyboard macro, it can sometimes be
+useful to trigger a redisplay (to show how far we've gotten). The
+@kbd{C-x C-k Q} can be used for this. As a not very useful example,
+@kbd{C-x ( M-f C-x C-k Q C-x )} will create a macro that will
+redisplay once per iteration when saying @kbd{C-u 42 C-x e}.
+
@node Keyboard Macro Ring
@section The Keyboard Macro Ring
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 4158154..bc276c4 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1994,19 +1994,21 @@ Of course, you should substitute the proper years and
copyright holder.
@section Find Identifier References
@cindex xref
+@cindex tag
An @dfn{identifier} is a name of a syntactical subunit of the
program: a function, a subroutine, a method, a class, a data type, a
macro, etc. In a programming language, each identifier is a symbol in
-the language's syntax. Program development and maintenance requires
-capabilities to quickly find where each identifier was defined and
-referenced, to rename identifiers across the entire project, etc.
-
-These capabilities are also useful for finding references in major
-modes other than those defined to support programming languages. For
-example, chapters, sections, appendices, etc.@: of a text or a @TeX{}
-document can be treated as subunits as well, and their names can be
-used as identifiers. In this chapter, we use the term ``identifiers''
-to collectively refer to the names of any kind of subunits, in program
+the language's syntax. Identifiers are also known as @dfn{tags}.
+
+Program development and maintenance requires capabilities to quickly
+find where each identifier was defined and referenced, to rename
+identifiers across the entire project, etc. These capabilities are
+also useful for finding references in major modes other than those
+defined to support programming languages. For example, chapters,
+sections, appendices, etc.@: of a text or a @TeX{} document can be
+treated as subunits as well, and their names can be used as
+identifiers. In this chapter, we use the term ``identifiers'' to
+collectively refer to the names of any kind of subunits, in program
source and in other kinds of text alike.
Emacs provides a unified interface to these capabilities, called
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 7f2a6f7..9b4716b 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -694,9 +694,17 @@ parameter (@pxref{Management Parameters}).
@item Internal Border
The internal border is a border drawn by Emacs around the inner frame
-(see below). Its width is specified by the @code{internal-border-width}
-frame parameter (@pxref{Layout Parameters}). Its color is specified by
-the background of the @code{internal-border} face.
+(see below). The specification of its appearance depends on whether
+or not the given frame is a child frame (@pxref{Child Frames}).
+
+For normal frames its width is specified by the @code{internal-border-width}
+frame parameter (@pxref{Layout Parameters}), and its color is specified by the
+background of the @code{internal-border} face.
+
+For child frames its width is specified by the @code{child-frame-border-width}
+frame parameter (but will use the @code{internal-border-width} parameter as
+fallback), and its color is specified by the background of the
+@code{child-frame-border} face.
@item Inner Frame
@cindex inner frame
@@ -1790,6 +1798,11 @@ The width in pixels of the frame's outer border
(@pxref{Frame Geometry}).
The width in pixels of the frame's internal border (@pxref{Frame
Geometry}).
+@vindex child-frame-border-width@r{, a frame parameter}
+@item child-frame-border-width
+The width in pixels of the frame's internal border (@pxref{Frame
+Geometry}) if the given frame is a child frame (@pxref{Child Frames}).
+
@vindex vertical-scroll-bars@r{, a frame parameter}
@item vertical-scroll-bars
Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
@@ -3748,10 +3761,31 @@ for instance using the window manager, then this
produces a quit and
You can specify the mouse pointer style for particular text or
images using the @code{pointer} text property, and for images with the
@code{:pointer} and @code{:map} image properties. The values you can
-use in these properties are @code{text} (or @code{nil}), @code{arrow},
-@code{hand}, @code{vdrag}, @code{hdrag}, @code{modeline}, and
-@code{hourglass}. @code{text} stands for the usual mouse pointer
-style used over text.
+use in these properties are in the table below. The actual shapes
+may vary between systems; the descriptions are examples.
+
+@table @code
+@item text
+@itemx nil
+The usual mouse pointer style used over text (an ``I''-like shape).
+
+@item arrow
+@itemx vdrag
+@itemx modeline
+An arrow that points north-west.
+
+@item hand
+A hand that points upwards.
+
+@item hdrag
+A right-left arrow.
+
+@item nhdrag
+An up-down arrow.
+
+@item hourglass
+A rotating ring.
+@end table
Over void parts of the window (parts that do not correspond to any
of the buffer contents), the mouse pointer usually uses the
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 0b567d8..b367346 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -334,6 +334,25 @@ but there is no peace.
(thing-at-point 'whitespace)
@result{} nil
@end example
+
+@defvar thing-at-point-provider-alist
+This variable allows users and modes to tweak how
+@code{thing-at-point} works. It's an association list of @var{thing}s
+and functions (called with zero parameters) to return that thing.
+Entries for @var{thing} will be evaluated in turn until a
+non-@code{nil} result is returned.
+
+For instance, a major mode could say:
+
+@lisp
+(setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . my-mode--url-at-point))))
+@end lisp
+
+If no providers have a non-@code{nil} return, the @var{thing} will be
+computed the standard way.
+@end defvar
@end defun
@node Comparing Text
@@ -1422,6 +1441,11 @@ the @code{amalgamating-undo-limit} variable. If this
variable is 1,
no changes are amalgamated.
@end defun
+A Lisp program can amalgamate a series of changes into a single change
+group by calling @code{undo-amalgamate-change-group} (@pxref{Atomic
+Changes}). Note that @code{amalgamating-undo-limit} has no effect on
+the groups produced by that function.
+
@defvar undo-auto-current-boundary-timer
Some buffers, such as process buffers, can change even when no
commands are executing. In these cases, @code{undo-boundary} is
@@ -5610,6 +5634,19 @@ This function cancels and undoes all the changes in the
change group
specified by @var{handle}.
@end defun
+ You can cause some or all of the changes in a change group to be
+considered as a single unit for the purposes of the @code{undo}
+commands (@pxref{Undo}) by using @code{undo-amalgamate-change-group}.
+
+@defun undo-amalgamate-change-group
+Amalgamate all the changes made in the change-group since the state
+identified by @var{handle}. This function removes all undo boundaries
+between undo records of changes since the state described by
+@var{handle}. Usually, @var{handle} is the handle returned by
+@code{prepare-change-group}, in which case all the changes since the
+beginning of the change-group are amalgamated into a single undo unit.
+@end defun
+
Your code should use @code{unwind-protect} to make sure the group is
always finished. The call to @code{activate-change-group} should be
inside the @code{unwind-protect}, in case the user types @kbd{C-g}
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index 5eeb098..8902d62 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -4071,7 +4071,7 @@ the link. Such a function will be called with the tag as
the only
argument.
With the above setting, you could link to a specific bug with
-@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with
@samp{[[google:OrgMode]]},
+@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with
@samp{[[duckduckgo:OrgMode]]},
show the map location of the Free Software Foundation @samp{[[gmap:51
Franklin Street, Boston]]} or of Carsten office @samp{[[omap:Science Park 904,
Amsterdam, The Netherlands]]} and find out what the Org author is doing
@@ -4082,8 +4082,8 @@ can define them in the file with
@cindex @samp{LINK}, keyword
@example
-#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
-#+LINK: google http://www.google.com/search?q=%s
+#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
+#+LINK: duckduckgo https://duckduckgo.com/?q=%s
@end example
In-buffer completion (see @ref{Completion}) can be used after @samp{[} to
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 3c7051d..dac7ae3 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2020-10-24.12}
+\def\texinfoversion{2020-11-25.18}
%
% Copyright 1985, 1986, 1988, 1990-2020 Free Software Foundation, Inc.
%
@@ -572,10 +572,9 @@
\fi
}
-% @end foo executes the definition of \Efoo.
-% But first, it executes a specialized version of \checkenv
-%
-\parseargdef\end{%
+
+% @end foo calls \checkenv and executes the definition of \Efoo.
+\parseargdef\end{
\if 1\csname iscond.#1\endcsname
\else
% The general wording of \badenverr may not be ideal.
@@ -2673,8 +2672,6 @@ end
\definetextfontsizexi
-\message{markup,}
-
% Check if we are currently using a typewriter font. Since all the
% Computer Modern typewriter fonts have zero interword stretch (and
% shrink), and it is reasonable to expect all typewriter fonts to have
@@ -2682,68 +2679,14 @@ end
%
\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
-% Markup style infrastructure. \defmarkupstylesetup\INITMACRO will
-% define and register \INITMACRO to be called on markup style changes.
-% \INITMACRO can check \currentmarkupstyle for the innermost
-% style.
-
-\let\currentmarkupstyle\empty
-
-\def\setupmarkupstyle#1{%
- \def\currentmarkupstyle{#1}%
- \markupstylesetup
-}
-
-\let\markupstylesetup\empty
-
-\def\defmarkupstylesetup#1{%
- \expandafter\def\expandafter\markupstylesetup
- \expandafter{\markupstylesetup #1}%
- \def#1%
-}
-
-% Markup style setup for left and right quotes.
-\defmarkupstylesetup\markupsetuplq{%
- \expandafter\let\expandafter \temp
- \csname markupsetuplq\currentmarkupstyle\endcsname
- \ifx\temp\relax \markupsetuplqdefault \else \temp \fi
-}
-
-\defmarkupstylesetup\markupsetuprq{%
- \expandafter\let\expandafter \temp
- \csname markupsetuprq\currentmarkupstyle\endcsname
- \ifx\temp\relax \markupsetuprqdefault \else \temp \fi
-}
-
{
\catcode`\'=\active
\catcode`\`=\active
-\gdef\markupsetuplqdefault{\let`\lq}
-\gdef\markupsetuprqdefault{\let'\rq}
-
-\gdef\markupsetcodequoteleft{\let`\codequoteleft}
-\gdef\markupsetcodequoteright{\let'\codequoteright}
+\gdef\setcodequotes{\let`\codequoteleft \let'\codequoteright}
+\gdef\setregularquotes{\let`\lq \let'\rq}
}
-\let\markupsetuplqcode \markupsetcodequoteleft
-\let\markupsetuprqcode \markupsetcodequoteright
-%
-\let\markupsetuplqexample \markupsetcodequoteleft
-\let\markupsetuprqexample \markupsetcodequoteright
-%
-\let\markupsetuplqkbd \markupsetcodequoteleft
-\let\markupsetuprqkbd \markupsetcodequoteright
-%
-\let\markupsetuplqsamp \markupsetcodequoteleft
-\let\markupsetuprqsamp \markupsetcodequoteright
-%
-\let\markupsetuplqverb \markupsetcodequoteleft
-\let\markupsetuprqverb \markupsetcodequoteright
-%
-\let\markupsetuplqverbatim \markupsetcodequoteleft
-\let\markupsetuprqverbatim \markupsetcodequoteright
-
% Allow an option to not use regular directed right quote/apostrophe
% (char 0x27), but instead the undirected quote from cmtt (char 0x0d).
% The undirected quote is ugly, so don't make it the default, but it
@@ -2906,7 +2849,7 @@ end
}
% @samp.
-\def\samp#1{{\setupmarkupstyle{samp}\lq\tclose{#1}\rq\null}}
+\def\samp#1{{\setcodequotes\lq\tclose{#1}\rq\null}}
% @indicateurl is \samp, that is, with quotes.
\let\indicateurl=\samp
@@ -2949,8 +2892,7 @@ end
\global\let'=\rq \global\let`=\lq % default definitions
%
\global\def\code{\begingroup
- \setupmarkupstyle{code}%
- % The following should really be moved into \setupmarkupstyle handlers.
+ \setcodequotes
\catcode\dashChar=\active \catcode\underChar=\active
\ifallowcodebreaks
\let-\codedash
@@ -3104,7 +3046,7 @@ end
\urefcatcodes
%
\global\def\urefcode{\begingroup
- \setupmarkupstyle{code}%
+ \setcodequotes
\urefcatcodes
\let&\urefcodeamp
\let.\urefcodedot
@@ -3225,8 +3167,8 @@ end
\def\kbdsub#1#2#3\par{%
\def\one{#1}\def\three{#3}\def\threex{??}%
\ifx\one\xkey\ifx\threex\three \key{#2}%
- \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
- \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
+ \else{\tclose{\kbdfont\setcodequotes\look}}\fi
+ \else{\tclose{\kbdfont\setcodequotes\look}}\fi
}
% definition of @key that produces a lozenge. Doesn't adjust to text size.
@@ -3243,7 +3185,7 @@ end
% monospace, don't change it; that way, we respect @kbdinputstyle. But
% if it isn't monospace, then use \tt.
%
-\def\key#1{{\setupmarkupstyle{key}%
+\def\key#1{{\setregularquotes
\nohyphenation
\ifmonospace\else\tt\fi
#1}\null}
@@ -3373,16 +3315,20 @@ end
{\obeylines
\globaldefs=1
\envdef\displaymath{%
-\tex
+\tex%
\def\thisenv{\displaymath}%
+\begingroup\let\end\displaymathend%
$$%
}
-\def\Edisplaymath{$$
+\def\displaymathend{$$\endgroup\end}%
+
+\def\Edisplaymath{%
\def\thisenv{\tex}%
\end tex
}}
+
% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}.
% Ignore unless FMTNAME == tex; then it is like @iftex and @tex,
% except specified as a normal braced arg, so no newlines to worry about.
@@ -7144,7 +7090,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% But \@ or @@ will get a plain @ character.
\envdef\tex{%
- \setupmarkupstyle{tex}%
+ \setregularquotes
\catcode `\\=0 \catcode `\{=1 \catcode `\}=2
\catcode `\$=3 \catcode `\&=4 \catcode `\#=6
\catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie
@@ -7370,7 +7316,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% If you want all examples etc. small: @set dispenvsize small.
% If you want even small examples the full size: @set dispenvsize nosmall.
% This affects the following displayed environments:
-% @example, @display, @format, @lisp
+% @example, @display, @format, @lisp, @verbatim
%
\def\smallword{small}
\def\nosmallword{nosmall}
@@ -7416,9 +7362,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
\maketwodispenvdef{lisp}{example}{%
\nonfillstart
- \tt\setupmarkupstyle{example}%
+ \tt\setcodequotes
\let\kbdfont = \kbdexamplefont % Allow @kbd to do something special.
- \gobble % eat return
+ \parsearg\gobble
}
% @display/@smalldisplay: same as @lisp except keep current font.
%
@@ -7576,7 +7522,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\setupverb{%
\tt % easiest (and conventionally used) font for verbatim
\def\par{\leavevmode\endgraf}%
- \setupmarkupstyle{verb}%
+ \setcodequotes
\tabeightspaces
% Respect line breaks,
% print special symbols as themselves, and
@@ -7617,7 +7563,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\tt % easiest (and conventionally used) font for verbatim
\def\par{\egroup\leavevmode\box\verbbox\endgraf\starttabbox}%
\tabexpand
- \setupmarkupstyle{verbatim}%
+ \setcodequotes
% Respect line breaks,
% print special symbols as themselves, and
% make each space count.
@@ -8036,7 +7982,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% leave the code in, but it's strange for @var to lead to typewriter.
% Nowadays we recommend @code, since the difference between a ttsl hyphen
% and a tt hyphen is pretty tiny. @code also disables ?` !`.
- \def\var##1{{\setupmarkupstyle{var}\ttslanted{##1}}}%
+ \def\var##1{{\setregularquotes\ttslanted{##1}}}%
#1%
\sl\hyphenchar\font=45
}
@@ -8145,11 +8091,18 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
\fi
+\let\E=\expandafter
+
% Used at the time of macro expansion.
% Argument is macro body with arguments substituted
\def\scanmacro#1{%
\newlinechar`\^^M
- \def\xeatspaces{\eatspaces}%
+ % expand the expansion of \eatleadingcr twice to maybe remove a leading
+ % newline (and \else and \fi tokens), then call \eatspaces on the result.
+ \def\xeatspaces##1{%
+ \E\E\E\E\E\E\E\eatspaces\E\E\E\E\E\E\E{\eatleadingcr##1%
+ }}%
+ \def\xempty##1{}%
%
% Process the macro body under the current catcode regime.
\scantokens{#1@comment}%
@@ -8202,6 +8155,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\unbrace{\gdef\trim@@@ #1 } #2@{#1}
}
+{\catcode`\^^M=\other%
+\gdef\eatleadingcr#1{\if\noexpand#1\noexpand^^M\else\E#1\fi}}%
+% Warning: this won't work for a delimited argument
+% or for an empty argument
+
% Trim a single trailing ^^M off a string.
{\catcode`\^^M=\other \catcode`\Q=3%
\gdef\eatcr #1{\eatcra #1Q^^MQ}%
@@ -8368,6 +8326,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\hash\relax
% \hash is redefined to `#' later to get it into definitions
\let\xeatspaces\relax
+ \let\xempty\relax
\parsemargdefxxx#1,;,%
\ifnum\paramno<10\relax\else
\paramno0\relax
@@ -8379,9 +8338,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\else \let\next=\parsemargdefxxx
\advance\paramno by 1
\expandafter\edef\csname macarg.\eatspaces{#1}\endcsname
- {\xeatspaces{\hash\the\paramno}}%
+ {\xeatspaces{\hash\the\paramno\noexpand\xempty{}}}%
\edef\paramlist{\paramlist\hash\the\paramno,}%
\fi\next}
+% the \xempty{} is to give \eatleadingcr an argument in the case of an
+% empty macro argument.
% \parsemacbody, \parsermacbody
%
@@ -9107,20 +9068,22 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% output the `[mynode]' via the macro below so it can be overridden.
\xrefprintnodename\printedrefname
%
- % But we always want a comma and a space:
- ,\space
- %
- % output the `page 3'.
- \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
- % Add a , if xref followed by a space
- \if\space\noexpand\tokenafterxref ,%
- \else\ifx\ \tokenafterxref ,% @TAB
- \else\ifx\*\tokenafterxref ,% @*
- \else\ifx\ \tokenafterxref ,% @SPACE
- \else\ifx\
- \tokenafterxref ,% @NL
- \else\ifx\tie\tokenafterxref ,% @tie
- \fi\fi\fi\fi\fi\fi
+ \expandafter\ifx\csname SETtxiomitxrefpg\endcsname\relax
+ % But we always want a comma and a space:
+ ,\space
+ %
+ % output the `page 3'.
+ \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+ % Add a , if xref followed by a space
+ \if\space\noexpand\tokenafterxref ,%
+ \else\ifx\ \tokenafterxref ,% @TAB
+ \else\ifx\*\tokenafterxref ,% @*
+ \else\ifx\ \tokenafterxref ,% @SPACE
+ \else\ifx\
+ \tokenafterxref ,% @NL
+ \else\ifx\tie\tokenafterxref ,% @tie
+ \fi\fi\fi\fi\fi\fi
+ \fi
\fi\fi
\fi
\endlink
@@ -9550,7 +9513,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup
\catcode`\^^M = 5 % in case we're inside an example
\normalturnoffactive % allow _ et al. in names
- \def\xprocessmacroarg{\eatspaces}% in case we are being used via a macro
+ \makevalueexpandable
% If the image is by itself, center it.
\ifvmode
\imagevmodetrue
@@ -11603,7 +11566,7 @@ directory should work if nowhere else does.}
\let> = \activegtr
\let~ = \activetilde
\let^ = \activehat
- \markupsetuplqdefault \markupsetuprqdefault
+ \setregularquotes
\let\b = \strong
\let\i = \smartitalic
% in principle, all other definitions in \tex have to be undone too.
@@ -11662,8 +11625,7 @@ directory should work if nowhere else does.}
@let|=@normalverticalbar
@let~=@normaltilde
@let\=@ttbackslash
- @markupsetuplqdefault
- @markupsetuprqdefault
+ @setregularquotes
@unsepspaces
}
}
@@ -11756,8 +11718,7 @@ directory should work if nowhere else does.}
@c Do this last of all since we use ` in the previous @catcode assignments.
@catcode`@'=@active
@catcode`@`=@active
-@markupsetuplqdefault
-@markupsetuprqdefault
+@setregularquotes
@c Local variables:
@c eval: (add-hook 'before-save-hook 'time-stamp)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index e9ffd6a..efe8395 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -810,9 +810,10 @@ behavior.
@cindex @option{sshx} method
Works like @option{ssh} but without the extra authentication prompts.
-@option{sshx} uses @samp{ssh -t -t @var{host} -l @var{user} /bin/sh}
-to open a connection with a ``standard'' login shell. It supports
-changing the remote login shell @command{/bin/sh}.
+@option{sshx} uses @samp{ssh -t -t -l @var{user} -o
+RemoteCommand='/bin/sh -i' @var{host}} to open a connection with a
+``standard'' login shell. It supports changing the remote login shell
+@command{/bin/sh}.
@strong{Note} that @option{sshx} does not bypass authentication
questions. For example, if the host key of the remote host is not
@@ -935,9 +936,10 @@ This method supports the @samp{-p} argument.
@cindex @command{ssh} (with @option{scpx} method)
@option{scpx} is useful to avoid login shell questions. It is similar
-in performance to @option{scp}. @option{scpx} uses @samp{ssh -t -t
-@var{host} -l @var{user} /bin/sh} to open a connection. It supports
-changing the remote login shell @command{/bin/sh}.
+in performance to @option{scp}. @option{scpx} uses @samp{ssh -t -t -l
+@var{user} -o RemoteCommand='/bin/sh -i' @var{host}} to open a
+connection. It supports changing the remote login shell
+@command{/bin/sh}.
@option{scpx} is useful for MS Windows users when @command{ssh}
triggers an error about allocating a pseudo tty. This happens due to
@@ -1284,6 +1286,9 @@ This method uses @command{sftp} in order to securely
access remote
hosts. @command{sftp} is a more secure option for connecting to hosts
that for security reasons refuse @command{ssh} connections.
+When there is a respective entry in your @command{ssh} configuration,
+do @emph{not} set the @option{RemoteCommand} option.
+
@end table
@defopt tramp-gvfs-methods
@@ -2220,7 +2225,10 @@ This uses also the settings in
@code{tramp-sh-extra-args}.
@vindex RemoteCommand@r{, ssh option}
@strong{Note}: If you use an @option{ssh}-based method for connection,
do @emph{not} set the @option{RemoteCommand} option in your
-@command{ssh} configuration, for example to @command{screen}.
+@command{ssh} configuration, for example to @command{screen}. On the
+other hand, some @option{ssh}-based methods, like @option{sshx} or
+@option{scpx}, silently overwrite a @option{RemoteCommand} option of
+the configuration file.
@subsection Other remote shell setup hints
@@ -3580,7 +3588,6 @@ Furthermore, this approach has the following limitations:
It works only for connection methods defined in @file{tramp-sh.el} and
@file{tramp-adb.el}.
-@vindex ControlMaster@r{, ssh option}
@item
It does not support interactive user authentication. With
@option{ssh}-based methods, this can be avoided by using a password
@@ -3588,6 +3595,10 @@ agent like @command{ssh-agent}, using public key
authentication, or
using @option{ControlMaster} options.
@item
+It cannot be applied for @option{ssh}-based methods, which use the
+@option{RemoteCommand} option.
+
+@item
It cannot be killed via @code{interrupt-process}.
@item
@@ -3597,8 +3608,7 @@ It does not report the remote terminal name via
@code{process-tty-name}.
It does not set process property @code{remote-pid}.
@item
-It does not use @code{tramp-remote-path} and
-@code{tramp-remote-process-environment}.
+It does not use @code{tramp-remote-path}.
@end itemize
In order to gain even more performance, it is recommended to bind
diff --git a/etc/NEWS b/etc/NEWS
index 357c75b..8e233f8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1098,6 +1098,11 @@ If present in 'whitespace-style' (as it is by default),
the final
character in the buffer will be highlighted if the buffer doesn't end
with a newline.
+---
+*** The default 'whitespace-enable-predicate' predicate has changed.
+It used to check elements in the list version of
+'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'.
+
** Texinfo
---
@@ -1564,8 +1569,17 @@ that makes it a valid button.
*** New macro `named-let` that provides Scheme's "named let" looping construct
+** thingatpt
+
++++
+*** New variable 'thing-at-point-provider-alist'.
+This allows mode-specific alterations to how `thing-at-point' works.
+
** Miscellaneous
++++
+*** New command `C-x C-k Q' to force redisplay in keyboard macros.
+
---
*** New user option 'remember-diary-regexp'.
@@ -2012,6 +2026,14 @@ hooks 'kill-buffer-hook', 'kill-buffer-query-functions',
and
'buffer-list-update-hook' for the temporary buffers they create. This
avoids slowing them down when a lot of these hooks are defined.
+** New face 'child-frame-border' and frame parameter
'child-frame-border-width'.
+The face and width of child frames borders can now be determined
+separately from those of normal frames. To minimize backward
+incompatibility, child frames without a 'child-frame-border-width'
+parameter will fall back to using 'internal-border-width'. However,
+the new 'child-frame-border' face does constitute a breaking change
+since child frames' borders no longer use the 'internal-border' face.
+
---
** The obsolete function 'thread-alive-p' has been removed.
@@ -2127,6 +2149,8 @@ obsolete back in Emacs-23.1. The affected functions are:
make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
define-obsolete-variable-alias.
+** The variable 'keyboard-type' is obsolete and not dynamically scoped any more
+
* Lisp Changes in Emacs 28.1
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index 2378f6f..687379d 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -1,4 +1,4 @@
-;; leim-ext.el -- extra leim configuration -*- coding:utf-8; -*-
+;; leim-ext.el -- extra leim configuration -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -39,13 +39,13 @@
(eval-after-load "quail/Punct-b5"
'(quail-defrule " " ? nil t))
-(register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+"
+(register-input-method "ucs" "UTF-8" #'ucs-input-activate "U+"
"Unicode input as hex in the form Uxxxx.")
(register-input-method
"korean-hangul"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한2"
"Hangul 2-Bulsik Input"
'hangul2-input-method
@@ -54,7 +54,7 @@
(register-input-method
"korean-hangul3f"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한3f"
"Hangul 3-Bulsik final Input"
'hangul3-input-method
@@ -63,7 +63,7 @@
(register-input-method
"korean-hangul390"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한390"
"Hangul 3-Bulsik 390 Input"
'hangul390-input-method
@@ -72,7 +72,7 @@
(register-input-method
"korean-hangul3"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한390"
"Hangul 3-Bulsik 390 Input"
'hangul390-input-method
diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h
index 38afe1d..fb718bc 100644
--- a/lib/_Noreturn.h
+++ b/lib/_Noreturn.h
@@ -26,14 +26,16 @@
AIX system header files and several gnulib header files use precisely
this syntax with 'extern'. */
# define _Noreturn [[noreturn]]
-# elif ((!defined __cplusplus || defined __clang__) \
- && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
- || (defined __apple_build_version__ \
- ? 6000000 <= __apple_build_version__ \
- : 3 < __clang_major__ + (5 <= __clang_minor__))))
+# elif ((!defined __cplusplus || defined __clang__) \
+ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
+ || (!defined __STRICT_ANSI__ \
+ && (__4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))))
/* _Noreturn works as-is. */
-# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
+# elif (2 < __GNUC__ + (8 <= __GNUC_MINOR__) || defined __clang__ \
+ || 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0)
# define _Noreturn __declspec (noreturn)
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index b6dc3a4..b7dba08 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -85,10 +85,6 @@
# define IF_LINT(Code) /* empty */
#endif
-/* True if adding two valid object sizes might overflow idx_t.
- As a practical matter, this cannot happen on 64-bit machines. */
-enum { NARROW_ADDRESSES = IDX_MAX >> 31 >> 31 == 0 };
-
#ifndef DOUBLE_SLASH_IS_DISTINCT_ROOT
# define DOUBLE_SLASH_IS_DISTINCT_ROOT false
#endif
@@ -145,11 +141,11 @@ suffix_requires_dir_check (char const *end)
macOS 10.13 <https://bugs.gnu.org/30350>, and should also work on
platforms like AIX 7.2 that need at least "/.". */
-#if defined _LIBC || defined LSTAT_FOLLOWS_SLASHED_SYMLINK
+# if defined _LIBC || defined LSTAT_FOLLOWS_SLASHED_SYMLINK
static char const dir_suffix[] = "/";
-#else
+# else
static char const dir_suffix[] = "/./";
-#endif
+# endif
/* Return true if DIR is a searchable dir, false (setting errno) otherwise.
DIREND points to the NUL byte at the end of the DIR string.
@@ -191,13 +187,13 @@ get_path_max (void)
to pacify GCC is known; even an explicit #pragma does not pacify GCC.
When the GCC bug is fixed this workaround should be limited to the
broken GCC versions. */
-#if __GNUC_PREREQ (10, 1)
-# if defined GCC_LINT || defined lint
+# if __GNUC_PREREQ (10, 1)
+# if defined GCC_LINT || defined lint
__attribute__ ((__noinline__))
-# elif __OPTIMIZE__ && !__NO_INLINE__
-# define GCC_BOGUS_WRETURN_LOCAL_ADDR
+# elif __OPTIMIZE__ && !__NO_INLINE__
+# define GCC_BOGUS_WRETURN_LOCAL_ADDR
+# endif
# endif
-#endif
static char *
realpath_stk (const char *name, char *resolved,
struct scratch_buffer *rname_buf)
@@ -343,7 +339,7 @@ realpath_stk (const char *name, char *resolved,
if (end_in_extra_buffer)
end_idx = end - extra_buf;
size_t len = strlen (end);
- if (NARROW_ADDRESSES && INT_ADD_OVERFLOW (len, n))
+ if (INT_ADD_OVERFLOW (len, n))
{
__set_errno (ENOMEM);
goto error_nomem;
@@ -443,7 +439,8 @@ __realpath (const char *name, char *resolved)
}
libc_hidden_def (__realpath)
versioned_symbol (libc, __realpath, realpath, GLIBC_2_3);
-#endif /* !FUNC_REALPATH_WORKS || defined _LIBC */
+
+#endif /* defined _LIBC || !FUNC_REALPATH_WORKS */
#if SHLIB_COMPAT(libc, GLIBC_2_0, GLIBC_2_3)
diff --git a/lib/cdefs.h b/lib/cdefs.h
index 2a3dc96..17a0919 100644
--- a/lib/cdefs.h
+++ b/lib/cdefs.h
@@ -25,7 +25,7 @@
/* The GNU libc does not support any K&R compilers or the traditional mode
of ISO C compilers anymore. Check for some of the combinations not
- anymore supported. */
+ supported anymore. */
#if defined __GNUC__ && !defined __STDC__
# error "You need a ISO C conforming compiler to use the glibc headers"
#endif
@@ -34,31 +34,26 @@
#undef __P
#undef __PMT
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_attribute(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_attribute
-# define __glibc_clang_has_attribute(name) __has_attribute (name)
+/* Compilers that lack __has_attribute may object to
+ #if defined __has_attribute && __has_attribute (...)
+ even though they do not need to evaluate the right-hand side of the &&.
+ Similarly for __has_builtin, etc. */
+#if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
+# define __glibc_has_attribute(attr) __has_attribute (attr)
#else
-# define __glibc_clang_has_attribute(name) 0
+# define __glibc_has_attribute(attr) 0
#endif
-
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_builtin(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_builtin
-# define __glibc_clang_has_builtin(name) __has_builtin (name)
+#ifdef __has_builtin
+# define __glibc_has_builtin(name) __has_builtin (name)
#else
-# define __glibc_clang_has_builtin(name) 0
+# define __glibc_has_builtin(name) 0
#endif
-
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_extension(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_extension
-# define __glibc_clang_has_extension(ext) __has_extension (ext)
+#ifdef __has_extension
+# define __glibc_has_extension(ext) __has_extension (ext)
#else
-# define __glibc_clang_has_extension(ext) 0
+# define __glibc_has_extension(ext) 0
#endif
#if defined __GNUC__ || defined __clang__
@@ -74,22 +69,26 @@
# endif
/* GCC can always grok prototypes. For C++ programs we add throw()
- to help it optimize the function calls. But this works only with
+ to help it optimize the function calls. But this only works with
gcc 2.8.x and egcs. For gcc 3.4 and up we even mark C functions
as non-throwing using a function attribute since programs can use
the -fexceptions options for C code as well. */
# if !defined __cplusplus \
- && (__GNUC_PREREQ (3, 4) || __glibc_clang_has_attribute (__nothrow__))
+ && (__GNUC_PREREQ (3, 4) || __glibc_has_attribute (__nothrow__))
# define __THROW __attribute__ ((__nothrow__ __LEAF))
# define __THROWNL __attribute__ ((__nothrow__))
# define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct
# define __NTHNL(fct) __attribute__ ((__nothrow__)) fct
# else
# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major >= 4)
-# define __THROW throw ()
-# define __THROWNL throw ()
-# define __NTH(fct) __LEAF_ATTR fct throw ()
-# define __NTHNL(fct) fct throw ()
+# if __cplusplus >= 201103L
+# define __THROW noexcept (true)
+# else
+# define __THROW throw ()
+# endif
+# define __THROWNL __THROW
+# define __NTH(fct) __LEAF_ATTR fct __THROW
+# define __NTHNL(fct) fct __THROW
# else
# define __THROW
# define __THROWNL
@@ -142,24 +141,20 @@
#define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1)
#define __bos0(ptr) __builtin_object_size (ptr, 0)
+/* Use __builtin_dynamic_object_size at _FORTIFY_SOURCE=3 when available. */
+#if __USE_FORTIFY_LEVEL == 3 && __glibc_clang_prereq (9, 0)
+# define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0)
+# define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1)
+#else
+# define __glibc_objsize0(__o) __bos0 (__o)
+# define __glibc_objsize(__o) __bos (__o)
+#endif
+
#if __GNUC_PREREQ (4,3)
-# define __warndecl(name, msg) \
- extern void name (void) __attribute__((__warning__ (msg)))
# define __warnattr(msg) __attribute__((__warning__ (msg)))
# define __errordecl(name, msg) \
extern void name (void) __attribute__((__error__ (msg)))
-#elif __glibc_clang_has_attribute (__diagnose_if__) && 0
-/* These definitions are not enabled, because they produce bogus warnings
- in the glibc Fortify functions. These functions are written in a style
- that works with GCC. In order to work with clang, these functions would
- need to be modified. */
-# define __warndecl(name, msg) \
- extern void name (void) __attribute__((__diagnose_if__ (1, msg, "warning")))
-# define __warnattr(msg) __attribute__((__diagnose_if__ (1, msg, "warning")))
-# define __errordecl(name, msg) \
- extern void name (void) __attribute__((__diagnose_if__ (1, msg, "error")))
#else
-# define __warndecl(name, msg) extern void name (void)
# define __warnattr(msg)
# define __errordecl(name, msg) extern void name (void)
#endif
@@ -233,7 +228,7 @@
/* At some point during the gcc 2.96 development the `malloc' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__malloc__)
+#if __GNUC_PREREQ (2,96) || __glibc_has_attribute (__malloc__)
# define __attribute_malloc__ __attribute__ ((__malloc__))
#else
# define __attribute_malloc__ /* Ignore */
@@ -251,23 +246,31 @@
/* At some point during the gcc 2.96 development the `pure' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__pure__)
+#if __GNUC_PREREQ (2,96) || __glibc_has_attribute (__pure__)
# define __attribute_pure__ __attribute__ ((__pure__))
#else
# define __attribute_pure__ /* Ignore */
#endif
/* This declaration tells the compiler that the value is constant. */
-#if __GNUC_PREREQ (2,5) || __glibc_clang_has_attribute (__const__)
+#if __GNUC_PREREQ (2,5) || __glibc_has_attribute (__const__)
# define __attribute_const__ __attribute__ ((__const__))
#else
# define __attribute_const__ /* Ignore */
#endif
+#if defined __STDC_VERSION__ && 201710L < __STDC_VERSION__
+# define __attribute_maybe_unused__ [[__maybe_unused__]]
+#elif __GNUC_PREREQ (2,7) || __glibc_has_attribute (__unused__)
+# define __attribute_maybe_unused__ __attribute__ ((__unused__))
+#else
+# define __attribute_maybe_unused__ /* Ignore */
+#endif
+
/* At some point during the gcc 3.1 development the `used' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (3,1) || __glibc_clang_has_attribute (__used__)
+#if __GNUC_PREREQ (3,1) || __glibc_has_attribute (__used__)
# define __attribute_used__ __attribute__ ((__used__))
# define __attribute_noinline__ __attribute__ ((__noinline__))
#else
@@ -276,7 +279,7 @@
#endif
/* Since version 3.2, gcc allows marking deprecated functions. */
-#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__deprecated__)
+#if __GNUC_PREREQ (3,2) || __glibc_has_attribute (__deprecated__)
# define __attribute_deprecated__ __attribute__ ((__deprecated__))
#else
# define __attribute_deprecated__ /* Ignore */
@@ -285,8 +288,8 @@
/* Since version 4.5, gcc also allows one to specify the message printed
when a deprecated function is used. clang claims to be gcc 4.2, but
may also support this feature. */
-#if __GNUC_PREREQ (4,5) || \
- __glibc_clang_has_extension (__attribute_deprecated_with_message__)
+#if __GNUC_PREREQ (4,5) \
+ || __glibc_has_extension (__attribute_deprecated_with_message__)
# define __attribute_deprecated_msg__(msg) \
__attribute__ ((__deprecated__ (msg)))
#else
@@ -299,7 +302,7 @@
If several `format_arg' attributes are given for the same function, in
gcc-3.0 and older, all but the last one are ignored. In newer gccs,
all designated arguments are considered. */
-#if __GNUC_PREREQ (2,8) || __glibc_clang_has_attribute (__format_arg__)
+#if __GNUC_PREREQ (2,8) || __glibc_has_attribute (__format_arg__)
# define __attribute_format_arg__(x) __attribute__ ((__format_arg__ (x)))
#else
# define __attribute_format_arg__(x) /* Ignore */
@@ -309,7 +312,7 @@
attribute for functions was introduced. We don't want to use it
unconditionally (although this would be possible) since it
generates warnings. */
-#if __GNUC_PREREQ (2,97) || __glibc_clang_has_attribute (__format__)
+#if __GNUC_PREREQ (2,97) || __glibc_has_attribute (__format__)
# define __attribute_format_strfmon__(a,b) \
__attribute__ ((__format__ (__strfmon__, a, b)))
#else
@@ -317,19 +320,21 @@
#endif
/* The nonnull function attribute marks pointer parameters that
- must not be NULL. Do not define __nonnull if it is already defined,
- for portability when this file is used in Gnulib. */
+ must not be NULL. */
#ifndef __nonnull
-# if __GNUC_PREREQ (3,3) || __glibc_clang_has_attribute (__nonnull__)
+# if __GNUC_PREREQ (3,3) || __glibc_has_attribute (__nonnull__)
# define __nonnull(params) __attribute__ ((__nonnull__ params))
# else
# define __nonnull(params)
# endif
+#elif !defined __GLIBC__
+# undef __nonnull
+# define __nonnull(params) _GL_ATTRIBUTE_NONNULL (params)
#endif
/* If fortification mode, we warn about unused results of certain
function calls which can lead to problems. */
-#if __GNUC_PREREQ (3,4) || __glibc_clang_has_attribute (__warn_unused_result__)
+#if __GNUC_PREREQ (3,4) || __glibc_has_attribute (__warn_unused_result__)
# define __attribute_warn_unused_result__ \
__attribute__ ((__warn_unused_result__))
# if defined __USE_FORTIFY_LEVEL && __USE_FORTIFY_LEVEL > 0
@@ -343,7 +348,7 @@
#endif
/* Forces a function to be always inlined. */
-#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__always_inline__)
+#if __GNUC_PREREQ (3,2) || __glibc_has_attribute (__always_inline__)
/* The Linux kernel defines __always_inline in stddef.h (283d7573), and
it conflicts with this definition. Therefore undefine it first to
allow either header to be included first. */
@@ -356,7 +361,7 @@
/* Associate error messages with the source location of the call site rather
than with the source location inside the function. */
-#if __GNUC_PREREQ (4,3) || __glibc_clang_has_attribute (__artificial__)
+#if __GNUC_PREREQ (4,3) || __glibc_has_attribute (__artificial__)
# define __attribute_artificial__ __attribute__ ((__artificial__))
#else
# define __attribute_artificial__ /* Ignore */
@@ -433,7 +438,7 @@
# endif
#endif
-#if (__GNUC__ >= 3) || __glibc_clang_has_builtin (__builtin_expect)
+#if (__GNUC__ >= 3) || __glibc_has_builtin (__builtin_expect)
# define __glibc_unlikely(cond) __builtin_expect ((cond), 0)
# define __glibc_likely(cond) __builtin_expect ((cond), 1)
#else
@@ -441,12 +446,6 @@
# define __glibc_likely(cond) (cond)
#endif
-#ifdef __has_attribute
-# define __glibc_has_attribute(attr) __has_attribute (attr)
-#else
-# define __glibc_has_attribute(attr) 0
-#endif
-
#if (!defined _Noreturn \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
&& !(__GNUC_PREREQ (4,7) \
@@ -467,6 +466,16 @@
# define __attribute_nonstring__
#endif
+/* Undefine (also defined in libc-symbols.h). */
+#undef __attribute_copy__
+#if __GNUC_PREREQ (9, 0)
+/* Copies attributes from the declaration or type referenced by
+ the argument. */
+# define __attribute_copy__(arg) __attribute__ ((__copy__ (arg)))
+#else
+# define __attribute_copy__(arg)
+#endif
+
#if (!defined _Static_assert && !defined __cplusplus \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
&& (!(__GNUC_PREREQ (4, 6) || __clang_major__ >= 4) \
@@ -483,7 +492,37 @@
# include <bits/long-double.h>
#endif
-#if defined __LONG_DOUBLE_MATH_OPTIONAL && defined __NO_LONG_DOUBLE_MATH
+#if __LDOUBLE_REDIRECTS_TO_FLOAT128_ABI == 1
+# ifdef __REDIRECT
+
+/* Alias name defined automatically. */
+# define __LDBL_REDIR(name, proto) ... unused__ldbl_redir
+# define __LDBL_REDIR_DECL(name) \
+ extern __typeof (name) name __asm (__ASMNAME ("__" #name "ieee128"));
+
+/* Alias name defined automatically, with leading underscores. */
+# define __LDBL_REDIR2_DECL(name) \
+ extern __typeof (__##name) __##name \
+ __asm (__ASMNAME ("__" #name "ieee128"));
+
+/* Alias name defined manually. */
+# define __LDBL_REDIR1(name, proto, alias) ... unused__ldbl_redir1
+# define __LDBL_REDIR1_DECL(name, alias) \
+ extern __typeof (name) name __asm (__ASMNAME (#alias));
+
+# define __LDBL_REDIR1_NTH(name, proto, alias) \
+ __REDIRECT_NTH (name, proto, alias)
+# define __REDIRECT_NTH_LDBL(name, proto, alias) \
+ __LDBL_REDIR1_NTH (name, proto, __##alias##ieee128)
+
+/* Unused. */
+# define __REDIRECT_LDBL(name, proto, alias) ... unused__redirect_ldbl
+# define __LDBL_REDIR_NTH(name, proto) ... unused__ldbl_redir_nth
+
+# else
+_Static_assert (0, "IEEE 128-bits long double requires redirection on this
platform");
+# endif
+#elif defined __LONG_DOUBLE_MATH_OPTIONAL && defined __NO_LONG_DOUBLE_MATH
# define __LDBL_COMPAT 1
# ifdef __REDIRECT
# define __LDBL_REDIR1(name, proto, alias) __REDIRECT (name, proto, alias)
@@ -492,6 +531,8 @@
# define __LDBL_REDIR1_NTH(name, proto, alias) __REDIRECT_NTH (name, proto,
alias)
# define __LDBL_REDIR_NTH(name, proto) \
__LDBL_REDIR1_NTH (name, proto, __nldbl_##name)
+# define __LDBL_REDIR2_DECL(name) \
+ extern __typeof (__##name) __##name __asm (__ASMNAME ("__nldbl___" #name));
# define __LDBL_REDIR1_DECL(name, alias) \
extern __typeof (name) name __asm (__ASMNAME (#alias));
# define __LDBL_REDIR_DECL(name) \
@@ -502,11 +543,13 @@
__LDBL_REDIR1_NTH (name, proto, __nldbl_##alias)
# endif
#endif
-#if !defined __LDBL_COMPAT || !defined __REDIRECT
+#if (!defined __LDBL_COMPAT && __LDOUBLE_REDIRECTS_TO_FLOAT128_ABI == 0) \
+ || !defined __REDIRECT
# define __LDBL_REDIR1(name, proto, alias) name proto
# define __LDBL_REDIR(name, proto) name proto
# define __LDBL_REDIR1_NTH(name, proto, alias) name proto __THROW
# define __LDBL_REDIR_NTH(name, proto) name proto __THROW
+# define __LDBL_REDIR2_DECL(name)
# define __LDBL_REDIR_DECL(name)
# ifdef __REDIRECT
# define __REDIRECT_LDBL(name, proto, alias) __REDIRECT (name, proto, alias)
@@ -537,7 +580,7 @@
check is required to enable the use of generic selection. */
#if !defined __cplusplus \
&& (__GNUC_PREREQ (4, 9) \
- || __glibc_clang_has_extension (c_generic_selections) \
+ || __glibc_has_extension (c_generic_selections) \
|| (!defined __GNUC__ && defined __STDC_VERSION__ \
&& __STDC_VERSION__ >= 201112L))
# define __HAVE_GENERIC_SELECTION 1
@@ -545,4 +588,23 @@
# define __HAVE_GENERIC_SELECTION 0
#endif
+#if __GNUC_PREREQ (10, 0)
+/* Designates a 1-based positional argument ref-index of pointer type
+ that can be used to access size-index elements of the pointed-to
+ array according to access mode, or at least one element when
+ size-index is not provided:
+ access (access-mode, <ref-index> [, <size-index>]) */
+#define __attr_access(x) __attribute__ ((__access__ x))
+#else
+# define __attr_access(x)
+#endif
+
+/* Specify that a function such as setjmp or vfork may return
+ twice. */
+#if __GNUC_PREREQ (4, 1)
+# define __attribute_returns_twice__ __attribute__ ((__returns_twice__))
+#else
+# define __attribute_returns_twice__ /* Ignore. */
+#endif
+
#endif /* sys/cdefs.h */
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index 2e2c511..4666972 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -154,7 +154,8 @@ _GL_WARN_ON_USE (closedir, "closedir is not portable - "
/* Return the file descriptor associated with the given directory stream,
or -1 if none exists. */
# if @REPLACE_DIRFD@
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+/* On kLIBC, dirfd() is a macro that does not work. Undefine it. */
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE) || defined dirfd
# undef dirfd
# define dirfd rpl_dirfd
# endif
diff --git a/lib/scratch_buffer.h b/lib/dynarray.h
similarity index 56%
copy from lib/scratch_buffer.h
copy to lib/dynarray.h
index 3e2b5ef..6da3e87 100644
--- a/lib/scratch_buffer.h
+++ b/lib/dynarray.h
@@ -1,5 +1,5 @@
-/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2017-2021 Free Software Foundation, Inc.
+/* Type-safe arrays which grow dynamically.
+ Copyright 2021 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -14,16 +14,18 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
-/* Written by Paul Eggert, 2017. */
+/* Written by Paul Eggert, 2021. */
-#ifndef _GL_SCRATCH_BUFFER_H
-#define _GL_SCRATCH_BUFFER_H
+#ifndef _GL_DYNARRAY_H
+#define _GL_DYNARRAY_H
#include <libc-config.h>
-#define __libc_scratch_buffer_grow gl_scratch_buffer_grow
-#define __libc_scratch_buffer_grow_preserve gl_scratch_buffer_grow_preserve
-#define __libc_scratch_buffer_set_array_size gl_scratch_buffer_set_array_size
-#include <malloc/scratch_buffer.h>
+#define __libc_dynarray_at_failure gl_dynarray_at_failure
+#define __libc_dynarray_emplace_enlarge gl_dynarray_emplace_enlarge
+#define __libc_dynarray_finalize gl_dynarray_finalize
+#define __libc_dynarray_resize_clear gl_dynarray_resize_clear
+#define __libc_dynarray_resize gl_dynarray_resize
+#include <malloc/dynarray.h>
-#endif /* _GL_SCRATCH_BUFFER_H */
+#endif /* _GL_DYNARRAY_H */
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
index feea444..f50ed08 100644
--- a/lib/explicit_bzero.c
+++ b/lib/explicit_bzero.c
@@ -54,11 +54,21 @@ explicit_bzero (void *s, size_t len)
explicit_memset (s, '\0', len);
#elif HAVE_MEMSET_S
(void) memset_s (s, len, '\0', len);
-#else
+#elif defined __GNUC__ && !defined __clang__
memset (s, '\0', len);
-# if defined __GNUC__ && !defined __clang__
/* Compiler barrier. */
asm volatile ("" ::: "memory");
-# endif
+#elif defined __clang__
+ memset (s, '\0', len);
+ /* Compiler barrier. */
+ /* With asm ("" ::: "memory") LLVM analyzes uses of 's' and finds that the
+ whole thing is dead and eliminates it. Use 'g' to work around this
+ problem. See <https://bugs.llvm.org/show_bug.cgi?id=15495#c11>. */
+ __asm__ volatile ("" : : "g"(s) : "memory");
+#else
+ /* Invoke memset through a volatile function pointer. This defeats compiler
+ optimizations. */
+ void * (* const volatile volatile_memset) (void *, int, size_t) = memset;
+ (void) volatile_memset (s, '\0', len);
#endif
}
diff --git a/lib/fchmodat.c b/lib/fchmodat.c
index d27c0d7..eb6e224 100644
--- a/lib/fchmodat.c
+++ b/lib/fchmodat.c
@@ -38,6 +38,7 @@ orig_fchmodat (int dir, char const *file, mode_t mode, int
flags)
#include <fcntl.h>
#include <stdio.h>
#include <stdlib.h>
+#include <string.h>
#include <unistd.h>
#ifdef __osf__
@@ -63,6 +64,22 @@ orig_fchmodat (int dir, char const *file, mode_t mode, int
flags)
int
fchmodat (int dir, char const *file, mode_t mode, int flags)
{
+# if HAVE_NEARLY_WORKING_FCHMODAT
+ /* Correct the trailing slash handling. */
+ size_t len = strlen (file);
+ if (len && file[len - 1] == '/')
+ {
+ struct stat st;
+ if (fstatat (dir, file, &st, flags & AT_SYMLINK_NOFOLLOW) < 0)
+ return -1;
+ if (!S_ISDIR (st.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+# endif
+
# if NEED_FCHMODAT_NONSYMLINK_FIX
if (flags == AT_SYMLINK_NOFOLLOW)
{
diff --git a/lib/free.c b/lib/free.c
index 135c3eb..5c89787 100644
--- a/lib/free.c
+++ b/lib/free.c
@@ -27,7 +27,21 @@ void
rpl_free (void *p)
#undef free
{
+#if defined __GNUC__ && !defined __clang__
+ /* An invalid GCC optimization
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98396>
+ would optimize away the assignments in the code below, when link-time
+ optimization (LTO) is enabled. Make the code more complicated, so that
+ GCC does not grok how to optimize it. */
+ int err[2];
+ err[0] = errno;
+ err[1] = errno;
+ errno = 0;
+ free (p);
+ errno = err[errno == 0];
+#else
int err = errno;
free (p);
errno = err;
+#endif
}
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index c457ac6..07736f9 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -516,6 +516,7 @@ GNULIB_SYMLINK = @GNULIB_SYMLINK@
GNULIB_SYMLINKAT = @GNULIB_SYMLINKAT@
GNULIB_SYSTEM_POSIX = @GNULIB_SYSTEM_POSIX@
GNULIB_TIMEGM = @GNULIB_TIMEGM@
+GNULIB_TIMESPEC_GET = @GNULIB_TIMESPEC_GET@
GNULIB_TIME_R = @GNULIB_TIME_R@
GNULIB_TIME_RZ = @GNULIB_TIME_RZ@
GNULIB_TMPFILE = @GNULIB_TMPFILE@
@@ -746,6 +747,7 @@ HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@
HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@
HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@
HAVE_TIMEGM = @HAVE_TIMEGM@
+HAVE_TIMESPEC_GET = @HAVE_TIMESPEC_GET@
HAVE_TIMEZONE_T = @HAVE_TIMEZONE_T@
HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@
HAVE_UNISTD_H = @HAVE_UNISTD_H@
@@ -949,6 +951,7 @@ REPLACE_FCNTL = @REPLACE_FCNTL@
REPLACE_FDOPEN = @REPLACE_FDOPEN@
REPLACE_FDOPENDIR = @REPLACE_FDOPENDIR@
REPLACE_FFLUSH = @REPLACE_FFLUSH@
+REPLACE_FFSLL = @REPLACE_FFSLL@
REPLACE_FOPEN = @REPLACE_FOPEN@
REPLACE_FPRINTF = @REPLACE_FPRINTF@
REPLACE_FPURGE = @REPLACE_FPURGE@
@@ -989,7 +992,9 @@ REPLACE_MEMCHR = @REPLACE_MEMCHR@
REPLACE_MEMMEM = @REPLACE_MEMMEM@
REPLACE_MKDIR = @REPLACE_MKDIR@
REPLACE_MKFIFO = @REPLACE_MKFIFO@
+REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@
REPLACE_MKNOD = @REPLACE_MKNOD@
+REPLACE_MKNODAT = @REPLACE_MKNODAT@
REPLACE_MKSTEMP = @REPLACE_MKSTEMP@
REPLACE_MKTIME = @REPLACE_MKTIME@
REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@
@@ -1087,6 +1092,7 @@ SYSTEM_TYPE = @SYSTEM_TYPE@
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@
TERMCAP_OBJ = @TERMCAP_OBJ@
TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@
+TIME_H_DEFINES_TIME_UTC = @TIME_H_DEFINES_TIME_UTC@
TOOLKIT_LIBW = @TOOLKIT_LIBW@
UINT32_MAX_LT_UINTMAX_MAX = @UINT32_MAX_LT_UINTMAX_MAX@
UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@
@@ -1171,6 +1177,7 @@ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 =
@gl_GNULIB_ENABLED_a9786850
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 =
@gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36@
gl_GNULIB_ENABLED_cloexec = @gl_GNULIB_ENABLED_cloexec@
gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@
+gl_GNULIB_ENABLED_dynarray = @gl_GNULIB_ENABLED_dynarray@
gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@
gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@
gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@
@@ -1584,6 +1591,20 @@ EXTRA_libgnu_a_SOURCES += dup2.c
endif
## end gnulib module dup2
+## begin gnulib module dynarray
+ifeq (,$(OMIT_GNULIB_MODULE_dynarray))
+
+ifneq (,$(gl_GNULIB_ENABLED_dynarray))
+libgnu_a_SOURCES += malloc/dynarray_at_failure.c
malloc/dynarray_emplace_enlarge.c malloc/dynarray_finalize.c
malloc/dynarray_resize.c
malloc/dynarray_resize_clear.c
+
+endif
+EXTRA_DIST += dynarray.h malloc/dynarray-skeleton.c malloc/dynarray.h
+
+EXTRA_libgnu_a_SOURCES += malloc/dynarray-skeleton.c
+
+endif
+## end gnulib module dynarray
+
## begin gnulib module eloop-threshold
ifeq (,$(OMIT_GNULIB_MODULE_eloop-threshold))
@@ -3036,6 +3057,7 @@ string.h: string.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_SIGDESCR_NP''@|$(HAVE_SIGDESCR_NP)|g' \
-e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \
-e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \
+ -e 's|@''REPLACE_FFSLL''@|$(REPLACE_FFSLL)|g' \
-e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \
-e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \
-e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \
@@ -3237,7 +3259,9 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNU
-e 's|@''REPLACE_LSTAT''@|$(REPLACE_LSTAT)|g' \
-e 's|@''REPLACE_MKDIR''@|$(REPLACE_MKDIR)|g' \
-e 's|@''REPLACE_MKFIFO''@|$(REPLACE_MKFIFO)|g' \
+ -e 's|@''REPLACE_MKFIFOAT''@|$(REPLACE_MKFIFOAT)|g' \
-e 's|@''REPLACE_MKNOD''@|$(REPLACE_MKNOD)|g' \
+ -e 's|@''REPLACE_MKNODAT''@|$(REPLACE_MKNODAT)|g' \
-e 's|@''REPLACE_STAT''@|$(REPLACE_STAT)|g' \
-e 's|@''REPLACE_UTIMENSAT''@|$(REPLACE_UTIMENSAT)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
@@ -3350,6 +3374,7 @@ time.h: time.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's/@''GNULIB_STRFTIME''@/$(GNULIB_STRFTIME)/g' \
-e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \
-e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \
+ -e 's/@''GNULIB_TIMESPEC_GET''@/$(GNULIB_TIMESPEC_GET)/g' \
-e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \
-e 's/@''GNULIB_TIME_RZ''@/$(GNULIB_TIME_RZ)/g' \
-e 's/@''GNULIB_TZSET''@/$(GNULIB_TZSET)/g' \
@@ -3358,6 +3383,7 @@ time.h: time.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
-e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \
+ -e 's|@''HAVE_TIMESPEC_GET''@|$(HAVE_TIMESPEC_GET)|g' \
-e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \
-e 's|@''REPLACE_CTIME''@|$(REPLACE_CTIME)|g' \
-e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \
@@ -3372,6 +3398,7 @@ time.h: time.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e
's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g'
\
-e
's|@''TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \
-e
's|@''UNISTD_H_DEFINES_STRUCT_TIMESPEC''@|$(UNISTD_H_DEFINES_STRUCT_TIMESPEC)|g'
\
+ -e 's|@''TIME_H_DEFINES_TIME_UTC''@|$(TIME_H_DEFINES_TIME_UTC)|g'
\
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
-e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
diff --git a/lib/libc-config.h b/lib/libc-config.h
index d4e2995..c0eac70 100644
--- a/lib/libc-config.h
+++ b/lib/libc-config.h
@@ -71,107 +71,112 @@
# endif
#endif
-
-/* Prepare to include <cdefs.h>, which is our copy of glibc
- <sys/cdefs.h>. */
+#ifndef __attribute_maybe_unused__
+/* <sys/cdefs.h> either does not exist, or is too old for Gnulib.
+ Prepare to include <cdefs.h>, which is Gnulib's version of a
+ more-recent glibc <sys/cdefs.h>. */
/* Define _FEATURES_H so that <cdefs.h> does not include <features.h>. */
-#ifndef _FEATURES_H
-# define _FEATURES_H 1
-#endif
+# ifndef _FEATURES_H
+# define _FEATURES_H 1
+# endif
/* Define __WORDSIZE so that <cdefs.h> does not attempt to include
nonexistent files. Make it a syntax error, since Gnulib does not
use __WORDSIZE now, and if Gnulib uses it later the syntax error
will let us know that __WORDSIZE needs configuring. */
-#ifndef __WORDSIZE
-# define __WORDSIZE %%%
-#endif
+# ifndef __WORDSIZE
+# define __WORDSIZE %%%
+# endif
/* Undef the macros unconditionally defined by our copy of glibc
<sys/cdefs.h>, so that they do not clash with any system-defined
versions. */
-#undef _SYS_CDEFS_H
-#undef __ASMNAME
-#undef __ASMNAME2
-#undef __BEGIN_DECLS
-#undef __CONCAT
-#undef __END_DECLS
-#undef __HAVE_GENERIC_SELECTION
-#undef __LDBL_COMPAT
-#undef __LDBL_REDIR
-#undef __LDBL_REDIR1
-#undef __LDBL_REDIR1_DECL
-#undef __LDBL_REDIR1_NTH
-#undef __LDBL_REDIR_DECL
-#undef __LDBL_REDIR_NTH
-#undef __LEAF
-#undef __LEAF_ATTR
-#undef __NTH
-#undef __NTHNL
-#undef __P
-#undef __PMT
-#undef __REDIRECT
-#undef __REDIRECT_LDBL
-#undef __REDIRECT_NTH
-#undef __REDIRECT_NTHNL
-#undef __REDIRECT_NTH_LDBL
-#undef __STRING
-#undef __THROW
-#undef __THROWNL
-#undef __always_inline
-#undef __attribute__
-#undef __attribute_alloc_size__
-#undef __attribute_artificial__
-#undef __attribute_const__
-#undef __attribute_deprecated__
-#undef __attribute_deprecated_msg__
-#undef __attribute_format_arg__
-#undef __attribute_format_strfmon__
-#undef __attribute_malloc__
-#undef __attribute_noinline__
-#undef __attribute_nonstring__
-#undef __attribute_pure__
-#undef __attribute_used__
-#undef __attribute_warn_unused_result__
-#undef __bos
-#undef __bos0
-#undef __errordecl
-#undef __extension__
-#undef __extern_always_inline
-#undef __extern_inline
-#undef __flexarr
-#undef __fortify_function
-#undef __glibc_c99_flexarr_available
-#undef __glibc_clang_has_extension
-#undef __glibc_likely
-#undef __glibc_macro_warning
-#undef __glibc_macro_warning1
-#undef __glibc_unlikely
-#undef __inline
-#undef __ptr_t
-#undef __restrict
-#undef __restrict_arr
-#undef __va_arg_pack
-#undef __va_arg_pack_len
-#undef __warnattr
-#undef __warndecl
+# undef _SYS_CDEFS_H
+# undef __ASMNAME
+# undef __ASMNAME2
+# undef __BEGIN_DECLS
+# undef __CONCAT
+# undef __END_DECLS
+# undef __HAVE_GENERIC_SELECTION
+# undef __LDBL_COMPAT
+# undef __LDBL_REDIR
+# undef __LDBL_REDIR1
+# undef __LDBL_REDIR1_DECL
+# undef __LDBL_REDIR1_NTH
+# undef __LDBL_REDIR2_DECL
+# undef __LDBL_REDIR_DECL
+# undef __LDBL_REDIR_NTH
+# undef __LEAF
+# undef __LEAF_ATTR
+# undef __NTH
+# undef __NTHNL
+# undef __REDIRECT
+# undef __REDIRECT_LDBL
+# undef __REDIRECT_NTH
+# undef __REDIRECT_NTHNL
+# undef __REDIRECT_NTH_LDBL
+# undef __STRING
+# undef __THROW
+# undef __THROWNL
+# undef __attr_access
+# undef __attribute__
+# undef __attribute_alloc_size__
+# undef __attribute_artificial__
+# undef __attribute_const__
+# undef __attribute_deprecated__
+# undef __attribute_deprecated_msg__
+# undef __attribute_format_arg__
+# undef __attribute_format_strfmon__
+# undef __attribute_malloc__
+# undef __attribute_noinline__
+# undef __attribute_nonstring__
+# undef __attribute_pure__
+# undef __attribute_returns_twice__
+# undef __attribute_used__
+# undef __attribute_warn_unused_result__
+# undef __bos
+# undef __bos0
+# undef __errordecl
+# undef __extension__
+# undef __extern_always_inline
+# undef __extern_inline
+# undef __flexarr
+# undef __fortify_function
+# undef __glibc_c99_flexarr_available
+# undef __glibc_has_attribute
+# undef __glibc_has_builtin
+# undef __glibc_has_extension
+# undef __glibc_macro_warning
+# undef __glibc_macro_warning1
+# undef __glibc_objsize
+# undef __glibc_objsize0
+# undef __glibc_unlikely
+# undef __inline
+# undef __ptr_t
+# undef __restrict
+# undef __restrict_arr
+# undef __va_arg_pack
+# undef __va_arg_pack_len
+# undef __warnattr
/* Include our copy of glibc <sys/cdefs.h>. */
-#include <cdefs.h>
+# include <cdefs.h>
/* <cdefs.h> __inline is too pessimistic for non-GCC. */
-#undef __inline
-#ifndef HAVE___INLINE
-# if 199901 <= __STDC_VERSION__ || defined inline
-# define __inline inline
-# else
-# define __inline
+# undef __inline
+# ifndef HAVE___INLINE
+# if 199901 <= __STDC_VERSION__ || defined inline
+# define __inline inline
+# else
+# define __inline
+# endif
# endif
-#endif
+
+#endif /* defined __glibc_likely */
/* A substitute for glibc <libc-symbols.h>, good enough for Gnulib. */
#define attribute_hidden
-#define libc_hidden_proto(name, ...)
+#define libc_hidden_proto(name)
#define libc_hidden_def(name)
#define libc_hidden_weak(name)
#define libc_hidden_ver(local, name)
diff --git a/lib/malloc/dynarray-skeleton.c b/lib/malloc/dynarray-skeleton.c
new file mode 100644
index 0000000..4995fd1
--- /dev/null
+++ b/lib/malloc/dynarray-skeleton.c
@@ -0,0 +1,525 @@
+/* Type-safe arrays which grow dynamically.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+/* Pre-processor macros which act as parameters:
+
+ DYNARRAY_STRUCT
+ The struct tag of dynamic array to be defined.
+ DYNARRAY_ELEMENT
+ The type name of the element type. Elements are copied
+ as if by memcpy, and can change address as the dynamic
+ array grows.
+ DYNARRAY_PREFIX
+ The prefix of the functions which are defined.
+
+ The following parameters are optional:
+
+ DYNARRAY_ELEMENT_FREE
+ DYNARRAY_ELEMENT_FREE (E) is evaluated to deallocate the
+ contents of elements. E is of type DYNARRAY_ELEMENT *.
+ DYNARRAY_ELEMENT_INIT
+ DYNARRAY_ELEMENT_INIT (E) is evaluated to initialize a new
+ element. E is of type DYNARRAY_ELEMENT *.
+ If DYNARRAY_ELEMENT_FREE but not DYNARRAY_ELEMENT_INIT is
+ defined, new elements are automatically zero-initialized.
+ Otherwise, new elements have undefined contents.
+ DYNARRAY_INITIAL_SIZE
+ The size of the statically allocated array (default:
+ at least 2, more elements if they fit into 128 bytes).
+ Must be a preprocessor constant. If DYNARRAY_INITIAL_SIZE is 0,
+ there is no statically allocated array at, and all non-empty
+ arrays are heap-allocated.
+ DYNARRAY_FINAL_TYPE
+ The name of the type which holds the final array. If not
+ defined, is PREFIX##finalize not provided. DYNARRAY_FINAL_TYPE
+ must be a struct type, with members of type DYNARRAY_ELEMENT and
+ size_t at the start (in this order).
+
+ These macros are undefined after this header file has been
+ included.
+
+ The following types are provided (their members are private to the
+ dynarray implementation):
+
+ struct DYNARRAY_STRUCT
+
+ The following functions are provided:
+
+ void DYNARRAY_PREFIX##init (struct DYNARRAY_STRUCT *);
+ void DYNARRAY_PREFIX##free (struct DYNARRAY_STRUCT *);
+ bool DYNARRAY_PREFIX##has_failed (const struct DYNARRAY_STRUCT *);
+ void DYNARRAY_PREFIX##mark_failed (struct DYNARRAY_STRUCT *);
+ size_t DYNARRAY_PREFIX##size (const struct DYNARRAY_STRUCT *);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##begin (const struct DYNARRAY_STRUCT *);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##end (const struct DYNARRAY_STRUCT *);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##at (struct DYNARRAY_STRUCT *, size_t);
+ void DYNARRAY_PREFIX##add (struct DYNARRAY_STRUCT *, DYNARRAY_ELEMENT);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##emplace (struct DYNARRAY_STRUCT *);
+ bool DYNARRAY_PREFIX##resize (struct DYNARRAY_STRUCT *, size_t);
+ void DYNARRAY_PREFIX##remove_last (struct DYNARRAY_STRUCT *);
+ void DYNARRAY_PREFIX##clear (struct DYNARRAY_STRUCT *);
+
+ The following functions are provided are provided if the
+ prerequisites are met:
+
+ bool DYNARRAY_PREFIX##finalize (struct DYNARRAY_STRUCT *,
+ DYNARRAY_FINAL_TYPE *);
+ (if DYNARRAY_FINAL_TYPE is defined)
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##finalize (struct DYNARRAY_STRUCT *,
+ size_t *);
+ (if DYNARRAY_FINAL_TYPE is not defined)
+*/
+
+#include <malloc/dynarray.h>
+
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifndef DYNARRAY_STRUCT
+# error "DYNARRAY_STRUCT must be defined"
+#endif
+
+#ifndef DYNARRAY_ELEMENT
+# error "DYNARRAY_ELEMENT must be defined"
+#endif
+
+#ifndef DYNARRAY_PREFIX
+# error "DYNARRAY_PREFIX must be defined"
+#endif
+
+#ifdef DYNARRAY_INITIAL_SIZE
+# if DYNARRAY_INITIAL_SIZE < 0
+# error "DYNARRAY_INITIAL_SIZE must be non-negative"
+# endif
+# if DYNARRAY_INITIAL_SIZE > 0
+# define DYNARRAY_HAVE_SCRATCH 1
+# else
+# define DYNARRAY_HAVE_SCRATCH 0
+# endif
+#else
+/* Provide a reasonable default which limits the size of
+ DYNARRAY_STRUCT. */
+# define DYNARRAY_INITIAL_SIZE \
+ (sizeof (DYNARRAY_ELEMENT) > 64 ? 2 : 128 / sizeof (DYNARRAY_ELEMENT))
+# define DYNARRAY_HAVE_SCRATCH 1
+#endif
+
+/* Public type definitions. */
+
+/* All fields of this struct are private to the implementation. */
+struct DYNARRAY_STRUCT
+{
+ union
+ {
+ struct dynarray_header dynarray_abstract;
+ struct
+ {
+ /* These fields must match struct dynarray_header. */
+ size_t used;
+ size_t allocated;
+ DYNARRAY_ELEMENT *array;
+ } dynarray_header;
+ } u;
+
+#if DYNARRAY_HAVE_SCRATCH
+ /* Initial inline allocation. */
+ DYNARRAY_ELEMENT scratch[DYNARRAY_INITIAL_SIZE];
+#endif
+};
+
+/* Internal use only: Helper macros. */
+
+/* Ensure macro-expansion of DYNARRAY_PREFIX. */
+#define DYNARRAY_CONCAT0(prefix, name) prefix##name
+#define DYNARRAY_CONCAT1(prefix, name) DYNARRAY_CONCAT0(prefix, name)
+#define DYNARRAY_NAME(name) DYNARRAY_CONCAT1(DYNARRAY_PREFIX, name)
+
+/* Use DYNARRAY_FREE instead of DYNARRAY_NAME (free),
+ so that Gnulib does not change 'free' to 'rpl_free'. */
+#define DYNARRAY_FREE DYNARRAY_CONCAT1 (DYNARRAY_NAME (f), ree)
+
+/* Address of the scratch buffer if any. */
+#if DYNARRAY_HAVE_SCRATCH
+# define DYNARRAY_SCRATCH(list) (list)->scratch
+#else
+# define DYNARRAY_SCRATCH(list) NULL
+#endif
+
+/* Internal use only: Helper functions. */
+
+/* Internal function. Call DYNARRAY_ELEMENT_FREE with the array
+ elements. Name mangling needed due to the DYNARRAY_ELEMENT_FREE
+ macro expansion. */
+static inline void
+DYNARRAY_NAME (free__elements__) (DYNARRAY_ELEMENT *__dynarray_array,
+ size_t __dynarray_used)
+{
+#ifdef DYNARRAY_ELEMENT_FREE
+ for (size_t __dynarray_i = 0; __dynarray_i < __dynarray_used; ++__dynarray_i)
+ DYNARRAY_ELEMENT_FREE (&__dynarray_array[__dynarray_i]);
+#endif /* DYNARRAY_ELEMENT_FREE */
+}
+
+/* Internal function. Free the non-scratch array allocation. */
+static inline void
+DYNARRAY_NAME (free__array__) (struct DYNARRAY_STRUCT *list)
+{
+#if DYNARRAY_HAVE_SCRATCH
+ if (list->u.dynarray_header.array != list->scratch)
+ free (list->u.dynarray_header.array);
+#else
+ free (list->u.dynarray_header.array);
+#endif
+}
+
+/* Public functions. */
+
+/* Initialize a dynamic array object. This must be called before any
+ use of the object. */
+__nonnull ((1))
+static void
+DYNARRAY_NAME (init) (struct DYNARRAY_STRUCT *list)
+{
+ list->u.dynarray_header.used = 0;
+ list->u.dynarray_header.allocated = DYNARRAY_INITIAL_SIZE;
+ list->u.dynarray_header.array = DYNARRAY_SCRATCH (list);
+}
+
+/* Deallocate the dynamic array and its elements. */
+__attribute_maybe_unused__ __nonnull ((1))
+static void
+DYNARRAY_FREE (struct DYNARRAY_STRUCT *list)
+{
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array, list->u.dynarray_header.used);
+ DYNARRAY_NAME (free__array__) (list);
+ DYNARRAY_NAME (init) (list);
+}
+
+/* Return true if the dynamic array is in an error state. */
+__nonnull ((1))
+static inline bool
+DYNARRAY_NAME (has_failed) (const struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.allocated == __dynarray_error_marker ();
+}
+
+/* Mark the dynamic array as failed. All elements are deallocated as
+ a side effect. */
+__nonnull ((1))
+static void
+DYNARRAY_NAME (mark_failed) (struct DYNARRAY_STRUCT *list)
+{
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array, list->u.dynarray_header.used);
+ DYNARRAY_NAME (free__array__) (list);
+ list->u.dynarray_header.array = DYNARRAY_SCRATCH (list);
+ list->u.dynarray_header.used = 0;
+ list->u.dynarray_header.allocated = __dynarray_error_marker ();
+}
+
+/* Return the number of elements which have been added to the dynamic
+ array. */
+__nonnull ((1))
+static inline size_t
+DYNARRAY_NAME (size) (const struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.used;
+}
+
+/* Return a pointer to the array element at INDEX. Terminate the
+ process if INDEX is out of bounds. */
+__nonnull ((1))
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (at) (struct DYNARRAY_STRUCT *list, size_t index)
+{
+ if (__glibc_unlikely (index >= DYNARRAY_NAME (size) (list)))
+ __libc_dynarray_at_failure (DYNARRAY_NAME (size) (list), index);
+ return list->u.dynarray_header.array + index;
+}
+
+/* Return a pointer to the first array element, if any. For a
+ zero-length array, the pointer can be NULL even though the dynamic
+ array has not entered the failure state. */
+__nonnull ((1))
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (begin) (struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.array;
+}
+
+/* Return a pointer one element past the last array element. For a
+ zero-length array, the pointer can be NULL even though the dynamic
+ array has not entered the failure state. */
+__nonnull ((1))
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (end) (struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.array + list->u.dynarray_header.used;
+}
+
+/* Internal function. Slow path for the add function below. */
+static void
+DYNARRAY_NAME (add__) (struct DYNARRAY_STRUCT *list, DYNARRAY_ELEMENT item)
+{
+ if (__glibc_unlikely
+ (!__libc_dynarray_emplace_enlarge (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT))))
+ {
+ DYNARRAY_NAME (mark_failed) (list);
+ return;
+ }
+
+ /* Copy the new element and increase the array length. */
+ list->u.dynarray_header.array[list->u.dynarray_header.used++] = item;
+}
+
+/* Add ITEM at the end of the array, enlarging it by one element.
+ Mark *LIST as failed if the dynamic array allocation size cannot be
+ increased. */
+__nonnull ((1))
+static inline void
+DYNARRAY_NAME (add) (struct DYNARRAY_STRUCT *list, DYNARRAY_ELEMENT item)
+{
+ /* Do nothing in case of previous error. */
+ if (DYNARRAY_NAME (has_failed) (list))
+ return;
+
+ /* Enlarge the array if necessary. */
+ if (__glibc_unlikely (list->u.dynarray_header.used
+ == list->u.dynarray_header.allocated))
+ {
+ DYNARRAY_NAME (add__) (list, item);
+ return;
+ }
+
+ /* Copy the new element and increase the array length. */
+ list->u.dynarray_header.array[list->u.dynarray_header.used++] = item;
+}
+
+/* Internal function. Building block for the emplace functions below.
+ Assumes space for one more element in *LIST. */
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (emplace__tail__) (struct DYNARRAY_STRUCT *list)
+{
+ DYNARRAY_ELEMENT *result
+ = &list->u.dynarray_header.array[list->u.dynarray_header.used];
+ ++list->u.dynarray_header.used;
+#if defined (DYNARRAY_ELEMENT_INIT)
+ DYNARRAY_ELEMENT_INIT (result);
+#elif defined (DYNARRAY_ELEMENT_FREE)
+ memset (result, 0, sizeof (*result));
+#endif
+ return result;
+}
+
+/* Internal function. Slow path for the emplace function below. */
+static DYNARRAY_ELEMENT *
+DYNARRAY_NAME (emplace__) (struct DYNARRAY_STRUCT *list)
+{
+ if (__glibc_unlikely
+ (!__libc_dynarray_emplace_enlarge (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT))))
+ {
+ DYNARRAY_NAME (mark_failed) (list);
+ return NULL;
+ }
+ return DYNARRAY_NAME (emplace__tail__) (list);
+}
+
+/* Allocate a place for a new element in *LIST and return a pointer to
+ it. The pointer can be NULL if the dynamic array cannot be
+ enlarged due to a memory allocation failure. */
+__attribute_maybe_unused__ __attribute_warn_unused_result__ __nonnull ((1))
+static
+/* Avoid inlining with the larger initialization code. */
+#if !(defined (DYNARRAY_ELEMENT_INIT) || defined (DYNARRAY_ELEMENT_FREE))
+inline
+#endif
+DYNARRAY_ELEMENT *
+DYNARRAY_NAME (emplace) (struct DYNARRAY_STRUCT *list)
+{
+ /* Do nothing in case of previous error. */
+ if (DYNARRAY_NAME (has_failed) (list))
+ return NULL;
+
+ /* Enlarge the array if necessary. */
+ if (__glibc_unlikely (list->u.dynarray_header.used
+ == list->u.dynarray_header.allocated))
+ return (DYNARRAY_NAME (emplace__) (list));
+ return DYNARRAY_NAME (emplace__tail__) (list);
+}
+
+/* Change the size of *LIST to SIZE. If SIZE is larger than the
+ existing size, new elements are added (which can be initialized).
+ Otherwise, the list is truncated, and elements are freed. Return
+ false on memory allocation failure (and mark *LIST as failed). */
+__attribute_maybe_unused__ __nonnull ((1))
+static bool
+DYNARRAY_NAME (resize) (struct DYNARRAY_STRUCT *list, size_t size)
+{
+ if (size > list->u.dynarray_header.used)
+ {
+ bool ok;
+#if defined (DYNARRAY_ELEMENT_INIT)
+ /* The new elements have to be initialized. */
+ size_t old_size = list->u.dynarray_header.used;
+ ok = __libc_dynarray_resize (&list->u.dynarray_abstract,
+ size, DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT));
+ if (ok)
+ for (size_t i = old_size; i < size; ++i)
+ {
+ DYNARRAY_ELEMENT_INIT (&list->u.dynarray_header.array[i]);
+ }
+#elif defined (DYNARRAY_ELEMENT_FREE)
+ /* Zero initialization is needed so that the elements can be
+ safely freed. */
+ ok = __libc_dynarray_resize_clear
+ (&list->u.dynarray_abstract, size,
+ DYNARRAY_SCRATCH (list), sizeof (DYNARRAY_ELEMENT));
+#else
+ ok = __libc_dynarray_resize (&list->u.dynarray_abstract,
+ size, DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT));
+#endif
+ if (__glibc_unlikely (!ok))
+ DYNARRAY_NAME (mark_failed) (list);
+ return ok;
+ }
+ else
+ {
+ /* The list has shrunk in size. Free the removed elements. */
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array + size,
+ list->u.dynarray_header.used - size);
+ list->u.dynarray_header.used = size;
+ return true;
+ }
+}
+
+/* Remove the last element of LIST if it is present. */
+__attribute_maybe_unused__ __nonnull ((1))
+static void
+DYNARRAY_NAME (remove_last) (struct DYNARRAY_STRUCT *list)
+{
+ /* used > 0 implies that the array is the non-failed state. */
+ if (list->u.dynarray_header.used > 0)
+ {
+ size_t new_length = list->u.dynarray_header.used - 1;
+#ifdef DYNARRAY_ELEMENT_FREE
+ DYNARRAY_ELEMENT_FREE (&list->u.dynarray_header.array[new_length]);
+#endif
+ list->u.dynarray_header.used = new_length;
+ }
+}
+
+/* Remove all elements from the list. The elements are freed, but the
+ list itself is not. */
+__attribute_maybe_unused__ __nonnull ((1))
+static void
+DYNARRAY_NAME (clear) (struct DYNARRAY_STRUCT *list)
+{
+ /* free__elements__ does nothing if the list is in the failed
+ state. */
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array, list->u.dynarray_header.used);
+ list->u.dynarray_header.used = 0;
+}
+
+#ifdef DYNARRAY_FINAL_TYPE
+/* Transfer the dynamic array to a permanent location at *RESULT.
+ Returns true on success on false on allocation failure. In either
+ case, *LIST is re-initialized and can be reused. A NULL pointer is
+ stored in *RESULT if LIST refers to an empty list. On success, the
+ pointer in *RESULT is heap-allocated and must be deallocated using
+ free. */
+__attribute_maybe_unused__ __attribute_warn_unused_result__ __nonnull ((1, 2))
+static bool
+DYNARRAY_NAME (finalize) (struct DYNARRAY_STRUCT *list,
+ DYNARRAY_FINAL_TYPE *result)
+{
+ struct dynarray_finalize_result res;
+ if (__libc_dynarray_finalize (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT), &res))
+ {
+ /* On success, the result owns all the data. */
+ DYNARRAY_NAME (init) (list);
+ *result = (DYNARRAY_FINAL_TYPE) { res.array, res.length };
+ return true;
+ }
+ else
+ {
+ /* On error, we need to free all data. */
+ DYNARRAY_FREE (list);
+ errno = ENOMEM;
+ return false;
+ }
+}
+#else /* !DYNARRAY_FINAL_TYPE */
+/* Transfer the dynamic array to a heap-allocated array and return a
+ pointer to it. The pointer is NULL if memory allocation fails, or
+ if the array is empty, so this function should be used only for
+ arrays which are known not be empty (usually because they always
+ have a sentinel at the end). If LENGTHP is not NULL, the array
+ length is written to *LENGTHP. *LIST is re-initialized and can be
+ reused. */
+__attribute_maybe_unused__ __attribute_warn_unused_result__ __nonnull ((1))
+static DYNARRAY_ELEMENT *
+DYNARRAY_NAME (finalize) (struct DYNARRAY_STRUCT *list, size_t *lengthp)
+{
+ struct dynarray_finalize_result res;
+ if (__libc_dynarray_finalize (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT), &res))
+ {
+ /* On success, the result owns all the data. */
+ DYNARRAY_NAME (init) (list);
+ if (lengthp != NULL)
+ *lengthp = res.length;
+ return res.array;
+ }
+ else
+ {
+ /* On error, we need to free all data. */
+ DYNARRAY_FREE (list);
+ errno = ENOMEM;
+ return NULL;
+ }
+}
+#endif /* !DYNARRAY_FINAL_TYPE */
+
+/* Undo macro definitions. */
+
+#undef DYNARRAY_CONCAT0
+#undef DYNARRAY_CONCAT1
+#undef DYNARRAY_NAME
+#undef DYNARRAY_SCRATCH
+#undef DYNARRAY_HAVE_SCRATCH
+
+#undef DYNARRAY_STRUCT
+#undef DYNARRAY_ELEMENT
+#undef DYNARRAY_PREFIX
+#undef DYNARRAY_ELEMENT_FREE
+#undef DYNARRAY_ELEMENT_INIT
+#undef DYNARRAY_INITIAL_SIZE
+#undef DYNARRAY_FINAL_TYPE
diff --git a/lib/malloc/dynarray.h b/lib/malloc/dynarray.h
new file mode 100644
index 0000000..84e4394
--- /dev/null
+++ b/lib/malloc/dynarray.h
@@ -0,0 +1,178 @@
+/* Type-safe arrays which grow dynamically. Shared definitions.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+/* To use the dynarray facility, you need to include
+ <malloc/dynarray-skeleton.c> and define the parameter macros
+ documented in that file.
+
+ A minimal example which provides a growing list of integers can be
+ defined like this:
+
+ struct int_array
+ {
+ // Pointer to result array followed by its length,
+ // as required by DYNARRAY_FINAL_TYPE.
+ int *array;
+ size_t length;
+ };
+
+ #define DYNARRAY_STRUCT dynarray_int
+ #define DYNARRAY_ELEMENT int
+ #define DYNARRAY_PREFIX dynarray_int_
+ #define DYNARRAY_FINAL_TYPE struct int_array
+ #include <malloc/dynarray-skeleton.c>
+
+ To create a three-element array with elements 1, 2, 3, use this
+ code:
+
+ struct dynarray_int dyn;
+ dynarray_int_init (&dyn);
+ for (int i = 1; i <= 3; ++i)
+ {
+ int *place = dynarray_int_emplace (&dyn);
+ assert (place != NULL);
+ *place = i;
+ }
+ struct int_array result;
+ bool ok = dynarray_int_finalize (&dyn, &result);
+ assert (ok);
+ assert (result.length == 3);
+ assert (result.array[0] == 1);
+ assert (result.array[1] == 2);
+ assert (result.array[2] == 3);
+ free (result.array);
+
+ If the elements contain resources which must be freed, define
+ DYNARRAY_ELEMENT_FREE appropriately, like this:
+
+ struct str_array
+ {
+ char **array;
+ size_t length;
+ };
+
+ #define DYNARRAY_STRUCT dynarray_str
+ #define DYNARRAY_ELEMENT char *
+ #define DYNARRAY_ELEMENT_FREE(ptr) free (*ptr)
+ #define DYNARRAY_PREFIX dynarray_str_
+ #define DYNARRAY_FINAL_TYPE struct str_array
+ #include <malloc/dynarray-skeleton.c>
+
+ Compared to scratch buffers, dynamic arrays have the following
+ features:
+
+ - They have an element type, and are not just an untyped buffer of
+ bytes.
+
+ - When growing, previously stored elements are preserved. (It is
+ expected that scratch_buffer_grow_preserve and
+ scratch_buffer_set_array_size eventually go away because all
+ current users are moved to dynamic arrays.)
+
+ - Scratch buffers have a more aggressive growth policy because
+ growing them typically means a retry of an operation (across an
+ NSS service module boundary), which is expensive.
+
+ - For the same reason, scratch buffers have a much larger initial
+ stack allocation. */
+
+#ifndef _DYNARRAY_H
+#define _DYNARRAY_H
+
+#include <stdbool.h>
+#include <stddef.h>
+#include <string.h>
+
+struct dynarray_header
+{
+ size_t used;
+ size_t allocated;
+ void *array;
+};
+
+/* Marker used in the allocated member to indicate that an error was
+ encountered. */
+static inline size_t
+__dynarray_error_marker (void)
+{
+ return -1;
+}
+
+/* Internal function. See the has_failed function in
+ dynarray-skeleton.c. */
+static inline bool
+__dynarray_error (struct dynarray_header *list)
+{
+ return list->allocated == __dynarray_error_marker ();
+}
+
+/* Internal function. Enlarge the dynamically allocated area of the
+ array to make room for one more element. SCRATCH is a pointer to
+ the scratch area (which is not heap-allocated and must not be
+ freed). ELEMENT_SIZE is the size, in bytes, of one element.
+ Return false on failure, true on success. */
+bool __libc_dynarray_emplace_enlarge (struct dynarray_header *,
+ void *scratch, size_t element_size);
+
+/* Internal function. Enlarge the dynamically allocated area of the
+ array to make room for at least SIZE elements (which must be larger
+ than the existing used part of the dynamic array). SCRATCH is a
+ pointer to the scratch area (which is not heap-allocated and must
+ not be freed). ELEMENT_SIZE is the size, in bytes, of one element.
+ Return false on failure, true on success. */
+bool __libc_dynarray_resize (struct dynarray_header *, size_t size,
+ void *scratch, size_t element_size);
+
+/* Internal function. Like __libc_dynarray_resize, but clear the new
+ part of the dynamic array. */
+bool __libc_dynarray_resize_clear (struct dynarray_header *, size_t size,
+ void *scratch, size_t element_size);
+
+/* Internal type. */
+struct dynarray_finalize_result
+{
+ void *array;
+ size_t length;
+};
+
+/* Internal function. Copy the dynamically-allocated area to an
+ explicitly-sized heap allocation. SCRATCH is a pointer to the
+ embedded scratch space. ELEMENT_SIZE is the size, in bytes, of the
+ element type. On success, true is returned, and pointer and length
+ are written to *RESULT. On failure, false is returned. The caller
+ has to take care of some of the memory management; this function is
+ expected to be called from dynarray-skeleton.c. */
+bool __libc_dynarray_finalize (struct dynarray_header *list, void *scratch,
+ size_t element_size,
+ struct dynarray_finalize_result *result);
+
+
+/* Internal function. Terminate the process after an index error.
+ SIZE is the number of elements of the dynamic array. INDEX is the
+ lookup index which triggered the failure. */
+_Noreturn void __libc_dynarray_at_failure (size_t size, size_t index);
+
+#ifndef _ISOMAC
+libc_hidden_proto (__libc_dynarray_emplace_enlarge)
+libc_hidden_proto (__libc_dynarray_resize)
+libc_hidden_proto (__libc_dynarray_resize_clear)
+libc_hidden_proto (__libc_dynarray_finalize)
+libc_hidden_proto (__libc_dynarray_at_failure)
+#endif
+
+#endif /* _DYNARRAY_H */
diff --git a/lib/timegm.c b/lib/malloc/dynarray_at_failure.c
similarity index 50%
copy from lib/timegm.c
copy to lib/malloc/dynarray_at_failure.c
index fa30943..a442459 100644
--- a/lib/timegm.c
+++ b/lib/malloc/dynarray_at_failure.c
@@ -1,6 +1,5 @@
-/* Convert UTC calendar time to simple time. Like mktime but assumes UTC.
-
- Copyright (C) 1994-2020 Free Software Foundation, Inc.
+/* Report an dynamic array index out of bounds condition.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
@@ -17,42 +16,20 @@
License along with the GNU C Library; if not, see
<https://www.gnu.org/licenses/>. */
-#ifndef _LIBC
-# include <libc-config.h>
-#endif
-
-#include <time.h>
-#include <errno.h>
-
-#include "mktime-internal.h"
-
-__time64_t
-__timegm64 (struct tm *tmp)
-{
- static mktime_offset_t gmtime_offset;
- tmp->tm_isdst = 0;
- return __mktime_internal (tmp, __gmtime64_r, &gmtime_offset);
-}
-
-#if defined _LIBC && __TIMESIZE != 64
-
-libc_hidden_def (__timegm64)
+#include <dynarray.h>
+#include <stdio.h>
+#include <stdlib.h>
-time_t
-timegm (struct tm *tmp)
+void
+__libc_dynarray_at_failure (size_t size, size_t index)
{
- struct tm tm = *tmp;
- __time64_t t = __timegm64 (&tm);
- if (in_time_t_range (t))
- {
- *tmp = tm;
- return t;
- }
- else
- {
- __set_errno (EOVERFLOW);
- return -1;
- }
-}
-
+#ifdef _LIBC
+ char buf[200];
+ __snprintf (buf, sizeof (buf), "Fatal glibc error: "
+ "array index %zu not less than array length %zu\n",
+ index, size);
+#else
+ abort ();
#endif
+}
+libc_hidden_def (__libc_dynarray_at_failure)
diff --git a/lib/malloc/dynarray_emplace_enlarge.c
b/lib/malloc/dynarray_emplace_enlarge.c
new file mode 100644
index 0000000..7ac4b6d
--- /dev/null
+++ b/lib/malloc/dynarray_emplace_enlarge.c
@@ -0,0 +1,73 @@
+/* Increase the size of a dynamic array in preparation of an emplace operation.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <errno.h>
+#include <intprops.h>
+#include <stdlib.h>
+#include <string.h>
+
+bool
+__libc_dynarray_emplace_enlarge (struct dynarray_header *list,
+ void *scratch, size_t element_size)
+{
+ size_t new_allocated;
+ if (list->allocated == 0)
+ {
+ /* No scratch buffer provided. Choose a reasonable default
+ size. */
+ if (element_size < 4)
+ new_allocated = 16;
+ else if (element_size < 8)
+ new_allocated = 8;
+ else
+ new_allocated = 4;
+ }
+ else
+ /* Increase the allocated size, using an exponential growth
+ policy. */
+ {
+ new_allocated = list->allocated + list->allocated / 2 + 1;
+ if (new_allocated <= list->allocated)
+ {
+ /* Overflow. */
+ __set_errno (ENOMEM);
+ return false;
+ }
+ }
+
+ size_t new_size;
+ if (INT_MULTIPLY_WRAPV (new_allocated, element_size, &new_size))
+ return false;
+ void *new_array;
+ if (list->array == scratch)
+ {
+ /* The previous array was not heap-allocated. */
+ new_array = malloc (new_size);
+ if (new_array != NULL && list->array != NULL)
+ memcpy (new_array, list->array, list->used * element_size);
+ }
+ else
+ new_array = realloc (list->array, new_size);
+ if (new_array == NULL)
+ return false;
+ list->array = new_array;
+ list->allocated = new_allocated;
+ return true;
+}
+libc_hidden_def (__libc_dynarray_emplace_enlarge)
diff --git a/lib/malloc/dynarray_finalize.c b/lib/malloc/dynarray_finalize.c
new file mode 100644
index 0000000..be9441e
--- /dev/null
+++ b/lib/malloc/dynarray_finalize.c
@@ -0,0 +1,62 @@
+/* Copy the dynamically-allocated area to an explicitly-sized heap allocation.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <stdlib.h>
+#include <string.h>
+
+bool
+__libc_dynarray_finalize (struct dynarray_header *list,
+ void *scratch, size_t element_size,
+ struct dynarray_finalize_result *result)
+{
+ if (__dynarray_error (list))
+ /* The caller will reported the deferred error. */
+ return false;
+
+ size_t used = list->used;
+
+ /* Empty list. */
+ if (used == 0)
+ {
+ /* An empty list could still be backed by a heap-allocated
+ array. Free it if necessary. */
+ if (list->array != scratch)
+ free (list->array);
+ *result = (struct dynarray_finalize_result) { NULL, 0 };
+ return true;
+ }
+
+ size_t allocation_size = used * element_size;
+ void *heap_array = malloc (allocation_size);
+ if (heap_array != NULL)
+ {
+ /* The new array takes ownership of the strings. */
+ if (list->array != NULL)
+ memcpy (heap_array, list->array, allocation_size);
+ if (list->array != scratch)
+ free (list->array);
+ *result = (struct dynarray_finalize_result)
+ { .array = heap_array, .length = used };
+ return true;
+ }
+ else
+ /* The caller will perform the freeing operation. */
+ return false;
+}
+libc_hidden_def (__libc_dynarray_finalize)
diff --git a/lib/malloc/dynarray_resize.c b/lib/malloc/dynarray_resize.c
new file mode 100644
index 0000000..92bbddd
--- /dev/null
+++ b/lib/malloc/dynarray_resize.c
@@ -0,0 +1,64 @@
+/* Increase the size of a dynamic array.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <errno.h>
+#include <intprops.h>
+#include <stdlib.h>
+#include <string.h>
+
+bool
+__libc_dynarray_resize (struct dynarray_header *list, size_t size,
+ void *scratch, size_t element_size)
+{
+ /* The existing allocation provides sufficient room. */
+ if (size <= list->allocated)
+ {
+ list->used = size;
+ return true;
+ }
+
+ /* Otherwise, use size as the new allocation size. The caller is
+ expected to provide the final size of the array, so there is no
+ over-allocation here. */
+
+ size_t new_size_bytes;
+ if (INT_MULTIPLY_WRAPV (size, element_size, &new_size_bytes))
+ {
+ /* Overflow. */
+ __set_errno (ENOMEM);
+ return false;
+ }
+ void *new_array;
+ if (list->array == scratch)
+ {
+ /* The previous array was not heap-allocated. */
+ new_array = malloc (new_size_bytes);
+ if (new_array != NULL && list->array != NULL)
+ memcpy (new_array, list->array, list->used * element_size);
+ }
+ else
+ new_array = realloc (list->array, new_size_bytes);
+ if (new_array == NULL)
+ return false;
+ list->array = new_array;
+ list->allocated = size;
+ list->used = size;
+ return true;
+}
+libc_hidden_def (__libc_dynarray_resize)
diff --git a/lib/malloc/dynarray_resize_clear.c
b/lib/malloc/dynarray_resize_clear.c
new file mode 100644
index 0000000..99c2cc8
--- /dev/null
+++ b/lib/malloc/dynarray_resize_clear.c
@@ -0,0 +1,35 @@
+/* Increase the size of a dynamic array and clear the new part.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <string.h>
+
+bool
+__libc_dynarray_resize_clear (struct dynarray_header *list, size_t size,
+ void *scratch, size_t element_size)
+{
+ size_t old_size = list->used;
+ if (!__libc_dynarray_resize (list, size, scratch, element_size))
+ return false;
+ /* __libc_dynarray_resize already checked for overflow. */
+ char *array = list->array;
+ memset (array + (old_size * element_size), 0,
+ (size - old_size) * element_size);
+ return true;
+}
+libc_hidden_def (__libc_dynarray_resize_clear)
diff --git a/lib/malloc/scratch_buffer_grow.c b/lib/malloc/scratch_buffer_grow.c
index 41befe3..e7606d8 100644
--- a/lib/malloc/scratch_buffer_grow.c
+++ b/lib/malloc/scratch_buffer_grow.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_grow_preserve.c
b/lib/malloc/scratch_buffer_grow_preserve.c
index aef2329..59f8c71 100644
--- a/lib/malloc/scratch_buffer_grow_preserve.c
+++ b/lib/malloc/scratch_buffer_grow_preserve.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_set_array_size.c
b/lib/malloc/scratch_buffer_set_array_size.c
index 5f5e4c2..e2b9f31 100644
--- a/lib/malloc/scratch_buffer_set_array_size.c
+++ b/lib/malloc/scratch_buffer_set_array_size.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c
index d34fe52..de061e6 100644
--- a/lib/mini-gmp.c
+++ b/lib/mini-gmp.c
@@ -4521,7 +4521,7 @@ mpz_export (void *r, size_t *countp, int order, size_t
size, int endian,
mp_size_t un;
if (nails != 0)
- gmp_die ("mpz_import: Nails not supported.");
+ gmp_die ("mpz_export: Nails not supported.");
assert (order == 1 || order == -1);
assert (endian >= -1 && endian <= 1);
diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h
index b765a37..9c447bd 100644
--- a/lib/mktime-internal.h
+++ b/lib/mktime-internal.h
@@ -1,5 +1,5 @@
/* Internals of mktime and related functions
- Copyright 2016-2020 Free Software Foundation, Inc.
+ Copyright 2016-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@cs.ucla.edu>.
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index 8ba6975..2f5e4fb 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -19,7 +19,7 @@
# define USE_IN_EXTENDED_LOCALE_MODEL 1
# define HAVE_STRUCT_ERA_ENTRY 1
# define HAVE_TM_GMTOFF 1
-# define HAVE_TM_ZONE 1
+# define HAVE_STRUCT_TM_TM_ZONE 1
# define HAVE_TZNAME 1
# include "../locale/localeinfo.h"
#else
@@ -499,7 +499,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
#endif
zone = NULL;
-#if HAVE_TM_ZONE
+#if HAVE_STRUCT_TM_TM_ZONE
/* The POSIX test suite assumes that setting
the environment variable TZ to a new value before calling strftime()
will influence the result (the %Z format) even if the information in
@@ -516,7 +516,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG
(size_t maxsize)
}
else
{
-# if !HAVE_TM_ZONE
+# if !HAVE_STRUCT_TM_TM_ZONE
/* Infer the zone name from *TZ instead of from TZNAME. */
tzname_vec = tz->tzname_copy;
# endif
diff --git a/lib/regex.c b/lib/regex.c
index 88173bb..f76a416 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index be2fa4f..4c634ed 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -32,6 +32,7 @@
#include <stdbool.h>
#include <stdint.h>
+#include <dynarray.h>
#include <intprops.h>
#include <verify.h>
@@ -444,25 +445,6 @@ typedef struct re_dfa_t re_dfa_t;
#define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
#define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
-#if defined _LIBC || HAVE_ALLOCA
-# include <alloca.h>
-#endif
-
-#ifndef _LIBC
-# if HAVE_ALLOCA
-/* The OS usually guarantees only one guard page at the bottom of the stack,
- and a page size can be as small as 4096 bytes. So we cannot safely
- allocate anything larger than 4096 bytes. Also care for the possibility
- of a few compiler-allocated temporary stack slots. */
-# define __libc_use_alloca(n) ((n) < 4032)
-# else
-/* alloca is implemented with malloc, so just use malloc. */
-# define __libc_use_alloca(n) 0
-# undef alloca
-# define alloca(n) malloc (n)
-# endif
-#endif
-
#ifdef _LIBC
# define MALLOC_0_IS_NONNULL 1
#elif !defined MALLOC_0_IS_NONNULL
@@ -848,12 +830,14 @@ re_string_elem_size_at (const re_string_t *pstr, Idx idx)
}
#endif /* RE_ENABLE_I18N */
-#ifndef FALLTHROUGH
-# if (__GNUC__ >= 7) || (__clang_major__ >= 10)
+#ifdef _LIBC
+# if __GNUC__ >= 7
# define FALLTHROUGH __attribute__ ((__fallthrough__))
# else
# define FALLTHROUGH ((void) 0)
# endif
+#else
+# include "attribute.h"
#endif
#endif /* _REGEX_INTERNAL_H */
diff --git a/lib/regexec.c b/lib/regexec.c
index 395e37d..15dc57b 100644
--- a/lib/regexec.c
+++ b/lib/regexec.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
@@ -1355,6 +1355,12 @@ pop_fail_stack (struct re_fail_stack_t *fs, Idx *pidx,
Idx nregs,
return fs->stack[num].node;
}
+
+#define DYNARRAY_STRUCT regmatch_list
+#define DYNARRAY_ELEMENT regmatch_t
+#define DYNARRAY_PREFIX regmatch_list_
+#include <malloc/dynarray-skeleton.c>
+
/* Set the positions where the subexpressions are starts/ends to registers
PMATCH.
Note: We assume that pmatch[0] is already set, and
@@ -1370,8 +1376,8 @@ set_regs (const regex_t *preg, const re_match_context_t
*mctx, size_t nmatch,
re_node_set eps_via_nodes;
struct re_fail_stack_t *fs;
struct re_fail_stack_t fs_body = { 0, 2, NULL };
- regmatch_t *prev_idx_match;
- bool prev_idx_match_malloced = false;
+ struct regmatch_list prev_match;
+ regmatch_list_init (&prev_match);
DEBUG_ASSERT (nmatch > 1);
DEBUG_ASSERT (mctx->state_log != NULL);
@@ -1388,18 +1394,13 @@ set_regs (const regex_t *preg, const re_match_context_t
*mctx, size_t nmatch,
cur_node = dfa->init_node;
re_node_set_init_empty (&eps_via_nodes);
- if (__libc_use_alloca (nmatch * sizeof (regmatch_t)))
- prev_idx_match = (regmatch_t *) alloca (nmatch * sizeof (regmatch_t));
- else
+ if (!regmatch_list_resize (&prev_match, nmatch))
{
- prev_idx_match = re_malloc (regmatch_t, nmatch);
- if (prev_idx_match == NULL)
- {
- free_fail_stack_return (fs);
- return REG_ESPACE;
- }
- prev_idx_match_malloced = true;
+ regmatch_list_free (&prev_match);
+ free_fail_stack_return (fs);
+ return REG_ESPACE;
}
+ regmatch_t *prev_idx_match = regmatch_list_begin (&prev_match);
memcpy (prev_idx_match, pmatch, sizeof (regmatch_t) * nmatch);
for (idx = pmatch[0].rm_so; idx <= pmatch[0].rm_eo ;)
@@ -1417,8 +1418,7 @@ set_regs (const regex_t *preg, const re_match_context_t
*mctx, size_t nmatch,
if (reg_idx == nmatch)
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return free_fail_stack_return (fs);
}
cur_node = pop_fail_stack (fs, &idx, nmatch, pmatch,
@@ -1427,8 +1427,7 @@ set_regs (const regex_t *preg, const re_match_context_t
*mctx, size_t nmatch,
else
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return REG_NOERROR;
}
}
@@ -1442,8 +1441,7 @@ set_regs (const regex_t *preg, const re_match_context_t
*mctx, size_t nmatch,
if (__glibc_unlikely (cur_node == -2))
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
free_fail_stack_return (fs);
return REG_ESPACE;
}
@@ -1453,15 +1451,13 @@ set_regs (const regex_t *preg, const re_match_context_t
*mctx, size_t nmatch,
else
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return REG_NOMATCH;
}
}
}
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return free_fail_stack_return (fs);
}
@@ -3251,7 +3247,7 @@ expand_bkref_cache (re_match_context_t *mctx, re_node_set
*cur_nodes,
/* Build transition table for the state.
Return true if successful. */
-static bool
+static bool __attribute_noinline__
build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
{
reg_errcode_t err;
@@ -3259,36 +3255,20 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t
*state)
int ch;
bool need_word_trtable = false;
bitset_word_t elem, mask;
- bool dests_node_malloced = false;
- bool dest_states_malloced = false;
Idx ndests; /* Number of the destination states from 'state'. */
re_dfastate_t **trtable;
- re_dfastate_t **dest_states = NULL, **dest_states_word, **dest_states_nl;
- re_node_set follows, *dests_node;
- bitset_t *dests_ch;
+ re_dfastate_t *dest_states[SBC_MAX];
+ re_dfastate_t *dest_states_word[SBC_MAX];
+ re_dfastate_t *dest_states_nl[SBC_MAX];
+ re_node_set follows;
bitset_t acceptable;
- struct dests_alloc
- {
- re_node_set dests_node[SBC_MAX];
- bitset_t dests_ch[SBC_MAX];
- } *dests_alloc;
-
/* We build DFA states which corresponds to the destination nodes
from 'state'. 'dests_node[i]' represents the nodes which i-th
destination state contains, and 'dests_ch[i]' represents the
characters which i-th destination state accepts. */
- if (__libc_use_alloca (sizeof (struct dests_alloc)))
- dests_alloc = (struct dests_alloc *) alloca (sizeof (struct dests_alloc));
- else
- {
- dests_alloc = re_malloc (struct dests_alloc, 1);
- if (__glibc_unlikely (dests_alloc == NULL))
- return false;
- dests_node_malloced = true;
- }
- dests_node = dests_alloc->dests_node;
- dests_ch = dests_alloc->dests_ch;
+ re_node_set dests_node[SBC_MAX];
+ bitset_t dests_ch[SBC_MAX];
/* Initialize transition table. */
state->word_trtable = state->trtable = NULL;
@@ -3298,8 +3278,6 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
ndests = group_nodes_into_DFAstates (dfa, state, dests_node, dests_ch);
if (__glibc_unlikely (ndests <= 0))
{
- if (dests_node_malloced)
- re_free (dests_alloc);
/* Return false in case of an error, true otherwise. */
if (ndests == 0)
{
@@ -3314,38 +3292,14 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t
*state)
err = re_node_set_alloc (&follows, ndests + 1);
if (__glibc_unlikely (err != REG_NOERROR))
- goto out_free;
-
- /* Avoid arithmetic overflow in size calculation. */
- size_t ndests_max
- = ((SIZE_MAX - (sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX)
- / (3 * sizeof (re_dfastate_t *)));
- if (__glibc_unlikely (ndests_max < ndests))
- goto out_free;
-
- if (__libc_use_alloca ((sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX
- + ndests * 3 * sizeof (re_dfastate_t *)))
- dest_states = (re_dfastate_t **)
- alloca (ndests * 3 * sizeof (re_dfastate_t *));
- else
{
- dest_states = re_malloc (re_dfastate_t *, ndests * 3);
- if (__glibc_unlikely (dest_states == NULL))
- {
-out_free:
- if (dest_states_malloced)
- re_free (dest_states);
- re_node_set_free (&follows);
- for (i = 0; i < ndests; ++i)
- re_node_set_free (dests_node + i);
- if (dests_node_malloced)
- re_free (dests_alloc);
- return false;
- }
- dest_states_malloced = true;
+ out_free:
+ re_node_set_free (&follows);
+ for (i = 0; i < ndests; ++i)
+ re_node_set_free (dests_node + i);
+ return false;
}
- dest_states_word = dest_states + ndests;
- dest_states_nl = dest_states_word + ndests;
+
bitset_empty (acceptable);
/* Then build the states for all destinations. */
@@ -3470,16 +3424,9 @@ out_free:
}
}
- if (dest_states_malloced)
- re_free (dest_states);
-
re_node_set_free (&follows);
for (i = 0; i < ndests; ++i)
re_node_set_free (dests_node + i);
-
- if (dests_node_malloced)
- re_free (dests_alloc);
-
return true;
}
diff --git a/lib/scratch_buffer.h b/lib/scratch_buffer.h
index 3e2b5ef..603b0d6 100644
--- a/lib/scratch_buffer.h
+++ b/lib/scratch_buffer.h
@@ -21,6 +21,7 @@
#include <libc-config.h>
+#define __libc_scratch_buffer_dupfree gl_scratch_buffer_dupfree
#define __libc_scratch_buffer_grow gl_scratch_buffer_grow
#define __libc_scratch_buffer_grow_preserve gl_scratch_buffer_grow_preserve
#define __libc_scratch_buffer_set_array_size gl_scratch_buffer_set_array_size
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index ba7195a..0f506a5 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -49,6 +49,23 @@
# ifndef _@GUARD_PREFIX@_STDDEF_H
+/* On AIX 7.2, with xlc in 64-bit mode, <stddef.h> defines max_align_t to a
+ type with alignment 4, but 'long' has alignment 8. */
+# if defined _AIX && defined _ARCH_PPC64
+# if !GNULIB_defined_max_align_t
+# ifdef _MAX_ALIGN_T
+/* /usr/include/stddef.h has already defined max_align_t. Override it. */
+typedef long rpl_max_align_t;
+# define max_align_t rpl_max_align_t
+# else
+/* Prevent /usr/include/stddef.h from defining max_align_t. */
+typedef long max_align_t;
+# define _MAX_ALIGN_T
+# endif
+# define GNULIB_defined_max_align_t 1
+# endif
+# endif
+
/* The include_next requires a split double-inclusion guard. */
# @INCLUDE_NEXT@ @NEXT_STDDEF_H@
@@ -86,8 +103,10 @@
we are currently compiling with gcc.
On MSVC, max_align_t is defined only in C++ mode, after <cstddef> was
included. Its definition is good since it has an alignment of 8 (on x86
- and x86_64). */
-#if defined _MSC_VER && defined __cplusplus
+ and x86_64).
+ Similarly on OS/2 kLIBC. */
+#if (defined _MSC_VER || (defined __KLIBC__ && !defined __LIBCN__)) \
+ && defined __cplusplus
# include <cstddef>
#else
# if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T)
diff --git a/lib/string.in.h b/lib/string.in.h
index 9f68e77..c76c182 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -69,6 +69,14 @@
# include <unistd.h>
#endif
+/* AIX 7.2 declares ffsl and ffsll in <strings.h>, not in <string.h>. */
+/* But in any case avoid namespace pollution on glibc systems. */
+#if ((@GNULIB_FFSL@ || @GNULIB_FFSLL@ || defined GNULIB_POSIXCHECK) \
+ && defined _AIX) \
+ && ! defined __GLIBC__
+# include <strings.h>
+#endif
+
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* The definition of _GL_ARG_NONNULL is copied here. */
@@ -110,10 +118,18 @@ _GL_WARN_ON_USE (ffsl, "ffsl is not portable - use the
ffsl module");
/* Find the index of the least-significant set bit. */
#if @GNULIB_FFSLL@
-# if !@HAVE_FFSLL@
+# if @REPLACE_FFSLL@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# define ffsll rpl_ffsll
+# endif
+_GL_FUNCDECL_RPL (ffsll, int, (long long int i));
+_GL_CXXALIAS_RPL (ffsll, int, (long long int i));
+# else
+# if !@HAVE_FFSLL@
_GL_FUNCDECL_SYS (ffsll, int, (long long int i));
-# endif
+# endif
_GL_CXXALIAS_SYS (ffsll, int, (long long int i));
+# endif
_GL_CXXALIASWARN (ffsll);
#elif defined GNULIB_POSIXCHECK
# undef ffsll
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index ccdb5cb..13d1294 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -713,11 +713,21 @@ _GL_WARN_ON_USE (mkfifo, "mkfifo is not portable - "
#if @GNULIB_MKFIFOAT@
-# if !@HAVE_MKFIFOAT@
+# if @REPLACE_MKFIFOAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mkfifoat
+# define mkfifoat rpl_mkfifoat
+# endif
+_GL_FUNCDECL_RPL (mkfifoat, int, (int fd, char const *file, mode_t mode)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (mkfifoat, int, (int fd, char const *file, mode_t mode));
+# else
+# if !@HAVE_MKFIFOAT@
_GL_FUNCDECL_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode));
+# endif
_GL_CXXALIASWARN (mkfifoat);
#elif defined GNULIB_POSIXCHECK
# undef mkfifoat
@@ -756,13 +766,25 @@ _GL_WARN_ON_USE (mknod, "mknod is not portable - "
#if @GNULIB_MKNODAT@
-# if !@HAVE_MKNODAT@
+# if @REPLACE_MKNODAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mknodat
+# define mknodat rpl_mknodat
+# endif
+_GL_FUNCDECL_RPL (mknodat, int,
+ (int fd, char const *file, mode_t mode, dev_t dev)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (mknodat, int,
+ (int fd, char const *file, mode_t mode, dev_t dev));
+# else
+# if !@HAVE_MKNODAT@
_GL_FUNCDECL_SYS (mknodat, int,
(int fd, char const *file, mode_t mode, dev_t dev)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (mknodat, int,
(int fd, char const *file, mode_t mode, dev_t dev));
+# endif
_GL_CXXALIASWARN (mknodat);
#elif defined GNULIB_POSIXCHECK
# undef mknodat
diff --git a/lib/tempname.c b/lib/tempname.c
index 3d91dee..e243483 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -22,6 +22,7 @@
#include <sys/types.h>
#include <assert.h>
+#include <stdbool.h>
#include <errno.h>
@@ -61,7 +62,8 @@
# define __gen_tempname gen_tempname
# define __mkdir mkdir
# define __open open
-# define __lxstat64(version, file, buf) lstat (file, buf)
+# define __lstat64(file, buf) lstat (file, buf)
+# define __stat64(file, buf) stat (file, buf)
# define __getrandom getrandom
# define __clock_gettime64 clock_gettime
# define __timespec64 timespec
@@ -76,13 +78,14 @@ typedef uint_fast64_t random_value;
#define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62)
static random_value
-random_bits (random_value var)
+random_bits (random_value var, bool use_getrandom)
{
random_value r;
- if (__getrandom (&r, sizeof r, 0) == sizeof r)
+ /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */
+ if (use_getrandom && __getrandom (&r, sizeof r, GRND_NONBLOCK) == sizeof r)
return r;
#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME)
- /* Add entropy if getrandom is not supported. */
+ /* Add entropy if getrandom did not work. */
struct __timespec64 tv;
__clock_gettime64 (CLOCK_MONOTONIC, &tv);
var ^= tv.tv_nsec;
@@ -96,7 +99,7 @@ static int
direxists (const char *dir)
{
struct_stat64 buf;
- return __xstat64 (_STAT_VER, dir, &buf) == 0 && S_ISDIR (buf.st_mode);
+ return __stat64 (dir, &buf) == 0 && S_ISDIR (buf.st_mode);
}
/* Path search algorithm, for tmpnam, tmpfile, etc. If DIR is
@@ -188,7 +191,7 @@ try_nocreate (char *tmpl, void *flags _GL_UNUSED)
{
struct_stat64 st;
- if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
+ if (__lstat64 (tmpl, &st) == 0 || errno == EOVERFLOW)
__set_errno (EEXIST);
return errno == ENOENT ? 0 : -1;
}
@@ -267,6 +270,13 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
/* How many random base-62 digits can currently be extracted from V. */
int vdigits = 0;
+ /* Whether to consume entropy when acquiring random bits. On the
+ first try it's worth the entropy cost with __GT_NOCREATE, which
+ is inherently insecure and can use the entropy to make it a bit
+ less secure. On the (rare) second and later attempts it might
+ help against DoS attacks. */
+ bool use_getrandom = tryfunc == try_nocreate;
+
/* Least unfair value for V. If V is less than this, V can generate
BASE_62_DIGITS digits fairly. Otherwise it might be biased. */
random_value const unfair_min
@@ -290,7 +300,10 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
if (vdigits == 0)
{
do
- v = random_bits (v);
+ {
+ v = random_bits (v, use_getrandom);
+ use_getrandom = true;
+ }
while (unfair_min <= v);
vdigits = BASE_62_DIGITS;
diff --git a/lib/time-internal.h b/lib/time-internal.h
index 63a3f9e..067ee72 100644
--- a/lib/time-internal.h
+++ b/lib/time-internal.h
@@ -24,7 +24,7 @@ struct tm_zone
members are zero. */
struct tm_zone *next;
-#if HAVE_TZNAME && !HAVE_TM_ZONE
+#if HAVE_TZNAME && !HAVE_STRUCT_TM_TM_ZONE
/* Copies of recent strings taken from tzname[0] and tzname[1].
The copies are in ABBRS, so that they survive tzset. Null if unknown. */
char *tzname_copy[2];
diff --git a/lib/time.in.h b/lib/time.in.h
index 958dc0b..1385980 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -101,6 +101,25 @@ struct __time_t_must_be_integral {
# define GNULIB_defined_struct_time_t_must_be_integral 1
# endif
+/* Define TIME_UTC, a positive integer constant used for timespec_get(). */
+# if ! @TIME_H_DEFINES_TIME_UTC@
+# if !GNULIB_defined_TIME_UTC
+# define TIME_UTC 1
+# define GNULIB_defined_TIME_UTC 1
+# endif
+# endif
+
+/* Set *TS to the current time, and return BASE.
+ Upon failure, return 0. */
+# if @GNULIB_TIMESPEC_GET@
+# if ! @HAVE_TIMESPEC_GET@
+_GL_FUNCDECL_SYS (timespec_get, int, (struct timespec *ts, int base)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (timespec_get, int, (struct timespec *ts, int base));
+_GL_CXXALIASWARN (timespec_get);
+# endif
+
/* Sleep for at least RQTP seconds unless interrupted, If interrupted,
return -1 and store the remaining time into RMTP. See
<https://pubs.opengroup.org/onlinepubs/9699919799/functions/nanosleep.html>. */
diff --git a/lib/time_rz.c b/lib/time_rz.c
index 65e20cc..3ac053c 100644
--- a/lib/time_rz.c
+++ b/lib/time_rz.c
@@ -71,7 +71,7 @@ tzalloc (char const *name)
if (tz)
{
tz->next = NULL;
-#if HAVE_TZNAME && !HAVE_TM_ZONE
+#if HAVE_TZNAME && !HAVE_STRUCT_TM_TM_ZONE
tz->tzname_copy[0] = tz->tzname_copy[1] = NULL;
#endif
tz->tz_is_set = !!name;
@@ -83,13 +83,13 @@ tzalloc (char const *name)
}
/* Save into TZ any nontrivial time zone abbreviation used by TM, and
- update *TM (if HAVE_TM_ZONE) or *TZ (if !HAVE_TM_ZONE &&
- HAVE_TZNAME) if they use the abbreviation. Return true if
- successful, false (setting errno) otherwise. */
+ update *TM (if HAVE_STRUCT_TM_TM_ZONE) or *TZ (if
+ !HAVE_STRUCT_TM_TM_ZONE && HAVE_TZNAME) if they use the abbreviation.
+ Return true if successful, false (setting errno) otherwise. */
static bool
save_abbr (timezone_t tz, struct tm *tm)
{
-#if HAVE_TM_ZONE || HAVE_TZNAME
+#if HAVE_STRUCT_TM_TM_ZONE || HAVE_TZNAME
char const *zone = NULL;
char *zone_copy = (char *) "";
@@ -97,7 +97,7 @@ save_abbr (timezone_t tz, struct tm *tm)
int tzname_index = -1;
# endif
-# if HAVE_TM_ZONE
+# if HAVE_STRUCT_TM_TM_ZONE
zone = tm->tm_zone;
# endif
@@ -145,7 +145,7 @@ save_abbr (timezone_t tz, struct tm *tm)
}
/* Replace the zone name so that its lifetime matches that of TZ. */
-# if HAVE_TM_ZONE
+# if HAVE_STRUCT_TM_TM_ZONE
tm->tm_zone = zone_copy;
# else
if (0 <= tzname_index)
@@ -303,7 +303,7 @@ mktime_z (timezone_t tz, struct tm *tm)
tm_1.tm_isdst = tm->tm_isdst;
time_t t = mktime (&tm_1);
bool ok = 0 <= tm_1.tm_yday;
-#if HAVE_TM_ZONE || HAVE_TZNAME
+#if HAVE_STRUCT_TM_TM_ZONE || HAVE_TZNAME
ok = ok && save_abbr (tz, &tm_1);
#endif
if (revert_tz (old_tz) && ok)
diff --git a/lib/timegm.c b/lib/timegm.c
index fa30943..e4127e7 100644
--- a/lib/timegm.c
+++ b/lib/timegm.c
@@ -1,6 +1,6 @@
/* Convert UTC calendar time to simple time. Like mktime but assumes UTC.
- Copyright (C) 1994-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/utimens.c b/lib/utimens.c
index 5bbae05..44d1ea0 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -27,6 +27,7 @@
#include <errno.h>
#include <fcntl.h>
#include <stdbool.h>
+#include <string.h>
#include <sys/stat.h>
#include <sys/time.h>
#include <unistd.h>
@@ -52,7 +53,9 @@
/* Avoid recursion with rpl_futimens or rpl_utimensat. */
#undef futimens
-#undef utimensat
+#if !HAVE_NEARLY_WORKING_UTIMENSAT
+# undef utimensat
+#endif
/* Solaris 9 mistakenly succeeds when given a non-directory with a
trailing slash. Force the use of rpl_stat for a fix. */
@@ -246,6 +249,20 @@ fdutimens (int fd, char const *file, struct timespec const
timespec[2])
# if HAVE_UTIMENSAT
if (fd < 0)
{
+# if defined __APPLE__ && defined __MACH__
+ size_t len = strlen (file);
+ if (len > 0 && file[len - 1] == '/')
+ {
+ struct stat statbuf;
+ if (stat (file, &statbuf) < 0)
+ return -1;
+ if (!S_ISDIR (statbuf.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+# endif
result = utimensat (AT_FDCWD, file, ts, 0);
# ifdef __linux__
/* Work around a kernel bug:
diff --git a/lib/utimensat.c b/lib/utimensat.c
index 2cea64f..9fdecd6 100644
--- a/lib/utimensat.c
+++ b/lib/utimensat.c
@@ -24,14 +24,40 @@
#include <errno.h>
#include <fcntl.h>
#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
#include "stat-time.h"
#include "timespec.h"
#include "utimens.h"
-#if HAVE_UTIMENSAT
+#if HAVE_NEARLY_WORKING_UTIMENSAT
+/* Use the original utimensat(), but correct the trailing slash handling. */
+int
+rpl_utimensat (int fd, char const *file, struct timespec const times[2],
+ int flag)
# undef utimensat
+{
+ size_t len = strlen (file);
+ if (len && file[len - 1] == '/')
+ {
+ struct stat st;
+ if (fstatat (fd, file, &st, flag & AT_SYMLINK_NOFOLLOW) < 0)
+ return -1;
+ if (!S_ISDIR (st.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+
+ return utimensat (fd, file, times, flag);
+}
+
+#else
+
+# if HAVE_UTIMENSAT
/* If we have a native utimensat, but are compiling this file, then
utimensat was defined to rpl_utimensat by our replacement
@@ -42,24 +68,25 @@
local_utimensat provides the fallback manipulation. */
static int local_utimensat (int, char const *, struct timespec const[2], int);
-# define AT_FUNC_NAME local_utimensat
+# define AT_FUNC_NAME local_utimensat
/* Like utimensat, but work around native bugs. */
int
rpl_utimensat (int fd, char const *file, struct timespec const times[2],
int flag)
+# undef utimensat
{
-# if defined __linux__ || defined __sun
+# if defined __linux__ || defined __sun
struct timespec ts[2];
-# endif
+# endif
/* See comments in utimens.c for details. */
static int utimensat_works_really; /* 0 = unknown, 1 = yes, -1 = no. */
if (0 <= utimensat_works_really)
{
int result;
-# if defined __linux__ || defined __sun
+# if defined __linux__ || defined __sun
struct stat st;
/* As recently as Linux kernel 2.6.32 (Dec 2009), several file
systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
@@ -90,7 +117,7 @@ rpl_utimensat (int fd, char const *file, struct timespec
const times[2],
ts[1] = times[1];
times = ts;
}
-# ifdef __hppa__
+# ifdef __hppa__
/* Linux kernel 2.6.22.19 on hppa does not reject invalid tv_nsec
values. */
else if (times
@@ -104,8 +131,36 @@ rpl_utimensat (int fd, char const *file, struct timespec
const times[2],
errno = EINVAL;
return -1;
}
+# endif
+# endif
+# if defined __APPLE__ && defined __MACH__
+ /* macOS 10.13 does not reject invalid tv_nsec values either. */
+ if (times
+ && ((times[0].tv_nsec != UTIME_OMIT
+ && times[0].tv_nsec != UTIME_NOW
+ && ! (0 <= times[0].tv_nsec
+ && times[0].tv_nsec < TIMESPEC_HZ))
+ || (times[1].tv_nsec != UTIME_OMIT
+ && times[1].tv_nsec != UTIME_NOW
+ && ! (0 <= times[1].tv_nsec
+ && times[1].tv_nsec < TIMESPEC_HZ))))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ size_t len = strlen (file);
+ if (len > 0 && file[len - 1] == '/')
+ {
+ struct stat statbuf;
+ if (fstatat (fd, file, &statbuf, 0) < 0)
+ return -1;
+ if (!S_ISDIR (statbuf.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
# endif
-# endif
result = utimensat (fd, file, times, flag);
/* Linux kernel 2.6.25 has a bug where it returns EINVAL for
UTIME_NOW or UTIME_OMIT with non-zero tv_sec, which
@@ -129,11 +184,11 @@ rpl_utimensat (int fd, char const *file, struct timespec
const times[2],
return local_utimensat (fd, file, times, flag);
}
-#else /* !HAVE_UTIMENSAT */
+# else /* !HAVE_UTIMENSAT */
-# define AT_FUNC_NAME utimensat
+# define AT_FUNC_NAME utimensat
-#endif /* !HAVE_UTIMENSAT */
+# endif /* !HAVE_UTIMENSAT */
/* Set the access and modification timestamps of FILE to be
TIMESPEC[0] and TIMESPEC[1], respectively; relative to directory
@@ -146,15 +201,17 @@ rpl_utimensat (int fd, char const *file, struct timespec
const times[2],
Return 0 on success, -1 (setting errno) on failure. */
/* AT_FUNC_NAME is now utimensat or local_utimensat. */
-#define AT_FUNC_F1 lutimens
-#define AT_FUNC_F2 utimens
-#define AT_FUNC_USE_F1_COND AT_SYMLINK_NOFOLLOW
-#define AT_FUNC_POST_FILE_PARAM_DECLS , struct timespec const ts[2], int flag
-#define AT_FUNC_POST_FILE_ARGS , ts
-#include "at-func.c"
-#undef AT_FUNC_NAME
-#undef AT_FUNC_F1
-#undef AT_FUNC_F2
-#undef AT_FUNC_USE_F1_COND
-#undef AT_FUNC_POST_FILE_PARAM_DECLS
-#undef AT_FUNC_POST_FILE_ARGS
+# define AT_FUNC_F1 lutimens
+# define AT_FUNC_F2 utimens
+# define AT_FUNC_USE_F1_COND AT_SYMLINK_NOFOLLOW
+# define AT_FUNC_POST_FILE_PARAM_DECLS , struct timespec const ts[2], int flag
+# define AT_FUNC_POST_FILE_ARGS , ts
+# include "at-func.c"
+# undef AT_FUNC_NAME
+# undef AT_FUNC_F1
+# undef AT_FUNC_F2
+# undef AT_FUNC_USE_F1_COND
+# undef AT_FUNC_POST_FILE_PARAM_DECLS
+# undef AT_FUNC_POST_FILE_ARGS
+
+#endif /* !HAVE_NEARLY_WORKING_UTIMENSAT */
diff --git a/lib/verify.h b/lib/verify.h
index 3cdcdca..65514c3 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -22,16 +22,10 @@
/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert (R, DIAGNOSTIC)
- works as per C11. This is supported by GCC 4.6.0 and later, in C
- mode, and by clang (also in C++ mode).
+ works as per C11. This is supported by GCC 4.6.0+ and by clang 4+.
Define _GL_HAVE__STATIC_ASSERT1 to 1 if _Static_assert (R) works as
- per C2X. This is supported by GCC 9.1 and later, and by clang in
- C++1z mode.
-
- Define _GL_HAVE_STATIC_ASSERT1 if static_assert (R) works as per
- C++17. This is supported by GCC 9.1 and later, and by clang in
- C++1z mode.
+ per C2X. This is supported by GCC 9.1+.
Support compilers claiming conformance to the relevant standard,
and also support GCC when not pedantic. If we were willing to slow
@@ -47,18 +41,6 @@
|| (!defined __STRICT_ANSI__ && 9 <= __GNUC__))
# define _GL_HAVE__STATIC_ASSERT1 1
# endif
-#else
-# if 4 <= __clang_major__
-# define _GL_HAVE__STATIC_ASSERT 1
-# endif
-# if 4 <= __clang_major__ && 201411 <= __cpp_static_assert
-# define _GL_HAVE__STATIC_ASSERT1 1
-# endif
-# if 201703L <= __cplusplus \
- || 9 <= __GNUC__ \
- || (4 <= __clang_major__ && 201411 <= __cpp_static_assert)
-# define _GL_HAVE_STATIC_ASSERT1 1
-# endif
#endif
/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other
@@ -225,7 +207,9 @@ template <int w>
Unfortunately, unlike C11, this implementation must appear as an
ordinary declaration, and cannot appear inside struct { ... }. */
-#if defined _GL_HAVE__STATIC_ASSERT
+#if 200410 <= __cpp_static_assert
+# define _GL_VERIFY(R, DIAGNOSTIC, ...) static_assert (R, DIAGNOSTIC)
+#elif defined _GL_HAVE__STATIC_ASSERT
# define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC)
#else
# define _GL_VERIFY(R, DIAGNOSTIC, ...) \
@@ -239,7 +223,7 @@ template <int w>
# define _Static_assert(...) \
_GL_VERIFY (__VA_ARGS__, "static assertion failed", -)
# endif
-# if !defined _GL_HAVE_STATIC_ASSERT1 && !defined static_assert
+# if __cpp_static_assert < 201411 && !defined static_assert
# define static_assert _Static_assert /* C11 requires this #define. */
# endif
#endif
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 1b2d689..57258f9 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -355,10 +355,9 @@ the list of old buffers.")
(add-hook 'after-set-visited-file-name-hook
#'auto-revert-set-visited-file-name)
-(defvar auto-revert--buffers-by-watch-descriptor
- (make-hash-table :test 'equal)
- "A hash table mapping notification descriptors to lists of buffers.
-The buffers use that descriptor for auto-revert notifications.
+(defvar auto-revert--buffer-by-watch-descriptor nil
+ "An association list mapping notification descriptors to buffers.
+The buffer uses that descriptor for auto-revert notifications.
The key is equal to `auto-revert-notify-watch-descriptor' in each
buffer.")
@@ -630,16 +629,12 @@ will use an up-to-date value of `auto-revert-interval'."
(defun auto-revert-notify-rm-watch ()
"Disable file notification for current buffer's associated file."
- (let ((desc auto-revert-notify-watch-descriptor)
- (table auto-revert--buffers-by-watch-descriptor))
- (when desc
- (let ((buffers (delq (current-buffer) (gethash desc table))))
- (if buffers
- (puthash desc buffers table)
- (remhash desc table)))
- (ignore-errors
- (file-notify-rm-watch desc))
- (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t)))
+ (when-let ((desc auto-revert-notify-watch-descriptor))
+ (setq auto-revert--buffer-by-watch-descriptor
+ (assoc-delete-all desc auto-revert--buffer-by-watch-descriptor))
+ (ignore-errors
+ (file-notify-rm-watch desc))
+ (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))
(setq auto-revert-notify-watch-descriptor nil
auto-revert-notify-modified-p nil))
@@ -660,13 +655,10 @@ will use an up-to-date value of `auto-revert-interval'."
(if buffer-file-name '(change attribute-change) '(change))
'auto-revert-notify-handler))))
(when auto-revert-notify-watch-descriptor
- (setq auto-revert-notify-modified-p t)
- (puthash
- auto-revert-notify-watch-descriptor
- (cons (current-buffer)
- (gethash auto-revert-notify-watch-descriptor
- auto-revert--buffers-by-watch-descriptor))
- auto-revert--buffers-by-watch-descriptor)
+ (setq auto-revert-notify-modified-p t
+ auto-revert--buffer-by-watch-descriptor
+ (cons (cons auto-revert-notify-watch-descriptor (current-buffer))
+ auto-revert--buffer-by-watch-descriptor))
(add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t))))
;; If we have file notifications, we want to update the auto-revert buffers
@@ -696,8 +688,8 @@ system.")
(action (nth 1 event))
(file (nth 2 event))
(file1 (nth 3 event)) ;; Target of `renamed'.
- (buffers (gethash descriptor
- auto-revert--buffers-by-watch-descriptor)))
+ (buffer (alist-get descriptor auto-revert--buffer-by-watch-descriptor
+ nil nil #'equal)))
;; Check, that event is meant for us.
(cl-assert descriptor)
;; Since we watch a directory, a file name must be returned.
@@ -706,9 +698,9 @@ system.")
(when auto-revert-debug
(message "auto-revert-notify-handler %S" event))
- (if (eq action 'stopped)
- ;; File notification has stopped. Continue with polling.
- (cl-dolist (buffer buffers)
+ (when (buffer-live-p buffer)
+ (if (eq action 'stopped)
+ ;; File notification has stopped. Continue with polling.
(with-current-buffer buffer
(when (or
;; A buffer associated with a file.
@@ -721,38 +713,35 @@ system.")
(auto-revert-notify-rm-watch)
;; Restart the timer if it wasn't running.
(unless auto-revert-timer
- (auto-revert-set-timer)))))
-
- ;; Loop over all buffers, in order to find the intended one.
- (cl-dolist (buffer buffers)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (when (or
- ;; A buffer associated with a file.
- (and (stringp buffer-file-name)
- (or
- (and (memq
- action '(attribute-changed changed created))
- (string-equal
- (file-name-nondirectory file)
- (file-name-nondirectory buffer-file-name)))
- (and (eq action 'renamed)
- (string-equal
- (file-name-nondirectory file1)
- (file-name-nondirectory buffer-file-name)))))
- ;; A buffer w/o a file, like dired.
- (and (null buffer-file-name)
- (memq action '(created renamed deleted))))
- ;; Mark buffer modified.
- (setq auto-revert-notify-modified-p t)
-
- ;; Revert the buffer now if we're not locked out.
- (unless auto-revert--lockout-timer
- (auto-revert-handler)
- (setq auto-revert--lockout-timer
- (run-with-timer
- auto-revert--lockout-interval nil
- #'auto-revert--end-lockout buffer)))))))))))
+ (auto-revert-set-timer))))
+
+ (with-current-buffer buffer
+ (when (or
+ ;; A buffer associated with a file.
+ (and (stringp buffer-file-name)
+ (or
+ (and (memq
+ action '(attribute-changed changed created))
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory buffer-file-name)))
+ (and (eq action 'renamed)
+ (string-equal
+ (file-name-nondirectory file1)
+ (file-name-nondirectory buffer-file-name)))))
+ ;; A buffer w/o a file, like dired.
+ (and (null buffer-file-name)
+ (memq action '(created renamed deleted))))
+ ;; Mark buffer modified.
+ (setq auto-revert-notify-modified-p t)
+
+ ;; Revert the buffer now if we're not locked out.
+ (unless auto-revert--lockout-timer
+ (auto-revert-handler)
+ (setq auto-revert--lockout-timer
+ (run-with-timer
+ auto-revert--lockout-interval nil
+ #'auto-revert--end-lockout buffer))))))))))
(defun auto-revert--end-lockout (buffer)
"End the lockout period after a notification.
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 4785fb7..423d1e6 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1136,11 +1136,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if penbl "linespoints" "lines")
(if penbl "points" "dots"))))
(if (and pstyle (> pstyle 0))
- (insert " "
+ (insert " ls "
(if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
- " " (int-to-string pstyle))
+ " ps " (int-to-string pstyle))
(if (and lstyle (> lstyle 0))
- (insert " " (int-to-string lstyle)))))))
+ (insert " ls " (int-to-string lstyle)))))))
(calc-graph-view-commands))
(defun calc-graph-zero-x (flag)
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 5f38ee7..bd81d7f 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -822,9 +822,16 @@
(if (setq spfn (get calc-language 'math-func-formatter))
(funcall spfn func a)
- (list 'horiz func calc-function-open
- (math-compose-vector (cdr a) ", " 0)
- calc-function-close))))))))))
+ (let ((args (math-compose-vector (cdr a) ", " 0)))
+ (if (and (member calc-function-open '("(" "[" "{"))
+ (member calc-function-close '(")" "]" "}")))
+ (list 'horiz func
+ (math--comp-bracket
+ (string-to-char calc-function-open)
+ (string-to-char calc-function-close)
+ args))
+ (list 'horiz func calc-function-open
+ args calc-function-close))))))))))))
(defun math-prod-first-term (x)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index f860743..ec864d5 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1168,6 +1168,8 @@ ARGS are command switches passed to PROGRAM.")
("\\.tar\\.bz2\\'" . "tar -cf - %i | bzip2 -c9 > %o")
("\\.tar\\.xz\\'" . "tar -cf - %i | xz -c9 > %o")
("\\.tar\\.zst\\'" . "tar -cf - %i | zstd -19 -o %o")
+ ("\\.tar\\.lz\\'" . "tar -cf - %i | lzip -c9 > %o")
+ ("\\.tar\\.lzo\\'" . "tar -cf - %i | lzop -c9 > %o")
("\\.zip\\'" . "zip %o -r --filesync %i")
("\\.pax\\'" . "pax -wf %o %i"))
"Control the compression shell command for `dired-do-compress-to'.
@@ -1177,7 +1179,7 @@ archive to which you want to compress, and CMD is the
corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
-output file. %i path(s) are relative, while %o is absolute.")
+output file. %i path(s) are relative, while %o is absolute.")
;;;###autoload
(defun dired-do-compress-to ()
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 5f432b8..0d9ba57 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,4 +1,4 @@
-;;; bindat.el --- binary data structure packing and unpacking.
+;;; bindat.el --- binary data structure packing and unpacking. -*-
lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -198,7 +198,7 @@
(defun bindat--unpack-u8 ()
(prog1
- (aref bindat-raw bindat-idx)
+ (aref bindat-raw bindat-idx)
(setq bindat-idx (1+ bindat-idx))))
(defun bindat--unpack-u16 ()
@@ -276,6 +276,8 @@
(t nil)))
(defun bindat--unpack-group (spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (struct last)
(while spec
(let* ((item (car spec))
@@ -287,11 +289,11 @@
data)
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)))))
+ (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)))))
+ (setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)))))
+ (setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
@@ -304,48 +306,51 @@
(cond
((eq type 'eval)
(if field
- (setq data (eval len))
- (eval len)))
+ (setq data (eval len t))
+ (eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
- (setq data (bindat--unpack-group (eval len))))
+ (setq data (bindat--unpack-group (eval len t))))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
- (setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
+ (push (bindat--unpack-group (nthcdr tail item)) data)
(setq index (1+ index)))
(setq data (nreverse data))))
((eq type 'union)
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc)))
+ (and (consp cc) (eval cc t)))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
(t
(setq data (bindat--unpack-item type len vectype)
last data)))
(if data
- (if field
- (setq struct (cons (cons field data) struct))
- (setq struct (append data struct))))))
+ (setq struct (if field
+ (cons (cons field data) struct)
+ (append data struct))))))
struct))
-(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
- "Return structured data according to SPEC for binary data in BINDAT-RAW.
-BINDAT-RAW is a unibyte string or vector.
-Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW."
- (when (multibyte-string-p bindat-raw)
+(defun bindat-unpack (spec raw &optional idx)
+ "Return structured data according to SPEC for binary data in RAW.
+RAW is a unibyte string or vector.
+Optional third arg IDX specifies the starting offset in RAW."
+ (when (multibyte-string-p raw)
(error "String is multibyte"))
- (unless bindat-idx (setq bindat-idx 0))
- (bindat--unpack-group spec))
+ (let ((bindat-idx (or idx 0))
+ (bindat-raw raw))
+ (bindat--unpack-group spec)))
(defun bindat-get-field (struct &rest field)
"In structured data STRUCT, return value of field named FIELD.
@@ -373,6 +378,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(ip . 4)))
(defun bindat--length-group (struct spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (last)
(while spec
(let* ((item (car spec))
@@ -383,32 +390,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)))))
+ (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)))))
+ (setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)))))
+ (setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
- (setq len (apply 'bindat-get-field struct len)))
+ (setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(while (eq type 'vec)
- (let ((vlen 1))
- (if (consp vectype)
- (setq len (* len (nth 1 vectype))
- type (nth 2 vectype))
- (setq type (or vectype 'u8)
- vectype nil))))
+ (if (consp vectype)
+ (setq len (* len (nth 1 vectype))
+ type (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil)))
(cond
((eq type 'eval)
(if field
- (setq struct (cons (cons field (eval len)) struct))
- (eval len)))
+ (setq struct (cons (cons field (eval len t)) struct))
+ (eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
@@ -416,7 +422,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--length-group
- (if field (bindat-get-field struct field) struct) (eval len)))
+ (if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
@@ -425,13 +431,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc)))
+ (and (consp cc) (eval cc t)))
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
@@ -536,6 +544,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (last)
(while spec
(let* ((item (car spec))
@@ -546,11 +556,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)))))
+ (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)))))
+ (setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)))))
+ (setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
@@ -563,8 +573,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(cond
((eq type 'eval)
(if field
- (setq struct (cons (cons field (eval len)) struct))
- (eval len)))
+ (setq struct (cons (cons field (eval len t)) struct))
+ (eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
@@ -572,7 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--pack-group
- (if field (bindat-get-field struct field) struct) (eval len)))
+ (if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
@@ -581,13 +591,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc)))
+ (and (consp cc) (eval cc t)))
(progn
(bindat--pack-group struct (cdr case))
(setq cases nil))))))
@@ -596,19 +608,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-item last type len vectype)
))))))
-(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
+(defun bindat-pack (spec struct &optional raw idx)
"Return binary data packed according to SPEC for structured data STRUCT.
-Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
+Optional third arg RAW is a pre-allocated unibyte string or vector to
pack into.
-Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
- (when (multibyte-string-p bindat-raw)
+Optional fourth arg IDX is the starting offset into RAW."
+ (when (multibyte-string-p raw)
(error "Pre-allocated string is multibyte"))
- (let ((no-return bindat-raw))
- (unless bindat-idx (setq bindat-idx 0))
- (unless bindat-raw
- (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct))
0)))
+ (let* ((bindat-idx (or idx 0))
+ (bindat-raw
+ (or raw
+ (make-string (+ bindat-idx (bindat-length spec struct)) 0))))
(bindat--pack-group struct spec)
- (if no-return nil bindat-raw)))
+ (if raw nil bindat-raw)))
;; Misc. format conversions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 0f8dd5a..88f362d 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -232,8 +232,11 @@ The return value is undefined.
#'(lambda (x)
(let ((f (cdr (assq (car x) macro-declarations-alist))))
(if f (apply (car f) name arglist (cdr x))
- (message "Warning: Unknown macro property %S in %S"
- (car x) name))))
+ (macroexp--warn-and-return
+ (format-message
+ "Unknown macro property %S in %S"
+ (car x) name)
+ nil))))
decls)))
;; Refresh font-lock if this is a new macro, or it is an
;; existing macro whose 'no-font-lock-keyword declaration
@@ -301,9 +304,12 @@ The return value is undefined.
(cdr body)
body)))
nil)
- (t (message "Warning: Unknown defun property `%S' in %S"
- (car x) name)))))
- decls))
+ (t
+ (macroexp--warn-and-return
+ (format-message "Unknown defun property `%S' in %S"
+ (car x) name)
+ nil)))))
+ decls))
(def (list 'defalias
(list 'quote name)
(list 'function
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 76638ec..9722792 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2362,7 +2362,9 @@ Code:, and others referenced in the style guide."
(checkdoc-create-error
(format "The footer should be: (provide '%s)\\n;;; %s%s ends
here"
fn fn fe)
- (1- (point-max)) (point-max)))))
+ ;; The buffer may be empty.
+ (max (point-min) (1- (point-max)))
+ (point-max)))))
err))
;; The below checks will not return errors if the user says NO
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index eb3193c..e106815 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,4 +1,4 @@
-;;; crm.el --- read multiple strings with completion
+;;; crm.el --- read multiple strings with completion -*- lexical-binding: t;
-*-
;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 4252842..54528b2 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,4 +1,4 @@
-;;; derived.el --- allow inheritance of major modes
+;;; derived.el --- allow inheritance of major modes -*- lexical-binding: t;
-*-
;; (formerly mode-clone.el)
;; Copyright (C) 1993-1994, 1999, 2001-2021 Free Software Foundation,
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index edf4d34..e65f424 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,4 +1,4 @@
-;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
+;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*-
lexical-binding: t; -*-
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 93f780e..6db1bbb 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,4 +1,4 @@
-;;; generic.el --- defining simple major modes with comment and font-lock
+;;; generic.el --- defining simple major modes with comment and font-lock -*-
lexical-binding: t; -*-
;;
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;;
@@ -245,7 +245,6 @@ Some generic modes are defined in `generic-x.el'."
"Set up comment functionality for generic mode."
(let ((chars nil)
(comstyles)
- (comstyle "")
(comment-start nil))
;; Go through all the comments.
@@ -269,14 +268,16 @@ Some generic modes are defined in `generic-x.el'."
;; Store the relevant info but don't update yet.
(push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
(push (cons c1 (concat (cdr (assoc c1 chars))
- (concat "2" comstyle))) chars)))
+ (concat "2" comstyle)))
+ chars)))
(if (= (length end) 1)
(modify-syntax-entry (aref end 0)
(concat ">" comstyle) st)
(let ((c0 (aref end 0)) (c1 (aref end 1)))
;; Store the relevant info but don't update yet.
(push (cons c0 (concat (cdr (assoc c0 chars))
- (concat "3" comstyle))) chars)
+ (concat "3" comstyle)))
+ chars)
(push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
;; Process the chars that were part of a 2-char comment marker
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 737f3ec..a5f21a5 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,4 +1,4 @@
-;;; helper.el --- utility help package supporting help in electric modes
+;;; helper.el --- utility help package supporting help in electric modes -*-
lexical-binding: t; -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -39,20 +39,19 @@
;; keymap either.
-(defvar Helper-help-map nil)
-(if Helper-help-map
- nil
- (setq Helper-help-map (make-keymap))
- ;(fillarray Helper-help-map 'undefined)
- (define-key Helper-help-map "m" 'Helper-describe-mode)
- (define-key Helper-help-map "b" 'Helper-describe-bindings)
- (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
- (define-key Helper-help-map "k" 'Helper-describe-key)
- ;(define-key Helper-help-map "f" 'Helper-describe-function)
- ;(define-key Helper-help-map "v" 'Helper-describe-variable)
- (define-key Helper-help-map "?" 'Helper-help-options)
- (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
- (fset 'Helper-help-map Helper-help-map))
+(defvar Helper-help-map
+ (let ((map (make-sparse-keymap)))
+ ;(fillarray map 'undefined)
+ (define-key map "m" 'Helper-describe-mode)
+ (define-key map "b" 'Helper-describe-bindings)
+ (define-key map "c" 'Helper-describe-key-briefly)
+ (define-key map "k" 'Helper-describe-key)
+ ;(define-key map "f" 'Helper-describe-function)
+ ;(define-key map "v" 'Helper-describe-variable)
+ (define-key map "?" 'Helper-help-options)
+ (define-key map (char-to-string help-char) 'Helper-help-options)
+ (fset 'Helper-help-map map)
+ map))
(defun Helper-help-scroller ()
(let ((blurb (or (and (boundp 'Helper-return-blurb)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 8780c5d..3918fa0 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -201,41 +201,53 @@
(defun lisp--el-non-funcall-position-p (pos)
"Heuristically determine whether POS is an evaluated position."
+ (declare (obsolete lisp--el-funcall-position-p "28.1"))
+ (not (lisp--el-funcall-position-p pos)))
+
+(defun lisp--el-funcall-position-p (pos)
+ "Heuristically determine whether POS is an evaluated position."
(save-match-data
(save-excursion
(ignore-errors
(goto-char pos)
;; '(lambda ..) is not a funcall position, but #'(lambda ...) is.
- (or (and (eql (char-before) ?\')
- (not (eql (char-before (1- (point))) ?#)))
- (let* ((ppss (syntax-ppss))
- (paren-posns (nth 9 ppss))
- (parent
- (when paren-posns
- (goto-char (car (last paren-posns))) ;(up-list -1)
- (cond
- ((ignore-errors
- (and (eql (char-after) ?\()
- (when (cdr paren-posns)
- (goto-char (car (last paren-posns 2)))
- (looking-at "(\\_<let\\*?\\_>"))))
- (goto-char (match-end 0))
- 'let)
- ((looking-at
- (rx "("
- (group-n 1 (+ (or (syntax w) (syntax _))))
- symbol-end))
- (prog1 (intern-soft (match-string-no-properties 1))
- (goto-char (match-end 1))))))))
- (or (eq parent 'declare)
- (and (eq parent 'let)
- (progn
- (forward-sexp 1)
- (< pos (point))))
- (and (eq parent 'condition-case)
- (progn
- (forward-sexp 2)
- (< (point) pos))))))))))
+ (if (eql (char-before) ?\')
+ (eql (char-before (1- (point))) ?#)
+ (let* ((ppss (syntax-ppss))
+ (paren-posns (nth 9 ppss))
+ (parent
+ (when paren-posns
+ (goto-char (car (last paren-posns))) ;(up-list -1)
+ (cond
+ ((ignore-errors
+ (and (eql (char-after) ?\()
+ (when (cdr paren-posns)
+ (goto-char (car (last paren-posns 2)))
+ (looking-at "(\\_<let\\*?\\_>"))))
+ (goto-char (match-end 0))
+ 'let)
+ ((looking-at
+ (rx "("
+ (group-n 1 (+ (or (syntax w) (syntax _))))
+ symbol-end))
+ (prog1 (intern-soft (match-string-no-properties 1))
+ (goto-char (match-end 1))))))))
+ (pcase parent
+ ('declare nil)
+ ('let
+ (forward-sexp 1)
+ (>= pos (point)))
+ ('condition-case
+ ;; If (cdr paren-posns), then we're in the BODY
+ ;; of HANDLERS.
+ (or (cdr paren-posns)
+ (progn
+ (forward-sexp 1)
+ ;; If we're in the second form, then we're in
+ ;; a funcall position.
+ (< (point) pos (progn (forward-sexp 1)
+ (point))))))
+ (_ t))))))))
(defun lisp--el-match-keyword (limit)
;; FIXME: Move to elisp-mode.el.
@@ -245,11 +257,9 @@
(concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
limit t)
(let ((sym (intern-soft (match-string 1))))
- (when (or (special-form-p sym)
- (and (macrop sym)
- (not (get sym 'no-font-lock-keyword))
- (not (lisp--el-non-funcall-position-p
- (match-beginning 0)))))
+ (when (and (or (special-form-p sym) (macrop sym))
+ (not (get sym 'no-font-lock-keyword))
+ (lisp--el-funcall-position-p (match-beginning 0)))
(throw 'found t))))))
(defmacro let-when-compile (bindings &rest body)
@@ -765,6 +775,7 @@ or to switch back to an existing one."
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
"\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ (setq-local comment-end "|#")
(setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 3784497..e842222 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -127,7 +127,7 @@ and also to avoid outputting the warning during normal
execution."
(cond
((null msg) form)
((macroexp--compiling-p)
- (if (gethash form macroexp--warned)
+ (if (and (consp form) (gethash form macroexp--warned))
;; Already wrapped this exp with a warning: avoid inf-looping
;; where we keep adding the same warning onto `form' because
;; macroexpand-all gets right back to macroexpanding `form'.
@@ -138,9 +138,10 @@ and also to avoid outputting the warning during normal
execution."
,form)))
(t
(unless compile-only
- (message "%s%s" (if (stringp load-file-name)
- (concat (file-relative-name load-file-name) ": ")
- "")
+ (message "%sWarning: %s"
+ (if (stringp load-file-name)
+ (concat (file-relative-name load-file-name) ": ")
+ "")
msg))
form))))
@@ -180,8 +181,9 @@ and also to avoid outputting the warning during normal
execution."
(defun macroexp-macroexpand (form env)
"Like `macroexpand' but checking obsolescence."
- (let ((new-form
- (macroexpand form env)))
+ (let* ((macroexpand-all-environment env)
+ (new-form
+ (macroexpand form env)))
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
@@ -239,9 +241,22 @@ Assumes the caller has bound
`macroexpand-all-environment'."
form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form))
+ ;; If the byte-optimizer is loaded, try to unfold this,
+ ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the
optimizer
+ ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
+ ;; creation of a closure, thus resulting in much better code.
+ (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda))
+ 'macroexp--not-unfolded
+ ;; Don't unfold if byte-opt is not yet loaded.
+ (byte-compile-unfold-lambda form))))
+ (if (or (eq newform 'macroexp--not-unfolded)
+ (eq newform form))
+ ;; Unfolding failed for some reason, avoid infinite recursion.
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form)
+ (macroexp--expand-all newform))))
+
;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte
;; compiler has traditionally handled these functions specially
@@ -255,17 +270,21 @@ Assumes the caller has bound
`macroexpand-all-environment'."
(macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,f . ,args))))
+ (macroexp--expand-all `(,fun #',f . ,args))))
;; Second arg is a function:
(`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
(macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
- (`(funcall #',(and f (pred symbolp)) . ,args)
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro.
- (macroexp--expand-all `(,f . ,args)))
+ (macroexp--expand-all `(,fun ,arg1 #',f . ,args))))
+ (`(funcall ,exp . ,args)
+ (let ((eexp (macroexp--expand-all exp))
+ (eargs (macroexp--all-forms args)))
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro, or to unfold it.
+ (pcase eexp
+ (`#',f (macroexp--expand-all `(,f . ,eargs)))
+ (_ `(funcall ,eexp . ,eargs)))))
(`(,func . ,_)
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
@@ -358,12 +377,12 @@ Never returns an empty list."
(t
`(cond (,test ,@(macroexp-unprogn then))
(,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
- (t ,@(nthcdr 3 else))))))
+ ,@(let ((def (nthcdr 3 else))) (if def `((t ,@def))))))))
((eq (car-safe else) 'cond)
`(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
;; Invert the test if that lets us reduce the depth of the tree.
((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
- (t `(if ,test ,then ,@(macroexp-unprogn else)))))
+ (t `(if ,test ,then ,@(if else (macroexp-unprogn else))))))
(defmacro macroexp-let2 (test sym exp &rest body)
"Evaluate BODY with SYM bound to an expression for EXP's value.
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 8a0853c..b723643 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,4 +1,4 @@
-;;; package-x.el --- Package extras
+;;; package-x.el --- Package extras -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index bfd577c..cf129c4 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -683,11 +683,6 @@ A and B can be one of:
;; and catch at least the easy cases such as (bug#14773).
(not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
- ;; In case UPAT is of the form (pred (not PRED))
- ((and (eq 'pred (car upat)) (eq 'not (car-safe (cadr upat))))
- (let* ((test (cadr (cadr upat)))
- (res (pcase--split-pred vars `(pred ,test) pat)))
- (cons (cdr res) (car res))))
;; In case PAT is of the form (pred (not PRED))
((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
(let* ((test (cadr (cadr pat)))
@@ -696,19 +691,34 @@ A and B can be one of:
((eq x :pcase--fail) :pcase--succeed)))))
(cons (funcall reverse (car res))
(funcall reverse (cdr res)))))
- ((and (eq 'pred (car upat))
- (let ((otherpred
- (cond ((eq 'pred (car-safe pat)) (cadr pat))
- ((not (eq 'quote (car-safe pat))) nil)
- ((consp (cadr pat)) #'consp)
- ((stringp (cadr pat)) #'stringp)
- ((vectorp (cadr pat)) #'vectorp)
- ((byte-code-function-p (cadr pat))
- #'byte-code-function-p))))
- (pcase--mutually-exclusive-p (cadr upat) otherpred)))
+ ;; All the rest below presumes UPAT is of the form (pred ...).
+ ((not (eq 'pred (car upat))) nil)
+ ;; In case UPAT is of the form (pred (not PRED))
+ ((eq 'not (car-safe (cadr upat)))
+ (let* ((test (cadr (cadr upat)))
+ (res (pcase--split-pred vars `(pred ,test) pat)))
+ (cons (cdr res) (car res))))
+ ((let ((otherpred
+ (cond ((eq 'pred (car-safe pat)) (cadr pat))
+ ((not (eq 'quote (car-safe pat))) nil)
+ ((consp (cadr pat)) #'consp)
+ ((stringp (cadr pat)) #'stringp)
+ ((vectorp (cadr pat)) #'vectorp)
+ ((byte-code-function-p (cadr pat))
+ #'byte-code-function-p))))
+ (pcase--mutually-exclusive-p (cadr upat) otherpred))
'(:pcase--fail . nil))
- ((and (eq 'pred (car upat))
- (eq 'quote (car-safe pat))
+ ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
+ ;; try and preserve the info we get from that memq test.
+ ((and (eq 'pcase--flip (car-safe (cadr upat)))
+ (memq (cadr (cadr upat)) '(memq member memql))
+ (eq 'quote (car-safe (nth 2 (cadr upat))))
+ (eq 'quote (car-safe pat)))
+ (let ((set (cadr (nth 2 (cadr upat)))))
+ (if (member (cadr pat) set)
+ '(nil . :pcase--fail)
+ '(:pcase--fail . nil))))
+ ((and (eq 'quote (car-safe pat))
(symbolp (cadr upat))
(or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
(get (cadr upat) 'side-effect-free)
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 38b202f..527af1d 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,4 +1,4 @@
-;;; regi.el --- REGular expression Interpreting engine
+;;; regi.el --- REGular expression Interpreting engine -*- lexical-binding:
t; -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@@ -153,7 +153,7 @@ useful information:
;; set up the narrowed region
(and start
end
- (let* ((tstart start)
+ (let* (;; (tstart start)
(start (min start end))
(end (max start end)))
(narrow-to-region
@@ -206,30 +206,33 @@ useful information:
;; if the line matched, package up the argument list and
;; funcall the FUNC
(if match-p
- (let* ((curline (buffer-substring
- (regi-pos 'bol)
- (regi-pos 'eol)))
- (curframe current-frame)
- (curentry entry)
- (result (eval func))
- (step (or (cdr (assq 'step result)) 1))
- )
- ;; changing frame on the fly?
- (if (assq 'frame result)
- (setq working-frame (cdr (assq 'frame result))))
-
- ;; continue processing current frame?
- (if (memq 'continue result)
- (setq current-frame (cdr current-frame))
- (forward-line step)
- (setq current-frame working-frame))
-
- ;; abort current frame?
- (if (memq 'abort result)
- (progn
- (setq donep t)
- (throw 'regi-throw-top t)))
- ) ; end-let
+ (with-suppressed-warnings
+ ((lexical curframe curentry curline))
+ (defvar curframe) (defvar curentry) (defvar curline)
+ (let* ((curline (buffer-substring
+ (regi-pos 'bol)
+ (regi-pos 'eol)))
+ (curframe current-frame)
+ (curentry entry)
+ (result (eval func))
+ (step (or (cdr (assq 'step result)) 1))
+ )
+ ;; changing frame on the fly?
+ (if (assq 'frame result)
+ (setq working-frame (cdr (assq 'frame result))))
+
+ ;; continue processing current frame?
+ (if (memq 'continue result)
+ (setq current-frame (cdr current-frame))
+ (forward-line step)
+ (setq current-frame working-frame))
+
+ ;; abort current frame?
+ (if (memq 'abort result)
+ (progn
+ (setq donep t)
+ (throw 'regi-throw-top t)))
+ )) ; end-let
;; else if no match occurred, then process the next
;; frame-entry on the current line
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 168e5e4..c1d0594 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,4 +1,4 @@
-;;; shadow.el --- locate Emacs Lisp file shadowings
+;;; shadow.el --- locate Emacs Lisp file shadowings -*- lexical-binding: t;
-*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -58,8 +58,7 @@
(defcustom load-path-shadows-compare-text nil
"If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
- :type 'boolean
- :group 'lisp-shadow)
+ :type 'boolean)
(defun load-path-shadows-find (&optional path)
"Return a list of Emacs Lisp files that create shadows.
@@ -78,8 +77,7 @@ See the documentation for `list-load-path-shadows' for
further information."
dir-case-insensitive ; `file-name-case-insensitive-p' of
dir.
curr-files ; This dir's Emacs Lisp files.
orig-dir ; Where the file was first seen.
- files-seen-this-dir ; Files seen so far in this dir.
- file) ; The current file.
+ files-seen-this-dir) ; Files seen so far in this dir.
(dolist (pp (or path load-path))
(setq dir (directory-file-name (file-truename (or pp "."))))
(if (member dir true-names)
@@ -109,7 +107,7 @@ See the documentation for `list-load-path-shadows' for
further information."
(dolist (file curr-files)
- (if (string-match "\\.gz$" file)
+ (if (string-match "\\.gz\\'" file)
(setq file (substring file 0 -3)))
(setq file (substring
file 0 (if (string= (substring file -1) "c") -4 -3)))
@@ -125,9 +123,13 @@ See the documentation for `list-load-path-shadows' for
further information."
;; XXX.elc (or vice-versa) when they are in the same directory.
(setq files-seen-this-dir (cons file files-seen-this-dir))
- (if (setq orig-dir (assoc file files
- (when dir-case-insensitive
- (lambda (f1 f2) (eq (compare-strings
f1 nil nil f2 nil nil t) t)))))
+ (if (setq orig-dir
+ (assoc file files
+ (when dir-case-insensitive
+ (lambda (f1 f2)
+ (eq (compare-strings f1 nil nil
+ f2 nil nil t)
+ t)))))
;; This file was seen before, we have a shadowing.
;; Report it unless the files are identical.
(let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))
@@ -142,7 +144,7 @@ See the documentation for `list-load-path-shadows' for
further information."
(append shadows (list base1 base2)))))
;; Not seen before, add it to the list of seen files.
- (setq files (cons (cons file dir) files)))))))
+ (push (cons file dir) files))))))
;; Return the list of shadowings.
shadows))
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 7de9d54..fb9cd8f 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,4 +1,4 @@
-;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
+;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*-
lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -19,21 +19,14 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-(require 'testcover)
+;;; Commentary:
-(defvar ses-initial-global-parameters)
-(defvar ses-mode-map)
+;; FIXME: Convert to ERT and move to `test/'?
-(declare-function ses-set-curcell "ses")
-(declare-function ses-update-cells "ses")
-(declare-function ses-load "ses")
-(declare-function ses-vector-delete "ses")
-(declare-function ses-create-header-string "ses")
-(declare-function ses-read-cell "ses")
-(declare-function ses-read-symbol "ses")
-(declare-function ses-command-hook "ses")
-(declare-function ses-jump "ses")
+;;; Code:
+(require 'testcover)
+(require 'ses)
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
@@ -652,6 +645,7 @@ spreadsheet files with invalid formatting."
(testcover-start "ses.el" t))
(require 'unsafep)) ;In case user has safe-functions = t!
+(defvar ses--curcell-overlay)
;;;#########################################################################
(defun ses-exercise ()
@@ -674,8 +668,8 @@ spreadsheet files with invalid formatting."
(ses-load))
;;ses-vector-delete is always called from buffer-undo-list with the same
;;symbol as argument. We'll give it a different one here.
- (let ((x [1 2 3]))
- (ses-vector-delete 'x 0 0))
+ (dlet ((tcover-ses--x [1 2 3]))
+ (ses-vector-delete 'tcover-ses--x 0 0))
;;ses-create-header-string behaves differently in a non-window environment
;;but we always test under windows.
(let ((window-system (not window-system)))
@@ -704,7 +698,7 @@ spreadsheet files with invalid formatting."
(ses-mode)))))
;;Test error-handling in command hook, outside a macro.
;;This will ring the bell.
- (let (curcell-overlay)
+ (let (ses--curcell-overlay)
(ses-command-hook))
;;Due to use of run-with-timer, ses-command-hook sometimes gets called
;;after we switch to another buffer.
@@ -720,4 +714,4 @@ spreadsheet files with invalid formatting."
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
-;; testcover-ses.el ends here.
+;;; testcover-ses.el ends here.
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index f46d9c7..d52a6c7 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,4 +1,4 @@
-;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
+;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*-
lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -129,15 +129,16 @@ in the parse.")
(put x 'safe-function t))
;;;###autoload
-(defun unsafep (form &optional unsafep-vars)
+(defun unsafep (form &optional vars)
"Return nil if evaluating FORM couldn't possibly do any harm.
Otherwise result is a reason why FORM is unsafe.
-UNSAFEP-VARS is a list of symbols with local bindings."
+VARS is a list of symbols with local bindings like `unsafep-vars'."
(catch 'unsafep
(if (or (eq safe-functions t) ;User turned off safety-checking
(atom form)) ;Atoms are never unsafe
(throw 'unsafep nil))
- (let* ((fun (car form))
+ (let* ((unsafep-vars vars)
+ (fun (car form))
(reason (unsafep-function fun))
arg)
(cond
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index 9c1d859..13f5c03 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,4 +1,4 @@
-;;; ezimage --- Generalized Image management
+;;; ezimage.el --- Generalized Image management -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
diff --git a/lisp/faces.el b/lisp/faces.el
index d654b1f..90f11bb 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2683,11 +2683,20 @@ the same as `window-divider' face."
(defface internal-border
'((t nil))
- "Basic face for the internal border."
+ "Basic face for the internal border.
+For the internal border of child frames see `child-frame-border'."
:version "26.1"
:group 'frames
:group 'basic-faces)
+(defface child-frame-border
+ '((t nil))
+ "Basic face for the internal border of child frames.
+For the internal border of non-child frames see `internal-border'."
+ :version "28.1"
+ :group 'frames
+ :group 'basic-faces)
+
(defface minibuffer-prompt
'((((background dark)) :foreground "cyan")
;; Don't use blue because many users of the MS-DOS port customize
diff --git a/lisp/files.el b/lisp/files.el
index d2e5413..77e3a3a 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4062,13 +4062,13 @@ Return the new variables list."
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
(progn
- (setq alist (delq subdirs alist))
+ (setq alist (remq subdirs alist))
(cdr-safe subdirs))
;; TODO someone might want to extend this to allow
;; integer values for subdir, where N means
;; variables apply to this directory and N levels
;; below it (0 == nil).
- (equal root default-directory))
+ (equal root (expand-file-name default-directory)))
(setq variables (dir-locals-collect-mode-variables
alist variables))))))))
(error
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el
index 5866b30..bb2e97d 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -1,4 +1,4 @@
-;;; find-cmd.el --- Build a valid find(1) command with sexps
+;;; find-cmd.el --- Build a valid find(1) command with sexps -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -28,7 +28,7 @@
;; (find-cmd '(prune (name ".svn" ".git" ".CVS"))
;; '(and (or (name "*.pl" "*.pm" "*.t")
;; (mtime "+1"))
-;; (fstype "nfs" "ufs"))))
+;; (fstype "nfs" "ufs")))
;; will become (un-wrapped):
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index 656edf2..adb52d7 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -1,4 +1,4 @@
-;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow
control
+;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow
control -*- lexical-binding: t -*-
;; Copyright (C) 1990-1991, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -64,12 +64,11 @@ With arg, enable flow control mode if arg is positive,
otherwise disable."
(progn
;; Turn flow control off, and stop exchanging chars.
(set-input-mode t nil (nth 2 (current-input-mode)))
- (if keyboard-translate-table
- (progn
- (aset keyboard-translate-table flow-control-c-s-replacement nil)
- (aset keyboard-translate-table ?\^s nil)
- (aset keyboard-translate-table flow-control-c-q-replacement nil)
- (aset keyboard-translate-table ?\^q nil))))
+ (when keyboard-translate-table
+ (aset keyboard-translate-table flow-control-c-s-replacement nil)
+ (aset keyboard-translate-table ?\^s nil)
+ (aset keyboard-translate-table flow-control-c-q-replacement nil)
+ (aset keyboard-translate-table ?\^q nil)))
;; Turn flow control on.
;; Tell emacs to pass C-s and C-q to OS.
(set-input-mode nil t (nth 2 (current-input-mode)))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index f3ea22a..4c6e118 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1,4 +1,4 @@
-;;; generic-x.el --- A collection of generic modes
+;;; generic-x.el --- A collection of generic modes -*- lexical-binding: t -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
@@ -121,14 +121,12 @@
"If non-nil, add a hook to enter `default-generic-mode' automatically.
This is done if the first few lines of a file in fundamental mode
start with a hash comment character."
- :group 'generic-x
:type 'boolean)
(defcustom generic-lines-to-scan 3
"Number of lines that `generic-mode-find-file-hook' looks at.
Relevant when deciding whether to enter Default-Generic mode automatically.
This variable should be set to a small positive number."
- :group 'generic-x
:type 'integer)
(defcustom generic-find-file-regexp "^#"
@@ -137,7 +135,6 @@ Files in fundamental mode whose first few lines contain a
match
for this regexp, should be put into Default-Generic mode instead.
The number of lines tested for the matches is specified by the
value of the variable `generic-lines-to-scan', which see."
- :group 'generic-x
:type 'regexp)
(defcustom generic-ignore-files-regexp "[Tt][Aa][Gg][Ss]\\'"
@@ -146,7 +143,6 @@ Files whose names match this regular expression should not
be put
into Default-Generic mode, even if they have lines which match
the regexp in `generic-find-file-regexp'. If the value is nil,
`generic-mode-find-file-hook' does not check the file names."
- :group 'generic-x
:type '(choice (const :tag "Don't check file names" nil) regexp))
;; This generic mode is always defined
@@ -249,7 +245,6 @@ This hook will be installed if the variable
Each entry in the list should be a symbol. If you set this variable
directly, without using customize, you must reload generic-x to put
your changes into effect."
- :group 'generic-x
:type (let (list)
(dolist (mode
(sort (append generic-default-modes
@@ -365,7 +360,8 @@ your changes into effect."
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
- '(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face))
+ '(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face)
+ ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
"Generic mode for HOSTS files."))
@@ -415,7 +411,8 @@ like an INI file. You can add this hook to
`find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
-(defalias 'generic-mode-ini-file-find-file-hook
'ini-generic-mode-find-file-hook))
+(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
+ 'ini-generic-mode-find-file-hook "28.1"))
;;; Windows REG files
;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
@@ -1296,19 +1293,16 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; here manually instead
(defun generic-rul-mode-setup-function ()
- (make-local-variable 'parse-sexp-ignore-comments)
- (make-local-variable 'comment-start)
(make-local-variable 'comment-start-skip)
- (make-local-variable 'comment-end)
(setq imenu-generic-expression
- '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1))
- parse-sexp-ignore-comments t
- comment-end "*/"
- comment-start "/*"
-;;; comment-end ""
-;;; comment-start "//"
-;;; comment-start-skip ""
- )
+ '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)))
+ (setq-local parse-sexp-ignore-comments t
+ comment-end "*/"
+ comment-start "/*"
+;;; comment-end ""
+;;; comment-start "//"
+;;; comment-start-skip ""
+ )
;; (set-syntax-table rul-generic-mode-syntax-table)
(setq-local font-lock-syntax-table rul-generic-mode-syntax-table))
@@ -1458,7 +1452,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
":"
;; Password, UID and GID
(mapconcat
- 'identity
+ #'identity
(make-list 3 "\\([^:]+\\)")
":")
":"
@@ -1490,41 +1484,104 @@ like an INI file. You can add this hook to
`find-file-hook'."
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
+ "ados"
"affs"
+ "anon_inodefs"
+ "atfs"
+ "audiofs"
"autofs"
+ "bdev"
+ "befs"
+ "bfs"
+ "binfmt_misc"
+ "btrfs"
+ "cd9660"
+ "cfs"
+ "cgroup"
+ "cifs"
"coda"
"coherent"
+ "configfs"
+ "cpuset"
"cramfs"
+ "devfs"
"devpts"
+ "devtmpfs"
+ "e2compr"
"efs"
"ext2"
+ "ext2fs"
"ext3"
"ext4"
+ "fdesc"
+ "ffs"
+ "filecore"
+ "fuse"
+ "fuseblk"
+ "fusectl"
"hfs"
"hpfs"
+ "hugetlbfs"
"iso9660"
+ "jffs"
+ "jffs2"
"jfs"
+ "kernfs"
+ "lfs"
+ "linprocfs"
+ "mfs"
"minix"
+ "mqueue"
"msdos"
"ncpfs"
"nfs"
+ "nfsd"
+ "nilfs2"
+ "none"
"ntfs"
+ "null"
+ "nwfs"
+ "overlay"
+ "ovlfs"
+ "pipefs"
+ "portal"
"proc"
+ "procfs"
+ "pstore"
+ "ptyfs"
"qnx4"
+ "ramfs"
"reiserfs"
"romfs"
+ "securityfs"
+ "shm"
"smbfs"
- "cifs"
- "usbdevfs"
- "sysv"
+ "sockfs"
+ "squashfs"
+ "sshfs"
+ "std"
+ "subfs"
"sysfs"
+ "sysv"
+ "tcfs"
"tmpfs"
"udf"
"ufs"
+ "umap"
"umsdos"
+ "union"
+ "usbdevfs"
+ "usbfs"
+ "userfs"
"vfat"
+ "vs3fs"
+ "vxfs"
+ "wrapfs"
+ "wvfs"
+ "xenfs"
"xenix"
"xfs"
+ "zisofs"
"swap"
"auto"
"ignore")
@@ -1575,8 +1632,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
(((class color) (min-colors 88)) (:background "red1"))
(((class color)) (:background "red"))
(t (:weight bold)))
- "Font Lock mode face used to highlight TABs."
- :group 'generic-x)
+ "Font Lock mode face used to highlight TABs.")
(defface show-tabs-space
'((((class grayscale) (background light)) (:background "DimGray" :weight
bold))
@@ -1584,8 +1640,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
(((class color) (min-colors 88)) (:background "yellow1"))
(((class color)) (:background "yellow"))
(t (:weight bold)))
- "Font Lock mode face used to highlight spaces."
- :group 'generic-x)
+ "Font Lock mode face used to highlight spaces.")
(define-generic-mode show-tabs-generic-mode
nil ;; no comment char
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 6866230..56640ea 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1789,7 +1789,6 @@ variables. Returns the first non-nil value found."
. gnus-agent-enable-expiration)
(agent-predicate . gnus-agent-predicate)))))))
-;; FIXME: This looks an awful lot like `gnus-agent-retrieve-headers'.
(defun gnus-agent-fetch-headers (group)
"Fetch interesting headers into the agent. The group's overview
file will be updated to include the headers while a list of available
@@ -1811,9 +1810,10 @@ article numbers will be returned."
(cdr active))))
(gnus-uncompress-range (gnus-active group)))
(gnus-list-of-unread-articles group)))
+ (gnus-decode-encoded-word-function 'identity)
+ (gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
- (file-name-coding-system nnmail-pathname-coding-system)
- headers fetched-headers)
+ (file-name-coding-system nnmail-pathname-coding-system))
(unless fetch-all
;; Add articles with marks to the list of article headers we want to
@@ -1824,7 +1824,7 @@ article numbers will be returned."
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
(setq articles (gnus-range-add articles (cdr arts)))))
- (setq articles (sort (gnus-uncompress-range articles) '<)))
+ (setq articles (sort (gnus-uncompress-sequence articles) '<)))
;; At this point, I have the list of articles to consider for
;; fetching. This is the list that I'll return to my caller. Some
@@ -1867,52 +1867,38 @@ article numbers will be returned."
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
(gnus-compress-sequence articles t)))
- ;; Parse known headers from FILE.
- (if (file-exists-p file)
- (with-current-buffer gnus-agent-overview-buffer
- (erase-buffer)
- (let ((nnheader-file-coding-system
- gnus-agent-file-coding-system))
- (nnheader-insert-nov-file file (car articles))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer)
- (setq headers
- (gnus-get-newsgroup-headers-xover
- articles nil (buffer-local-value
- 'gnus-newsgroup-dependencies
- gnus-summary-buffer)
- gnus-newsgroup-name)))))
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t)))
-
- ;; Fetch our new headers.
- (gnus-message 8 "Fetching headers for %s..." group)
- (if articles
- (setq fetched-headers (gnus-fetch-headers articles)))
-
- ;; Merge two sets of headers.
- (setq headers
- (if (and headers fetched-headers)
- (delete-dups
- (sort (append headers (copy-sequence fetched-headers))
- (lambda (l r)
- (< (mail-header-number l)
- (mail-header-number r)))))
- (or headers fetched-headers)))
-
- ;; Save the new set of headers to FILE.
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (with-current-buffer gnus-agent-overview-buffer
- (goto-char (point-max))
- (mapc #'nnheader-insert-nov fetched-headers)
- (sort-numeric-fields 1 (point-min) (point-max))
- (gnus-agent-check-overview-buffer)
- (write-region (point-min) (point-max) file nil 'silent))
- (gnus-agent-update-view-total-fetched-for group t)
- (gnus-agent-save-alist group articles nil)))
- headers))
+ (with-current-buffer nntp-server-buffer
+ (if articles
+ (progn
+ (gnus-message 8 "Fetching headers for %s..." group)
+
+ ;; Fetch them.
+ (gnus-make-directory (nnheader-translate-file-chars
+ (file-name-directory file) t))
+
+ (unless (eq 'nov (gnus-retrieve-headers articles group))
+ (nnvirtual-convert-headers))
+ (gnus-agent-check-overview-buffer)
+ ;; Move these headers to the overview buffer so that
+ ;; gnus-agent-braid-nov can merge them with the contents
+ ;; of FILE.
+ (copy-to-buffer
+ gnus-agent-overview-buffer (point-min) (point-max))
+ ;; NOTE: Call g-a-brand-nov even when the file does not
+ ;; exist. As a minimum, it will validate the article
+ ;; numbers already in the buffer.
+ (gnus-agent-braid-nov articles file)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-update-view-total-fetched-for group t)
+ (gnus-agent-save-alist group articles nil)
+ articles)
+ (ignore-errors
+ (erase-buffer)
+ (nnheader-insert-file-contents file)))))
+ articles))
(defsubst gnus-agent-read-article-number ()
"Read the article number at point.
@@ -1938,6 +1924,96 @@ Return nil when a valid article number can not be read."
(set-buffer nntp-server-buffer)
(insert-buffer-substring gnus-agent-overview-buffer b e))))
+(defun gnus-agent-braid-nov (articles file)
+ "Merge agent overview data with given file.
+Takes unvalidated headers for ARTICLES from
+`gnus-agent-overview-buffer' and validated headers from the given
+FILE and places the combined valid headers into
+`nntp-server-buffer'. This function can be used, when file
+doesn't exist, to valid the overview buffer."
+ (let (start last)
+ (set-buffer gnus-agent-overview-buffer)
+ (goto-char (point-min))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (when (file-exists-p file)
+ (nnheader-insert-file-contents file))
+ (goto-char (point-max))
+ (forward-line -1)
+
+ (unless (or (= (point-min) (point-max))
+ (< (setq last (read (current-buffer))) (car articles)))
+ ;; Old and new overlap -- We do it the hard way.
+ (when (nnheader-find-nov-line (car articles))
+ ;; Replacing existing NOV entry
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (gnus-agent-copy-nov-line (pop articles))
+
+ (ignore-errors
+ (while articles
+ (while (let ((art (read (current-buffer))))
+ (cond ((< art (car articles))
+ (forward-line 1)
+ t)
+ ((= art (car articles))
+ (beginning-of-line)
+ (delete-region
+ (point) (progn (forward-line 1) (point)))
+ nil)
+ (t
+ (beginning-of-line)
+ nil))))
+
+ (gnus-agent-copy-nov-line (pop articles)))))
+
+ (goto-char (point-max))
+
+ ;; Append the remaining lines
+ (when articles
+ (when last
+ (set-buffer gnus-agent-overview-buffer)
+ (setq start (point))
+ (set-buffer nntp-server-buffer))
+
+ (let ((p (point)))
+ (insert-buffer-substring gnus-agent-overview-buffer start)
+ (goto-char p))
+
+ (setq last (or last -134217728))
+ (while (catch 'problems
+ (let (sort art)
+ (while (not (eobp))
+ (setq art (gnus-agent-read-article-number))
+ (cond ((not art)
+ ;; Bad art num - delete this line
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1)
(point))))
+ ((< art last)
+ ;; Art num out of order - enable sort
+ (setq sort t)
+ (forward-line 1))
+ ((= art last)
+ ;; Bad repeat of art number - delete this line
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1)
(point))))
+ (t
+ ;; Good art num
+ (setq last art)
+ (forward-line 1))))
+ (when sort
+ ;; something is seriously wrong as we simply shouldn't see
out-of-order data.
+ ;; First, we'll fix the sort.
+ (sort-numeric-fields 1 (point-min) (point-max))
+
+ ;; but now we have to consider that we may have duplicate
rows...
+ ;; so reset to beginning of file
+ (goto-char (point-min))
+ (setq last -134217728)
+
+ ;; and throw a code that restarts this scan
+ (throw 'problems t))
+ nil))))))
+
;; Keeps the compiler from warning about the free variable in
;; gnus-agent-read-agentview.
(defvar gnus-agent-read-agentview)
@@ -2310,9 +2386,10 @@ modified) original contents, they are first saved to
their own file."
(gnus-orphan-score gnus-orphan-score)
;; Maybe some other gnus-summary local variables should also
;; be put here.
- fetched-headers
+
gnus-headers
gnus-score
+ articles
predicate info marks
)
(unless (gnus-check-group group)
@@ -2333,35 +2410,38 @@ modified) original contents, they are first saved to
their own file."
(setq info (gnus-get-info group)))))))
(when arts
(setq marked-articles (nconc (gnus-uncompress-range arts)
- marked-articles))))))
+ marked-articles))
+ ))))
(setq marked-articles (sort marked-articles '<))
- (setq gnus-newsgroup-dependencies
- (or gnus-newsgroup-dependencies
- (gnus-make-hashtable)))
+ ;; Fetch any new articles from the server
+ (setq articles (gnus-agent-fetch-headers group))
- ;; Fetch headers for any new articles from the server.
- (setq fetched-headers (gnus-agent-fetch-headers group))
+ ;; Merge new articles with marked
+ (setq articles (sort (append marked-articles articles) '<))
- (when fetched-headers
+ (when articles
+ ;; Parse them and see which articles we want to fetch.
+ (setq gnus-newsgroup-dependencies
+ (or gnus-newsgroup-dependencies
+ (gnus-make-hashtable (length articles))))
(setq gnus-newsgroup-headers
- (or gnus-newsgroup-headers
- fetched-headers)))
- (when marked-articles
- ;; `gnus-agent-overview-buffer' may be killed for timeout
- ;; reason. If so, recreate it.
+ (or gnus-newsgroup-headers
+ (gnus-get-newsgroup-headers-xover articles nil nil
+ group)))
+ ;; `gnus-agent-overview-buffer' may be killed for
+ ;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)
(setq predicate
- (gnus-get-predicate
- (gnus-agent-find-parameter group 'agent-predicate)))
-
- ;; If the selection predicate requires scoring, score each header.
+ (gnus-get-predicate
+ (gnus-agent-find-parameter group 'agent-predicate)))
+ ;; If the selection predicate requires scoring, score each header
(unless (memq predicate '(gnus-agent-true gnus-agent-false))
(let ((score-param
(gnus-agent-find-parameter group 'agent-score-file)))
- ;; Translate score-param into real one.
+ ;; Translate score-param into real one
(cond
((not score-param))
((eq score-param 'file)
@@ -3581,9 +3661,11 @@ has been fetched."
(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
(save-excursion
(gnus-agent-create-buffer)
- (let ((file (gnus-agent-article-name ".overview" group))
- (file-name-coding-system nnmail-pathname-coding-system)
- uncached-articles headers fetched-headers)
+ (let ((gnus-decode-encoded-word-function 'identity)
+ (gnus-decode-encoded-address-function 'identity)
+ (file (gnus-agent-article-name ".overview" group))
+ uncached-articles
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
@@ -3594,63 +3676,122 @@ has been fetched."
1)
(car (last articles))))))
- ;; See if we've got cached headers for ARTICLES and put them in
- ;; HEADERS. Articles with no cached headers go in
- ;; UNCACHED-ARTICLES to be fetched from the server.
+ ;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(erase-buffer)
(let ((nnheader-file-coding-system
gnus-agent-file-coding-system))
- (nnheader-insert-nov-file file (car articles))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer)
- (setq headers
- (gnus-get-newsgroup-headers-xover
- articles nil (buffer-local-value
- 'gnus-newsgroup-dependencies
- gnus-summary-buffer)
- gnus-newsgroup-name))))))
-
- (setq uncached-articles
- (gnus-agent-uncached-articles articles group t))
-
- (when uncached-articles
- (let ((gnus-newsgroup-name group)
- gnus-agent) ; Prevent loop.
- ;; Fetch additional headers for the uncached articles.
- (setq fetched-headers (gnus-fetch-headers uncached-articles))
- ;; Merge headers we got from the overview file with our
- ;; newly-fetched headers.
- (when fetched-headers
- (setq headers
- (delete-dups
- (sort (append headers (copy-sequence fetched-headers))
- (lambda (l r)
- (< (mail-header-number l)
- (mail-header-number r))))))
-
- ;; Add the new set of known headers to the overview file.
+ (nnheader-insert-nov-file file (car articles)))))
+
+ (if (setq uncached-articles (gnus-agent-uncached-articles articles group
+ t))
+ (progn
+ ;; Populate nntp-server-buffer with uncached headers
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
+ (gnus-retrieve-headers
+ uncached-articles group))))
+ (nnvirtual-convert-headers))
+ ((eq 'nntp (car gnus-current-select-method))
+ ;; The author of gnus-get-newsgroup-headers-xover
+ ;; reports that the XOVER command is commonly
+ ;; unreliable. The problem is that recently
+ ;; posted articles may not be entered into the
+ ;; NOV database in time to respond to my XOVER
+ ;; query.
+ ;;
+ ;; I'm going to use his assumption that the NOV
+ ;; database is updated in order of ascending
+ ;; article ID. Therefore, a response containing
+ ;; article ID N implies that all articles from 1
+ ;; to N-1 are up-to-date. Therefore, missing
+ ;; articles in that range have expired.
+
+ (set-buffer nntp-server-buffer)
+ (let* ((fetched-articles (list nil))
+ (tail-fetched-articles fetched-articles)
+ (min (car articles))
+ (max (car (last articles))))
+
+ ;; Get the list of articles that were fetched
+ (goto-char (point-min))
+ (let ((pm (point-max))
+ art)
+ (while (< (point) pm)
+ (when (setq art (gnus-agent-read-article-number))
+ (gnus-agent-append-to-list tail-fetched-articles
art))
+ (forward-line 1)))
+
+ ;; Clip this list to the headers that will
+ ;; actually be returned
+ (setq fetched-articles (gnus-list-range-intersection
+ (cdr fetched-articles)
+ (cons min max)))
+
+ ;; Clip the uncached articles list to exclude
+ ;; IDs after the last FETCHED header. The
+ ;; excluded IDs may be fetchable using HEAD.
+ (if (car tail-fetched-articles)
+ (setq uncached-articles
+ (gnus-list-range-intersection
+ uncached-articles
+ (cons (car uncached-articles)
+ (car tail-fetched-articles)))))
+
+ ;; Create the list of articles that were
+ ;; "successfully" fetched. Success, in this
+ ;; case, means that the ID should not be
+ ;; fetched again. In the case of an expired
+ ;; article, the header will not be fetched.
+ (setq uncached-articles
+ (gnus-sorted-nunion fetched-articles
+ uncached-articles))
+ )))
+
+ ;; Erase the temp buffer
+ (set-buffer gnus-agent-overview-buffer)
+ (erase-buffer)
+
+ ;; Copy the nntp-server-buffer to the temp buffer
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+
+ ;; Merge the temp buffer with the known headers (found on
+ ;; disk in FILE) into the nntp-server-buffer
+ (when uncached-articles
+ (gnus-agent-braid-nov uncached-articles file))
+
+ ;; Save the new set of known headers to FILE
+ (set-buffer nntp-server-buffer)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
- (with-current-buffer gnus-agent-overview-buffer
- ;; We stick the new headers in at the end, then
- ;; re-sort the whole buffer with
- ;; `sort-numeric-fields'. If this turns out to be
- ;; slow, we could consider a loop to add the headers
- ;; in sorted order to begin with.
- (goto-char (point-max))
- (mapc #'nnheader-insert-nov fetched-headers)
- (sort-numeric-fields 1 (point-min) (point-max))
- (gnus-agent-check-overview-buffer)
- (write-region (point-min) (point-max) file nil 'silent)
- (gnus-agent-update-view-total-fetched-for group t)
- ;; Update the group's article alist to include the
- ;; newly fetched articles.
- (gnus-agent-load-alist group)
- (gnus-agent-save-alist group uncached-articles nil))))))
- headers)))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+
+ (gnus-agent-update-view-total-fetched-for group t)
+
+ ;; Update the group's article alist to include the newly
+ ;; fetched articles.
+ (gnus-agent-load-alist group)
+ (gnus-agent-save-alist group uncached-articles nil)
+ )
+
+ ;; Copy the temp buffer to the nntp-server-buffer
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring gnus-agent-overview-buffer)))
+
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (car articles)
+ (car (last articles)))
+ t)
+
+ 'nov))
(defun gnus-agent-request-article (article group)
"Retrieve ARTICLE in GROUP from the agent cache."
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index ed948a2..fefd02c 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -357,13 +357,8 @@ that was fetched."
(let ((nntp-server-buffer (current-buffer))
(nnheader-callback-function
(lambda (_arg)
- (setq gnus-async-header-prefetched
- (cons group unread)))))
- ;; FIXME: If header prefetch is ever put into use, we'll
- ;; have to handle the possibility that
- ;; `gnus-retrieve-headers' might return a list of header
- ;; vectors directly, rather than writing them into the
- ;; current buffer.
+ (setq gnus-async-header-prefetched
+ (cons group unread)))))
(gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
(defun gnus-async-retrieve-fetched-headers (articles group)
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 9423d9f..36657e4 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -294,47 +294,49 @@ it's not cached."
(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
"Retrieve the headers for ARTICLES in GROUP."
(let ((cached
- (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))
- (gnus-newsgroup-name group)
- (gnus-fetch-old-headers fetch-old))
+ (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
(if (not cached)
;; No cached articles here, so we just retrieve them
;; the normal way.
(let ((gnus-use-cache nil))
- (gnus-retrieve-headers articles group))
+ (gnus-retrieve-headers articles group fetch-old))
(let ((uncached-articles (gnus-sorted-difference articles cached))
(cache-file (gnus-cache-file-name group ".overview"))
- (file-name-coding-system nnmail-pathname-coding-system)
- headers)
+ type
+ (file-name-coding-system nnmail-pathname-coding-system))
;; We first retrieve all the headers that we don't have in
;; the cache.
(let ((gnus-use-cache nil))
(when uncached-articles
- (setq headers (and articles
- (gnus-fetch-headers uncached-articles)))))
+ (setq type (and articles
+ (gnus-retrieve-headers
+ uncached-articles group fetch-old)))))
(gnus-cache-save-buffers)
- ;; Then we include the cached headers.
- (when (file-exists-p cache-file)
- (setq headers
- (delete-dups
- (sort
- (append headers
- (let ((coding-system-for-read
- gnus-cache-overview-coding-system))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-file-contents cache-file)
- (gnus-get-newsgroup-headers-xover
- (gnus-sorted-difference
- cached uncached-articles)
- nil (buffer-local-value
- 'gnus-newsgroup-dependencies
- gnus-summary-buffer)
- group))))
- (lambda (l r)
- (< (mail-header-number l)
- (mail-header-number r)))))))
- headers))))
+ ;; Then we insert the cached headers.
+ (save-excursion
+ (cond
+ ((not (file-exists-p cache-file))
+ ;; There are no cached headers.
+ type)
+ ((null type)
+ ;; There were no uncached headers (or retrieval was
+ ;; unsuccessful), so we use the cached headers exclusively.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((coding-system-for-read
+ gnus-cache-overview-coding-system))
+ (insert-file-contents cache-file))
+ 'nov)
+ ((eq type 'nov)
+ ;; We have both cached and uncached NOV headers, so we
+ ;; braid them.
+ (gnus-cache-braid-nov group cached)
+ type)
+ (t
+ ;; We braid HEADs.
+ (gnus-cache-braid-heads group (gnus-sorted-intersection
+ cached articles))
+ type)))))))
(defun gnus-cache-enter-article (&optional n)
"Enter the next N articles into the cache.
@@ -527,6 +529,70 @@ Returns the list of articles removed."
(setq gnus-cache-active-altered t)))
articles)))
+(defun gnus-cache-braid-nov (group cached &optional file)
+ (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
+ beg end)
+ (gnus-cache-save-buffers)
+ (with-current-buffer cache-buf
+ (erase-buffer)
+ (let ((coding-system-for-read gnus-cache-overview-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (insert-file-contents
+ (or file (gnus-cache-file-name group ".overview"))))
+ (goto-char (point-min))
+ (insert "\n")
+ (goto-char (point-min)))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while cached
+ (while (and (not (eobp))
+ (< (read (current-buffer)) (car cached)))
+ (forward-line 1))
+ (beginning-of-line)
+ (set-buffer cache-buf)
+ (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
+ nil t)
+ (setq beg (point-at-bol)
+ end (progn (end-of-line) (point)))
+ (setq beg nil))
+ (set-buffer nntp-server-buffer)
+ (when beg
+ (insert-buffer-substring cache-buf beg end)
+ (insert "\n"))
+ (setq cached (cdr cached)))
+ (kill-buffer cache-buf)))
+
+(defun gnus-cache-braid-heads (group cached)
+ (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
+ (with-current-buffer cache-buf
+ (erase-buffer))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (dolist (entry cached)
+ (while (and (not (eobp))
+ (looking-at "2.. +\\([0-9]+\\) ")
+ (< (progn (goto-char (match-beginning 1))
+ (read (current-buffer)))
+ entry))
+ (search-forward "\n.\n" nil 'move))
+ (beginning-of-line)
+ (set-buffer cache-buf)
+ (erase-buffer)
+ (let ((coding-system-for-read gnus-cache-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (insert-file-contents (gnus-cache-file-name group entry)))
+ (goto-char (point-min))
+ (insert "220 ")
+ (princ (pop cached) (current-buffer))
+ (insert " Article retrieved.\n")
+ (search-forward "\n\n" nil 'move)
+ (delete-region (point) (point-max))
+ (forward-char -1)
+ (insert ".")
+ (set-buffer nntp-server-buffer)
+ (insert-buffer-substring cache-buf))
+ (kill-buffer cache-buf)))
+
;;;###autoload
(defun gnus-jog-cache ()
"Go through all groups and put the articles into the cache.
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 00b85f5..f7c71f4 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -30,8 +30,6 @@
(require 'parse-time)
(require 'nnimap)
-(declare-function gnus-fetch-headers "gnus-sum")
-(defvar gnus-alter-header-function)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
@@ -393,6 +391,8 @@ When FULL is t, upload everything, not just a difference
from the last full."
(gnus-group-refresh-group group))
(gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
+(defvar gnus-alter-header-function)
+
(defun gnus-cloud-add-timestamps (elems)
(dolist (elem elems)
(let* ((file-name (plist-get elem :file-name))
@@ -407,10 +407,14 @@ When FULL is t, upload everything, not just a difference
from the last full."
(gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
(let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
(active (gnus-active group))
- (gnus-newsgroup-name group)
- (headers (gnus-fetch-headers (gnus-uncompress-range active))))
- (when gnus-alter-header-function
- (mapc gnus-alter-header-function headers))
+ headers head)
+ (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
+ (with-current-buffer nntp-server-buffer
+ (goto-char (point-min))
+ (while (setq head (nnheader-parse-head))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function head))
+ (push head headers))))
(sort (nreverse headers)
(lambda (h1 h2)
(> (gnus-cloud-chunk-sequence (mail-header-subject h1))
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 1e0e207..9811e8b 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -835,6 +835,7 @@ These will be used to retrieve the RSVP information from
ical events."
keymap ,gnus-mime-button-map
face ,gnus-article-button-face
follow-link t
+ category t
button t
gnus-data ,data))))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 5c6a5b9..4478060 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -909,6 +909,7 @@ quirks.")
(defclass gnus-search-namazu (gnus-search-indexed)
((index-directory
:initarg :index-directory
+ :initform (symbol-value 'gnus-search-namazu-index-directory)
:type string
:custom directory)
(program
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index fbdbf41..cf37a1c 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -637,7 +637,7 @@ the first newsgroup."
;; We subscribe the group by changing its level to `subscribed'.
(gnus-group-change-level
newsgroup gnus-level-default-subscribed
- gnus-level-killed (or next "dummy.group"))
+ gnus-level-killed next)
(gnus-request-update-group-status newsgroup 'subscribe)
(gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
(run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup)
@@ -1282,7 +1282,8 @@ string name) to insert this group before."
(gnus-dribble-enter
(format "(gnus-group-change-level %S %S %S %S %S)"
group level oldlevel
- (cadr (member previous gnus-group-list))
+ (when previous
+ (cadr (member previous gnus-group-list)))
fromkilled)))
;; Then we remove the newgroup from any old structures, if needed.
@@ -1341,9 +1342,10 @@ string name) to insert this group before."
;; at the head of `gnus-newsrc-alist'.
(push info (cdr gnus-newsrc-alist))
(puthash group (list num info) gnus-newsrc-hashtb)
- (when (stringp previous)
+ (when (and previous (stringp previous))
(setq previous (gnus-group-entry previous)))
- (let ((idx (or (seq-position gnus-group-list (caadr previous))
+ (let ((idx (or (and previous
+ (seq-position gnus-group-list (caadr previous)))
(length gnus-group-list))))
(push group (nthcdr idx gnus-group-list)))
(gnus-dribble-enter
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 5bd58b6..b0f9ed4 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5658,21 +5658,10 @@ or a straight list of headers."
(setf (mail-header-subject header) subject))))))
(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
- "Fetch headers of ARTICLES.
-This calls the `gnus-retrieve-headers' function of the current
-group's backend server. The server can do one of two things:
-
-1. Write the headers for ARTICLES into the
- `nntp-server-buffer' (the current buffer) in a parseable format, or
-2. Return the headers directly as a list of vectors.
-
-In the first case, `gnus-retrieve-headers' returns a symbol
-value, either `nov' or `headers'. This value determines which
-parsing function is used to read the headers. It is also stored
-into the variable `gnus-headers-retrieved-by', which is consulted
-later when possibly building full threads."
+ "Fetch headers of ARTICLES."
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
- (let ((res (setq gnus-headers-retrieved-by
+ (prog1
+ (pcase (setq gnus-headers-retrieved-by
(gnus-retrieve-headers
articles gnus-newsgroup-name
(or limit
@@ -5682,34 +5671,22 @@ later when possibly building full threads."
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))
- gnus-fetch-old-headers))))))
- (prog1
- (pcase res
- ('nov
- (gnus-get-newsgroup-headers-xover
- articles force-new dependencies gnus-newsgroup-name t))
- ;; For now, assume that any backend returning its own
- ;; headers takes some effort to do so, so return `headers'.
- ((pred listp)
- (setq gnus-headers-retrieved-by 'headers)
- (let ((dependencies
- (or dependencies
- (buffer-local-value
- 'gnus-newsgroup-dependencies gnus-summary-buffer))))
- (when (functionp gnus-alter-header-function)
- (mapc gnus-alter-header-function res))
- (mapc (lambda (header)
- ;; The agent or the cache may have already
- ;; registered this header in the dependency
- ;; table.
- (unless (gethash (mail-header-id header) dependencies)
- (gnus-dependencies-add-header
- header dependencies force-new)))
- res)
- res))
- (_ (gnus-get-newsgroup-headers dependencies force-new)))
- (gnus-message 7 "Fetching headers for %s...done"
- gnus-newsgroup-name))))
+ gnus-fetch-old-headers))))
+ ('nov
+ (gnus-get-newsgroup-headers-xover
+ articles force-new dependencies gnus-newsgroup-name t))
+ ('headers
+ (gnus-get-newsgroup-headers dependencies force-new))
+ ((pred listp)
+ (let ((dependencies
+ (or dependencies
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-dependencies))))
+ (delq nil (mapcar #'(lambda (header)
+ (gnus-dependencies-add-header
+ header dependencies force-new))
+ gnus-headers-retrieved-by)))))
+ (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -6466,10 +6443,6 @@ The resulting hash table is returned, or nil if no Xrefs
were found."
(unless (gnus-ephemeral-group-p group)
(gnus-group-update-group group t))))))
-;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and
-;; extract the necessary bits for the direct-header-return case. Also
-;; look at this and see how similar it is to
-;; `nnheader-parse-naked-head'.
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(let ((dependencies
(or dependencies
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 2e9ee71..3b172db 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2388,14 +2388,7 @@ Typical marks are those that make no sense in a
standalone back end,
such as a mark that says whether an article is stored in the cache
\(which doesn't make sense in a standalone back end).")
-(defvar gnus-headers-retrieved-by nil
- "Holds the return value of `gnus-retrieve-headers'.
-This is either the symbol `nov' or the symbol `headers'. This
-value is checked during the summary creation process, when
-building threads. A value of `nov' indicates that header
-retrieval is relatively cheap and threading is encouraged to
-include more old articles. A value of `headers' indicates that
-retrieval is expensive and should be minimized.")
+(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(defvar gnus-override-method nil)
(defvar gnus-opened-servers nil)
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index ebececa..3cdfc74 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -769,8 +769,24 @@ article number. This function is called narrowed to an
article."
(let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
+ ;; If there's non-ASCII raw characters in the data,
+ ;; RFC2047-encode them to avoid having arbitrary data in the
+ ;; .overview file.
+ (nnml--encode-headers headers)
headers))))
+(defun nnml--encode-headers (headers)
+ (let ((subject (mail-header-subject headers))
+ (rfc2047-encoding-type 'mime))
+ (unless (string-match "\\`[[:ascii:]]*\\'" subject)
+ (setf (mail-header-subject headers)
+ (mail-encode-encoded-word-string subject t))))
+ (let ((from (mail-header-from headers))
+ (rfc2047-encoding-type 'address-mime))
+ (unless (string-match "\\`[[:ascii:]]*\\'" from)
+ (setf (mail-header-from headers)
+ (rfc2047-encode-string from t)))))
+
(defun nnml-get-nov-buffer (group &optional incrementalp)
(let ((buffer (gnus-get-buffer-create
(format " *nnml %soverview %s*"
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index ba29343..1e2feda 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -101,10 +101,15 @@ It is computed from the marks of individual component
groups.")
(erase-buffer)
(if (stringp (car articles))
'headers
- (let ((carticles (nnvirtual-partition-sequence articles))
+ (let ((vbuf (nnheader-set-temp-buffer
+ (gnus-get-buffer-create " *virtual headers*")))
+ (carticles (nnvirtual-partition-sequence articles))
(sysname (system-name))
- cgroup headers all-headers article prefix)
- (pcase-dolist (`(,cgroup . ,articles) carticles)
+ cgroup carticle article result prefix)
+ (while carticles
+ (setq cgroup (caar carticles))
+ (setq articles (cdar carticles))
+ (pop carticles)
(when (and articles
(gnus-check-server
(gnus-find-method-for-group cgroup) t)
@@ -114,37 +119,69 @@ It is computed from the marks of individual component
groups.")
;; This is probably evil if people have set
;; gnus-use-cache to nil themselves, but I
;; have no way of finding the true value of it.
- (let ((gnus-use-cache t)
- (gnus-newsgroup-name cgroup)
- (gnus-fetch-old-headers nil))
- (setq headers (gnus-fetch-headers articles))))
- (erase-buffer)
- ;; Remove all header article numbers from `articles'.
- ;; If there's anything left, those are expired or
- ;; canceled articles, so we update the component group
- ;; below.
- (dolist (h headers)
- (setq articles (delq (mail-header-number h) articles)
- article (nnvirtual-reverse-map-article
- cgroup (mail-header-number h)))
- ;; Update all the header numbers according to their
- ;; reverse mapping, and drop any with no such mapping.
- (when article
- ;; Do this first, before we re-set the header's
- ;; article number.
- (nnvirtual-update-xref-header
- h cgroup prefix sysname)
- (setf (mail-header-number h) article)
- (push h all-headers)))
- ;; Anything left in articles is expired or canceled.
- ;; Could be smart and not tell it about articles already
- ;; known?
- (when articles
- (gnus-group-make-articles-read cgroup articles))))
-
- (sort all-headers (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2)))))))))
+ (let ((gnus-use-cache t))
+ (setq result (gnus-retrieve-headers
+ articles cgroup nil))))
+ (set-buffer nntp-server-buffer)
+ ;; If we got HEAD headers, we convert them into NOV
+ ;; headers. This is slow, inefficient and, come to think
+ ;; of it, downright evil. So sue me. I couldn't be
+ ;; bothered to write a header parse routine that could
+ ;; parse a mixed HEAD/NOV buffer.
+ (when (eq result 'headers)
+ (nnvirtual-convert-headers))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (delete-region (point)
+ (progn
+ (setq carticle (read nntp-server-buffer))
+ (point)))
+
+ ;; We remove this article from the articles list, if
+ ;; anything is left in the articles list after going through
+ ;; the entire buffer, then those articles have been
+ ;; expired or canceled, so we appropriately update the
+ ;; component group below. They should be coming up
+ ;; generally in order, so this shouldn't be slow.
+ (setq articles (delq carticle articles))
+
+ (setq article (nnvirtual-reverse-map-article cgroup carticle))
+ (if (null article)
+ ;; This line has no reverse mapping, that means it
+ ;; was an extra article reference returned by nntp.
+ (progn
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; Otherwise insert the virtual article number,
+ ;; and clean up the xrefs.
+ (princ article nntp-server-buffer)
+ (nnvirtual-update-xref-header cgroup carticle
+ prefix sysname)
+ (forward-line 1))
+ )
+
+ (set-buffer vbuf)
+ (goto-char (point-max))
+ (insert-buffer-substring nntp-server-buffer))
+ ;; Anything left in articles is expired or canceled.
+ ;; Could be smart and not tell it about articles already known?
+ (when articles
+ (gnus-group-make-articles-read cgroup articles))
+ )
+
+ ;; The headers are ready for reading, so they are inserted into
+ ;; the nntp-server-buffer, which is where Gnus expects to find
+ ;; them.
+ (prog1
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert-buffer-substring vbuf)
+ ;; FIX FIX FIX, we should be able to sort faster than
+ ;; this if needed, since each cgroup is sorted, we just
+ ;; need to merge
+ (sort-numeric-fields 1 (point-min) (point-max))
+ 'nov)
+ (kill-buffer vbuf)))))))
(defvoo nnvirtual-last-accessed-component-group nil)
@@ -335,18 +372,61 @@ It is computed from the marks of individual component
groups.")
;;; Internal functions.
-(defun nnvirtual-update-xref-header (header group prefix sysname)
- "Add xref to component GROUP to HEADER.
-Also add a server PREFIX any existing xref lines."
- (let ((bits (split-string (mail-header-xref header)
- nil t "[[:blank:]]"))
- (art-no (mail-header-number header)))
- (setf (mail-header-xref header)
- (concat
- (format "%s %s:%d " sysname group art-no)
- (mapconcat (lambda (bit)
- (concat prefix bit))
- bits " ")))))
+(defun nnvirtual-convert-headers ()
+ "Convert HEAD headers into NOV headers."
+ (with-current-buffer nntp-server-buffer
+ (let* ((dependencies (make-hash-table :test #'equal))
+ (headers (gnus-get-newsgroup-headers dependencies)))
+ (erase-buffer)
+ (mapc 'nnheader-insert-nov headers))))
+
+
+(defun nnvirtual-update-xref-header (group article prefix sysname)
+ "Edit current NOV header in current buffer to have an xref to the component
group, and also server prefix any existing xref lines."
+ ;; Move to beginning of Xref field, creating a slot if needed.
+ (beginning-of-line)
+ (looking-at
+ "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
+ (goto-char (match-end 0))
+ (unless (search-forward "\t" (point-at-eol) 'move)
+ (insert "\t"))
+
+ ;; Remove any spaces at the beginning of the Xref field.
+ (while (eq (char-after (1- (point))) ? )
+ (forward-char -1)
+ (delete-char 1))
+
+ (insert "Xref: " sysname " " group ":")
+ (princ article (current-buffer))
+ (insert " ")
+
+ ;; If there were existing xref lines, clean them up to have the correct
+ ;; component server prefix.
+ (save-restriction
+ (narrow-to-region (point)
+ (or (search-forward "\t" (point-at-eol) t)
+ (point-at-eol)))
+ (goto-char (point-min))
+ (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
+ (replace-match "" t t))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
+ nil t)
+ (replace-match "" t t))
+ (unless (eobp)
+ (insert " ")
+ (when (not (string= "" prefix))
+ (while (re-search-forward "[^ ]+:[0-9]+" nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (insert prefix))))))
+
+ ;; Ensure a trailing \t.
+ (end-of-line)
+ (or (eq (char-after (1- (point))) ?\t)
+ (insert ?\t)))
+
(defun nnvirtual-possibly-change-server (server)
(or (not server)
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 73870f9..82952e9 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -45,11 +45,7 @@
;; An overlay is used. In the non-sticky cases, this overlay is
;; active only on the selected window. A hook is added to
;; `post-command-hook' to activate the overlay and move it to the line
-;; about point. To get the non-sticky behavior, `hl-line-unhighlight'
-;; is added to `pre-command-hook' as well. This function deactivates
-;; the overlay unconditionally in case the command changes the
-;; selected window. (It does so rather than keeping track of changes
-;; in the selected window).
+;; about point.
;; You could make variable `global-hl-line-mode' buffer-local and set
;; it to nil to avoid highlighting specific buffers, when the global
@@ -91,9 +87,9 @@ when `global-hl-line-sticky-flag' is non-nil.")
(set symbol value)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (when hl-line-overlay
+ (when (overlayp hl-line-overlay)
(overlay-put hl-line-overlay 'face hl-line-face))))
- (when global-hl-line-overlay
+ (when (overlayp global-hl-line-overlay)
(overlay-put global-hl-line-overlay 'face hl-line-face))))
(defcustom hl-line-sticky-flag t
@@ -141,9 +137,7 @@ non-selected window. Hl-Line mode uses the function
`hl-line-highlight' on `post-command-hook' in this case.
When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
-line about point in the selected window only. In this case, it
-uses the function `hl-line-maybe-unhighlight' in
-addition to `hl-line-highlight' on `post-command-hook'."
+line about point in the selected window only."
:group 'hl-line
(if hl-line-mode
(progn
@@ -151,12 +145,10 @@ addition to `hl-line-highlight' on `post-command-hook'."
(add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t)
(hl-line-highlight)
(setq hl-line-overlay-buffer (current-buffer))
- (add-hook 'post-command-hook #'hl-line-highlight nil t)
- (add-hook 'post-command-hook #'hl-line-maybe-unhighlight nil t))
+ (add-hook 'post-command-hook #'hl-line-highlight nil t))
(remove-hook 'post-command-hook #'hl-line-highlight t)
(hl-line-unhighlight)
- (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t)
- (remove-hook 'post-command-hook #'hl-line-maybe-unhighlight t)))
+ (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t)))
(defun hl-line-make-overlay ()
(let ((ol (make-overlay (point) (point))))
@@ -168,17 +160,19 @@ addition to `hl-line-highlight' on `post-command-hook'."
"Activate the Hl-Line overlay on the current line."
(if hl-line-mode ; Might be changed outside the mode function.
(progn
- (unless hl-line-overlay
+ (unless (overlayp hl-line-overlay)
(setq hl-line-overlay (hl-line-make-overlay))) ; To be moved.
(overlay-put hl-line-overlay
'window (unless hl-line-sticky-flag (selected-window)))
- (hl-line-move hl-line-overlay))
+ (hl-line-move hl-line-overlay)
+ (hl-line-maybe-unhighlight))
(hl-line-unhighlight)))
(defun hl-line-unhighlight ()
"Deactivate the Hl-Line overlay on the current line."
- (when hl-line-overlay
- (delete-overlay hl-line-overlay)))
+ (when (overlayp hl-line-overlay)
+ (delete-overlay hl-line-overlay)
+ (setq hl-line-overlay nil)))
(defun hl-line-maybe-unhighlight ()
"Maybe deactivate the Hl-Line overlay on the current line.
@@ -191,8 +185,7 @@ such overlays in all buffers except the current one."
(not (eq curbuf hlob))
(not (minibufferp)))
(with-current-buffer hlob
- (when (overlayp hl-line-overlay)
- (delete-overlay hl-line-overlay))))
+ (hl-line-unhighlight)))
(when (and (overlayp hl-line-overlay)
(eq (overlay-buffer hl-line-overlay) curbuf))
(setq hl-line-overlay-buffer curbuf))))
@@ -205,8 +198,8 @@ If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line
mode
highlights the line about the current buffer's point in all live
windows.
-Global-Hl-Line mode uses the functions `global-hl-line-highlight'
-and `global-hl-line-maybe-unhighlight' on `post-command-hook'."
+Global-Hl-Line mode uses the function `global-hl-line-highlight'
+on `post-command-hook'."
:global t
:group 'hl-line
(if global-hl-line-mode
@@ -214,25 +207,24 @@ and `global-hl-line-maybe-unhighlight' on
`post-command-hook'."
;; In case `kill-all-local-variables' is called.
(add-hook 'change-major-mode-hook #'global-hl-line-unhighlight)
(global-hl-line-highlight-all)
- (add-hook 'post-command-hook #'global-hl-line-highlight)
- (add-hook 'post-command-hook #'global-hl-line-maybe-unhighlight))
+ (add-hook 'post-command-hook #'global-hl-line-highlight))
(global-hl-line-unhighlight-all)
(remove-hook 'post-command-hook #'global-hl-line-highlight)
- (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight)
- (remove-hook 'post-command-hook #'global-hl-line-maybe-unhighlight)))
+ (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight)))
(defun global-hl-line-highlight ()
"Highlight the current line in the current window."
(when global-hl-line-mode ; Might be changed outside the mode function.
(unless (window-minibuffer-p)
- (unless global-hl-line-overlay
+ (unless (overlayp global-hl-line-overlay)
(setq global-hl-line-overlay (hl-line-make-overlay))) ; To be moved.
(unless (member global-hl-line-overlay global-hl-line-overlays)
(push global-hl-line-overlay global-hl-line-overlays))
(overlay-put global-hl-line-overlay 'window
(unless global-hl-line-sticky-flag
(selected-window)))
- (hl-line-move global-hl-line-overlay))))
+ (hl-line-move global-hl-line-overlay)
+ (global-hl-line-maybe-unhighlight))))
(defun global-hl-line-highlight-all ()
"Highlight the current line in all live windows."
@@ -243,8 +235,9 @@ and `global-hl-line-maybe-unhighlight' on
`post-command-hook'."
(defun global-hl-line-unhighlight ()
"Deactivate the Global-Hl-Line overlay on the current line."
- (when global-hl-line-overlay
- (delete-overlay global-hl-line-overlay)))
+ (when (overlayp global-hl-line-overlay)
+ (delete-overlay global-hl-line-overlay)
+ (setq global-hl-line-overlay nil)))
(defun global-hl-line-maybe-unhighlight ()
"Maybe deactivate the Global-Hl-Line overlay on the current line.
@@ -256,9 +249,8 @@ all such overlays in all buffers except the current one."
(bufferp ovb)
(not (eq ovb (current-buffer)))
(not (minibufferp)))
- (with-current-buffer ovb
- (when (overlayp global-hl-line-overlay)
- (delete-overlay global-hl-line-overlay))))))
+ (with-current-buffer ovb
+ (global-hl-line-unhighlight)))))
global-hl-line-overlays))
(defun global-hl-line-unhighlight-all ()
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 4f37834..f6f056a 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -160,16 +160,19 @@ to track whether you're reading a specific mail."
(cond
((and
result ;there is a result
- (let* ((data (mapcar (lambda (record)
+ (let* ((answers (dns-get 'answers result))
+ (data (mapcar (lambda (record)
(dns-get 'data (cdr record)))
- (dns-get 'answers result)))
+ ;; We may get junk data back (or CNAME;
+ ;; ignore).
+ (and (eq (dns-get 'type answers) 'SRV)
+ answers)))
(priorities (mapcar (lambda (r)
(dns-get 'priority r))
data))
- (max-priority (if priorities
- (apply #'max priorities)
- 0))
- (sum 0) top)
+ (max-priority (apply #'max 0 priorities))
+ (sum 0)
+ top)
;; Attempt to find all records with the same maximal
;; priority, and calculate the sum of their weights.
(dolist (ent data)
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index 400421d..b890bde 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -1,4 +1,4 @@
-;;; isearch-x.el --- extended isearch handling commands
+;;; isearch-x.el --- extended isearch handling commands -*- lexical-binding:
t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -67,7 +67,7 @@
;; Exit from recursive edit safely. Set in `after-change-functions'
;; by isearch-with-keyboard-coding.
-(defun isearch-exit-recursive-edit (start end length)
+(defun isearch-exit-recursive-edit (_start _end _length)
(interactive)
(throw 'exit nil))
@@ -102,6 +102,7 @@
;;;###autoload
(defun isearch-process-search-multibyte-characters (last-char &optional count)
+ (defvar junk-hist)
(if (eq this-command 'isearch-printing-char)
(let ((overriding-terminal-local-map nil)
(prompt (isearch-message-prefix))
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index 3f3843e..ead7c8a 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -1,4 +1,4 @@
-;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding:
utf-8 -*-
+;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*-
lexical-binding: t; -*-
;; This file was formerly called gm-lingo.el.
;; Copyright (C) 1993-1998, 2000-2021 Free Software Foundation, Inc.
@@ -79,7 +79,7 @@
(point-max))))
;;;###autoload
-(defun iso-spanish (from to &optional buffer)
+(defun iso-spanish (from to &optional _buffer)
"Translate net conventions for Spanish to ISO 8859-1.
Translate the region between FROM and TO using the table
`iso-spanish-trans-tab'.
@@ -121,7 +121,7 @@ and may translate too little.")
"Currently active translation table for German.")
;;;###autoload
-(defun iso-german (from to &optional buffer)
+(defun iso-german (from to &optional _buffer)
"Translate net conventions for German to ISO 8859-1.
Translate the region FROM and TO using the table
`iso-german-trans-tab'.
@@ -194,7 +194,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
"Translation table for translating ISO 8859-1 characters to TeX sequences.")
;;;###autoload
-(defun iso-iso2tex (from to &optional buffer)
+(defun iso-iso2tex (from to &optional _buffer)
"Translate ISO 8859-1 characters to TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2tex-trans-tab'.
@@ -387,7 +387,7 @@ This table is not exhaustive (and due to TeX's power can
never be).
It only contains commonly used sequences.")
;;;###autoload
-(defun iso-tex2iso (from to &optional buffer)
+(defun iso-tex2iso (from to &optional _buffer)
"Translate TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-tex2iso-trans-tab'.
@@ -646,7 +646,7 @@ It only contains commonly used sequences.")
"Translation table for translating ISO 8859-1 characters to German TeX.")
;;;###autoload
-(defun iso-gtex2iso (from to &optional buffer)
+(defun iso-gtex2iso (from to &optional _buffer)
"Translate German TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-gtex2iso-trans-tab'.
@@ -655,7 +655,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-gtex2iso-trans-tab))
;;;###autoload
-(defun iso-iso2gtex (from to &optional buffer)
+(defun iso-iso2gtex (from to &optional _buffer)
"Translate ISO 8859-1 characters to German TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2gtex-trans-tab'.
@@ -674,7 +674,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
"Translation table for translating ISO 8859-1 characters to Duden
sequences.")
;;;###autoload
-(defun iso-iso2duden (from to &optional buffer)
+(defun iso-iso2duden (from to &optional _buffer)
"Translate ISO 8859-1 characters to Duden sequences.
Translate the region between FROM and TO using the table
`iso-iso2duden-trans-tab'.
@@ -812,7 +812,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
("ÿ" "ÿ")))
;;;###autoload
-(defun iso-iso2sgml (from to &optional buffer)
+(defun iso-iso2sgml (from to &optional _buffer)
"Translate ISO 8859-1 characters in the region to SGML entities.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist')."
@@ -820,7 +820,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-iso2sgml-trans-tab))
;;;###autoload
-(defun iso-sgml2iso (from to &optional buffer)
+(defun iso-sgml2iso (from to &optional _buffer)
"Translate SGML entities in the region to ISO 8859-1 characters.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist')."
@@ -828,13 +828,13 @@ Optional arg BUFFER is ignored (for use in
`format-alist')."
(iso-translate-conventions from to iso-sgml2iso-trans-tab))
;;;###autoload
-(defun iso-cvt-read-only (&rest ignore)
+(defun iso-cvt-read-only (&rest _ignore)
"Warn that format is read-only."
(interactive)
(error "This format is read-only; specify another format for writing"))
;;;###autoload
-(defun iso-cvt-write-only (&rest ignore)
+(defun iso-cvt-write-only (&rest _ignore)
"Warn that format is write-only."
(interactive)
(error "This format is write-only"))
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index b805904..3be7849 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -1,4 +1,4 @@
-;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
+;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs
Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -96,7 +96,7 @@
("もく" "目")
("ゆき" "行")))
-(defun skkdic-convert-postfix (skkbuf buf)
+(defun skkdic-convert-postfix (_skkbuf buf)
(byte-compile-info "Processing POSTFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
@@ -150,7 +150,7 @@
(defconst skkdic-prefix-list '(skkdic-prefix-list))
-(defun skkdic-convert-prefix (skkbuf buf)
+(defun skkdic-convert-prefix (_skkbuf buf)
(byte-compile-info "Processing PREFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
@@ -209,7 +209,7 @@
(substring str from idx)
skkdic-word-list)))
(if (or (and (consp kana2-list)
- (let ((kana-len (length kana))
+ (let (;; (kana-len (length kana))
kana2)
(catch 'skkdic-tag
(while kana2-list
@@ -342,7 +342,8 @@ The name of generated file is specified by the variable
`ja-dic-filename'."
(with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
- (insert ";;; ja-dic.el --- dictionary for Japanese input method\n"
+ (insert ";;; ja-dic.el --- dictionary for Japanese input method"
+ " -*- lexical-binding:t -*-\n"
";;\tGenerated by the command `skkdic-convert'\n"
";;\tOriginal SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el
index 498fb23..cc63698 100644
--- a/lisp/international/ja-dic-utl.el
+++ b/lisp/international/ja-dic-utl.el
@@ -1,4 +1,4 @@
-;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L)
+;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L)
-*- 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/international/kinsoku.el b/lisp/international/kinsoku.el
index cd740ac..05179a9 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -1,4 +1,4 @@
-;;; kinsoku.el --- `Kinsoku' processing funcs
+;;; kinsoku.el --- `Kinsoku' processing funcs -*- 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/international/kkc.el b/lisp/international/kkc.el
index 290f4fa..87f7389 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -1,4 +1,4 @@
-;;; kkc.el --- Kana Kanji converter
+;;; kkc.el --- Kana Kanji converter -*- 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/international/latexenc.el b/lisp/international/latexenc.el
index e2ee3fb..ff7cddc 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -1,4 +1,4 @@
-;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding:
utf-8 -*-
+;;; latexenc.el --- guess correct coding system in LaTeX files -*-
lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@@ -109,6 +109,8 @@ Return nil if no matching input encoding can be found."
(defvar latexenc-dont-use-tex-guess-main-file-flag nil
"Non-nil means don't use tex-guessmain-file to find the coding system.")
+(defvar tex-start-of-header)
+
;;;###autoload
(defun latexenc-find-file-coding-system (arg-list)
"Determine the coding system of a LaTeX file if it uses \"inputenc.sty\".
diff --git a/lisp/international/latin1-disp.el
b/lisp/international/latin1-disp.el
index bda2c51..4b6ef98 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -1,4 +1,4 @@
-;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals
-*-coding: utf-8;-*-
+;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals
-*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -86,8 +86,8 @@ use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :initialize #'custom-initialize-default
+ :set (lambda (_symbol value)
(if value
(apply #'latin1-display latin1-display-sets)
(latin1-display))))
@@ -186,7 +186,7 @@ character set."
'arabic-iso8859-6
(car (remq 'ascii (get-language-info language
'charset))))))
- (map-charset-chars #'(lambda (range arg)
+ (map-charset-chars #'(lambda (range _arg)
(standard-display-default (car range) (cdr range)))
charset))
(sit-for 0))
@@ -201,11 +201,10 @@ character set: `latin-2', `hebrew' etc."
(char (and info (decode-char (car (remq 'ascii info)) ?\ ))))
(and char (char-displayable-p char))))
-(defun latin1-display-setup (set &optional force)
+(defun latin1-display-setup (set &optional _force)
"Set up Latin-1 display for characters in the given SET.
SET must be a member of `latin1-display-sets'. Normally, check
-whether a font for SET is available and don't set the display if it
-is. If FORCE is non-nil, set up the display regardless."
+whether a font for SET is available and don't set the display if it is."
(cond
((eq set 'latin-2)
(latin1-display-identities set)
@@ -735,7 +734,7 @@ is. If FORCE is non-nil, set up the display regardless."
(sit-for 0))
;;;###autoload
-(defcustom latin1-display-ucs-per-lynx nil
+(defcustom latin1-display-ucs-per-lynx nil ;FIXME: Isn't this a minor mode?
"Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser. The display isn't
changed if the display can render Unicode characters.
@@ -745,8 +744,8 @@ use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :initialize #'custom-initialize-default
+ :set (lambda (_symbol value)
(if value
(latin1-display-ucs-per-lynx 1)
(latin1-display-ucs-per-lynx -1))))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 347e678..8202c3e 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1279,7 +1279,7 @@ in the format of Lisp expression for registering each
input method.
Emacs loads this file at startup time.")
(defconst leim-list-header (format-message
-";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
+";;; %s --- list of LEIM (Library of Emacs Input Method) -*-
lexical-binding:t -*-
;;
;; This file is automatically generated.
;;
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index d622268..d97d090 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,4 +1,4 @@
-;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
+;;; mule-diag.el --- show diagnosis of multilingual environment (Mule) -*-
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,
@@ -86,8 +86,7 @@ but still shows the full information."
(indent-to 48)
(insert "| +--CHARS\n")
(let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
- ("D CH FINAL-BYTE" . iso-spec)))
- pos)
+ ("D CH FINAL-BYTE" . iso-spec))))
(while columns
(if (stringp (car columns))
(insert (car columns))
@@ -117,8 +116,8 @@ but still shows the full information."
SORT-KEY should be `name' or `iso-spec' (default `name')."
(or sort-key
(setq sort-key 'name))
- (let ((tail charset-list)
- charset-info-list supplementary-list charset sort-func)
+ (let (;; (tail charset-list)
+ charset-info-list supplementary-list sort-func)
(dolist (charset charset-list)
;; Generate a list that contains all information to display.
(let ((elt (list charset
@@ -273,9 +272,9 @@ meanings of these arguments."
(setq tab-width 4)
(set-buffer-multibyte t)
(let ((dim (charset-dimension charset))
- (chars (charset-chars charset))
- ;; (plane (charset-iso-graphic-plane charset))
- (plane 1)
+ ;; (chars (charset-chars charset))
+ ;; (plane (charset-iso-graphic-plane charset))
+ ;; (plane 1)
(range (plist-get (charset-plist charset) :code-space))
min max min2 max2)
(if (> dim 2)
@@ -415,7 +414,8 @@ or provided just for backward compatibility." nil)))
(print-coding-system-briefly coding-system 'doc-string)
(let ((type (coding-system-type coding-system))
;; Fixme: use this
- (extra-spec (coding-system-plist coding-system)))
+ ;; (extra-spec (coding-system-plist coding-system))
+ )
(princ "Type: ")
(princ type)
(cond ((eq type 'undecided)
@@ -858,6 +858,8 @@ The IGNORED argument is ignored."
(with-output-to-temp-buffer "*Help*"
(describe-font-internal font-info)))))
+(defvar mule--print-opened)
+
(defun print-fontset-element (val)
;; VAL has this format:
;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
@@ -915,7 +917,7 @@ The IGNORED argument is ignored."
(or adstyle "*") registry)))))
;; Insert opened font names (if any).
- (if (and (boundp 'print-opened) (symbol-value 'print-opened))
+ (if (bound-and-true-p mule--print-opened)
(dolist (opened (cdr elt))
(insert "\n\t[" opened "]")))))))
@@ -943,8 +945,9 @@ the current buffer."
" and [" (propertize "OPENED" 'face 'underline) "])")
(let* ((info (fontset-info fontset))
(default-info (char-table-extra-slot info 0))
+ (mule--print-opened print-opened)
start1 end1 start2 end2)
- (describe-vector info 'print-fontset-element)
+ (describe-vector info #'print-fontset-element)
(when (char-table-range info nil)
;; The default of FONTSET is described.
(setq start1 (re-search-backward "^default"))
@@ -956,7 +959,7 @@ the current buffer."
(when default-info
(insert "\n ---<fallback to the default fontset>---")
(put-text-property (line-beginning-position) (point) 'face 'highlight)
- (describe-vector default-info 'print-fontset-element)
+ (describe-vector default-info #'print-fontset-element)
(when (char-table-range default-info nil)
;; The default of the default fontset is described.
(setq end2 (re-search-backward "^default"))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 79e4468..e049832 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -1,4 +1,4 @@
-;;; ogonek.el --- change the encoding of Polish diacritics
+;;; ogonek.el --- change the encoding of Polish diacritics -*-
lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f2ac44a..0901115 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1,4 +1,4 @@
-;;; quail.el --- provides simple input method for multilingual text
+;;; quail.el --- provides simple input method for multilingual text -*-
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,
@@ -1046,7 +1046,7 @@ the following annotation types are supported.
(quail-install-decode-map ',decode-map))))))
;;;###autoload
-(defun quail-install-map (map &optional name)
+(defun quail-install-map (map &optional _name)
"Install the Quail map MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@@ -1060,7 +1060,7 @@ The installed map can be referred by the function
`quail-map'."
(setcar (cdr (cdr quail-current-package)) map))
;;;###autoload
-(defun quail-install-decode-map (decode-map &optional name)
+(defun quail-install-decode-map (decode-map &optional _name)
"Install the Quail decode map DECODE-MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@@ -1390,7 +1390,7 @@ Return the input string."
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-translation-keymap))
- (generated-events nil) ;FIXME: What is this?
+ ;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command inhibit-record)
@@ -1455,7 +1455,7 @@ Return the input string."
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-conversion-keymap))
- (generated-events nil) ;FIXME: What is this?
+ ;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command inhibit-record)
@@ -2452,7 +2452,7 @@ should be made by `quail-build-decode-map' (which see)."
(insert-char ?- single-trans-width)
(forward-line 1)
;; Insert the key-tran pairs.
- (dotimes (row rows)
+ (dotimes (_ rows)
(let ((elt (pop single-list)))
(when elt
(move-to-column col)
@@ -2625,12 +2625,14 @@ KEY BINDINGS FOR CONVERSION
(run-hooks 'temp-buffer-show-hook)))))
(defun quail-help-insert-keymap-description (keymap &optional header)
+ (defvar the-keymap)
(let ((pos1 (point))
+ (the-keymap keymap)
pos2)
(if header
(insert header))
(save-excursion
- (insert (substitute-command-keys "\\{keymap}")))
+ (insert (substitute-command-keys "\\{the-keymap}")))
;; Skip headers "key bindings", etc.
(forward-line 3)
(setq pos2 (point))
@@ -3011,7 +3013,7 @@ of each directory."
;; At first, clean up the file.
(with-current-buffer list-buf
- (goto-char 1)
+ (goto-char (point-min))
;; Insert the correct header.
(if (looking-at (regexp-quote leim-list-header))
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 16cac07..55390df 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -1,4 +1,4 @@
-;;; robin.el --- yet another input method (smaller than quail)
+;;; robin.el --- yet another input method (smaller than quail) -*-
lexical-binding: t; -*-
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 58c81bf..64d6644 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,4 +1,4 @@
-;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package
-*- coding:iso-2022-7bit; lexical-binding:t -*-
+;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package
-*- coding: utf-8-emacs; 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,
@@ -83,9 +83,9 @@
;; how to select a translation from a list of candidates.
(defvar quail-cxterm-package-ext-info
- '(("chinese-4corner" "$(0(?-F(B")
- ("chinese-array30" "$(0#R#O(B")
- ("chinese-ccdospy" "$AKuF4(B"
+ '(("chinese-4corner" "四角")
+ ("chinese-array30" "３０")
+ ("chinese-ccdospy" "缩拼"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard Roman transliteration method for Chinese.
@@ -94,10 +94,10 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you type a single key for these Pinyin spelling.
- Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B)
+ Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü)
keyseq: a f g h i j k l s u y v
For example:
- Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B
$ASq(B $AH+(B
+ Chinese: 啊 果 中 文 光 玉 全
Pinyin: a guo zhong wen guang yu quan
Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6
@@ -106,14 +106,14 @@ For example:
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-ecdict" "$(05CKH(B"
+ ("chinese-ecdict" "英漢"
"In this input method, you enter a Chinese (Big5) character or word
by typing the corresponding English word. For example, if you type
-\"computer\", \"$(0IZH+(B\" is input.
+\"computer\", \"電腦\" is input.
\\<quail-translation-docstring>")
- ("chinese-etzy" "$(06/0D(B"
+ ("chinese-etzy" "倚注"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -122,20 +122,20 @@ compose one Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 1, 2, 3, or 4 specifying a tone (SPC:$(0?v(N(B, 1:$(0M=Vy(B,
2:$(0Dm(N(B, 3: $(0&9Vy(B,
-4:$(0(+Vy(B).
+SPC, 1, 2, 3, or 4 specifying a tone (SPC:陰平, 1:輕聲, 2:陽平, 3: 上聲,
+4:去聲).
\\<quail-translation-docstring>")
- ("chinese-punct-b5" "$(0O:(BB"
+ ("chinese-punct-b5" "標B"
"Input method for Chinese punctuation and symbols of Big5
\(`chinese-big5-1' and `chinese-big5-2').")
- ("chinese-punct" "$A1j(BG"
+ ("chinese-punct" "标G"
"Input method for Chinese punctuation and symbols of GB2312
\(`chinese-gb2312').")
- ("chinese-py-b5" "$(03<(BB"
+ ("chinese-py-b5" "拼B"
"Pinyin base input method for Chinese Big5 characters
\(`chinese-big5-1', `chinese-big5-2').
@@ -153,28 +153,28 @@ method `chinese-qj-b5'.
The input method `chinese-py' and `chinese-tonepy' are also Pinyin
based, but for the character set GB2312 (`chinese-gb2312').")
- ("chinese-qj-b5" "$(0)A(BB")
+ ("chinese-qj-b5" "全B")
- ("chinese-qj" "$AH+(BG")
+ ("chinese-qj" "全G")
- ("chinese-sw" "$AJWN2(B"
+ ("chinese-sw" "首尾"
"Radical base input method for Chinese charset GB2312 (`chinese-gb2312').
In this input method, you enter a Chinese character by typing two
-keys. The first key corresponds to the first ($AJW(B) radical, the second
-key corresponds to the last ($AN2(B) radical. The correspondence of keys
+keys. The first key corresponds to the first (首) radical, the second
+key corresponds to the last (尾) radical. The correspondence of keys
and radicals is as below:
first radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- $APD(B $AZ"(B $AJ,(B $AX<(B $A;p(B $A?Z(B $A^P(B $Ac_(B
$AZ%(B $A\3(B $AXi(B $AD>(B $Alj(B $Ab;(B $ATB(B $Afy(B
$AJ/(B $AMu(B $A0K(B $AX/(B $AHU(B $AeA(B $Aak(B $AVq(B
$AR;(B $AHK(B
+ 心 冖 尸 丶 火 口 扌 氵 讠 艹 亻 木 礻 饣 月 纟 石 王 八 丿 日 辶 犭 竹 一 人
last radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- $ASV(B $AI=(B $AMA(B $A56(B $AZb(B $A?Z(B $ARB(B $Aqb(B
$A4s(B $A6!(B $A[L(B $Ala(B $AJ.(B $A4u(B $AXg(B $ACE(B
$A=q(B $AX-(B $AE.(B $ARR(B $A`m(B $AP!(B $A3'(B $A3f(B
$A_.(B $A27(B
+ 又 山 土 刀 阝 口 衣 疋 大 丁 厶 灬 十 歹 冂 门 今 丨 女 乙 囗 小 厂 虫 弋 卜
\\<quail-translation-docstring>")
- ("chinese-tonepy" "$A5wF4(B"
+ ("chinese-tonepy" "调拼"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard roman transliteration method for Chinese.
@@ -183,18 +183,18 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you must type 1..5 after each Pinyin spelling to
-specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B,
5:$AGaIy(B).
+specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声).
\\<quail-translation-docstring>
-For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is
+For instance, to input 你, you type \"n i 3 3\", the first \"n i\" is
a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects
the third character from the candidate list.
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-zozy" "$(0I\0D(B"
+ ("chinese-zozy" "零注"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -203,8 +203,8 @@ compose a Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B,
3:$(0&9Vy(B, 4:$(0(+Vy(B,
-7:$(0M=Vy(B).
+SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲,
+7:輕聲).
\\<quail-translation-docstring>")))
@@ -269,6 +269,8 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B,
6:$(0Dm(N(B, 3:$(0&9Vy
(tit-moveleft ",<")
(tit-keyprompt nil))
+ (princ (format ";;; %s -*- lexical-binding:t -*-\n"
+ (file-name-nondirectory filename)))
(princ ";; Quail package `")
(princ package)
(princ "\n")
@@ -354,7 +356,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B,
6:$(0Dm(N(B, 3:$(0&9Vy
(princ (nth 2 (assoc tit-encode tit-encode-list)))
(princ "\" \"")
(princ (or title
- (if (string-match
"[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
+ (if (string-match "[:∷：【]+\\([^:∷：】]+\\)" tit-prompt)
(substring tit-prompt (match-beginning 1) (match-end 1))
tit-prompt)))
(princ "\"\n"))
@@ -375,7 +377,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B,
6:$(0Dm(N(B, 3:$(0&9Vy
;; Arg DOCSTRING
(let ((doc (concat tit-prompt "\n"))
(comments (if tit-comments
- (mapconcat 'identity (nreverse tit-comments) "\n")))
+ (mapconcat #'identity (nreverse tit-comments) "\n")))
(doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info))))
(if comments
(setq doc (concat doc "\n" comments "\n")))
@@ -580,7 +582,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; )
(defvar quail-misc-package-ext-info
- '(("chinese-b5-tsangchi" "$(06A(BB"
+ '(("chinese-b5-tsangchi" "倉B"
"cangjie-table.b5" big5 "tsang-b5.el"
tsang-b5-converter
"\
@@ -590,7 +592,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-b5-quick" "$(0X|(BB"
+ ("chinese-b5-quick" "簡B"
"cangjie-table.b5" big5 "quick-b5.el"
quick-b5-converter
"\
@@ -600,7 +602,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-tsangchi" "$(GT?(BC"
+ ("chinese-cns-tsangchi" "倉C"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
tsang-cns-converter
"\
@@ -610,7 +612,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-quick" "$(Gv|(BC"
+ ("chinese-cns-quick" "簡C"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
quick-cns-converter
"\
@@ -620,7 +622,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-py" "$AF4(BG"
+ ("chinese-py" "拼G"
"pinyin.map" cn-gb-2312 "PY.el"
py-converter
"\
@@ -648,7 +650,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ziranma" "$AWTH;(B"
+ ("chinese-ziranma" "自然"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
ziranma-converter
"\
@@ -676,7 +678,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlau" "$AAuTA(B"
+ ("chinese-ctlau" "刘粤"
"CTLau.html" cn-gb-2312 "CTLau.el"
ctlau-gb-converter
"\
@@ -701,7 +703,7 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; # You should have received a copy of the GNU General Public License
;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlaub" "$(0N,Gn(B"
+ ("chinese-ctlaub" "劉粵"
"CTLau-b5.html" big5 "CTLau-b5.el"
ctlau-b5-converter
"\
@@ -731,41 +733,27 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
;; dictionary in the buffer DICBUF. The input method name of the
;; Quail package is NAME, and the title string is TITLE.
-;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise
-;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is
non-nil, the
+;; TSANG-P is non-nil, generate 倉頡 input method. Otherwise
+;; generate 簡易 (simple version of 倉頡). If BIG5-P is non-nil, the
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
(defun tsang-quick-converter (dicbuf tsang-p big5-p)
- (let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B")
- (if big5-p "$(0X|/y(B" "$(Gv|Mx(B")))
+ (let ((fulltitle (if tsang-p "倉頡" "簡易"))
dic)
(goto-char (point-max))
- (if big5-p
- (insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5
+ (insert (format "\"中文輸入【%s】%s
- $(0KHM$(B%s$(0TT&,WoOu(B
+ 漢語%s輸入鍵盤
- [Q $(0'D(B] [W $(0(q(B] [E $(0'V(B] [R $(0&H(B] [T $(0'>(B] [Y
$(0&4(B] [U $(0&U(B] [I $(0'B(B] [O $(0&*(B] [P $(0'A(B]
+ [Q 手] [W 田] [E 水] [R 口] [T 廿] [Y 卜] [U 山] [I 戈] [O 人] [P 心]
- [A $(0'K(B] [S $(0&T(B] [D $(0'N(B] [F $(0'W(B] [G $(0&I(B] [H
$(0*M(B] [J $(0&3(B] [L $(0&d(B]
+ [A 日] [S 尸] [D 木] [F 火] [G 土] [H 竹] [J 十] [L 中]
- [Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N
$(0&_(B] [M $(0&"(B]
+ [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
\\\\<quail-translation-docstring>\"\n"
- fulltitle fulltitle))
- (insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS
-
- $(GiGk#(B%s$(GrSD+uomu(B
-
- [Q $(GEC(B] [W $(GFp(B] [E $(GEU(B] [R $(GDG(B] [T $(GE=(B] [Y
$(GD3(B] [U $(GDT(B] [I $(GEA(B] [O $(GD)(B] [P $(GE@(B]
-
- [A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H
$(GHL(B] [J $(GD2(B] [L $(GDc(B]
-
- [Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N
$(GD^(B] [M $(GD!(B]
-
-\\\\<quail-translation-docstring>\"\n"
- fulltitle fulltitle)))
+ fulltitle (if big5-p "BIG5" "CNS") fulltitle))
(insert " '((\".\" . quail-next-translation-block)
(\",\" . quail-prev-translation-block))
nil nil)\n\n")
@@ -798,35 +786,35 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
(setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
(dolist (elt dic)
(insert (format "(%S\t%S)\n" (car elt) (cdr elt))))
- (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B")
- (":" "$(0!(!+!3!%!$!&!0!1(B"
"$(G!(!+!3!%!$!&!0!1(B")
- ("'" "$(0!e!d(B" "$(G!e!d(B")
- ("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B")
- ("\\" "$(0"`"b#M(B" "$(G"`"b#M(B")
- ("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B")
- ("/" "$(0"_"a#L(B" "$(G"_"a#L(B")
- ("?" "$(0!)!4(B" "$(G!)!4(B")
- ("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B")
- (">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B")
- ("[" "$(0!F!J!b!H!L!V!Z!X!\(B"
"$(G!F!J!b!H!L!V!Z!X!\(B")
- ("]" "$(0!G!K!c!I!M!W![!Y!](B"
"$(G!G!K!c!I!M!W![!Y!](B")
- ("{" "$(0!B!`!D(B " "$(G!B!`!D(B ")
- ("}" "$(0!C!a!E(B" "$(G!C!a!E(B")
- ("`" "$(0!j!k(B" "$(G!j!k(B")
- ("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B")
- ("!" "$(0!*!5(B" "$(G!*!5(B")
- ("@" "$(0"i"n(B" "$(G"i"n(B")
- ("#" "$(0!l"-(B" "$(G!l"-(B")
- ("$" "$(0"c"l(B" "$(G"c"l(B")
- ("%" "$(0"h"m(B" "$(G"h"m(B")
- ("&" "$(0!m".(B" "$(G!m".(B")
- ("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B")
- ("(" "$(0!>!^!@(B" "$(G!>!^!@(B")
- (")" "$(0!?!_!A(B" "$(G!?!_!A(B")
- ("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B")
- ("_" "$(0"%"&(B" "$(G"%"&(B")
- ("=" "$(0"8"C(B" "$(G"8"C(B")
- ("+" "$(0"0"?(B" "$(G"0"?(B"))))
+ (let ((punctuation '((";" "；﹔，、﹐﹑" "；﹔，、﹐﹑")
+ (":" "：︰﹕．。‧﹒·" "：︰﹕．。・﹒·")
+ ("'" "’‘" "’‘")
+ ("\"" "”“〝〞〃" "”“〝〞〃")
+ ("\\" "＼﹨╲" "＼﹨╲")
+ ("|" "｜︱︳∣" "︱︲��｜")
+ ("/" "／∕╱" "／∕╱")
+ ("?" "？﹖" "？﹖")
+ ("<" "〈＜﹤︿∠" "〈＜﹤︿∠")
+ (">" "〉＞﹥﹀" "〉＞﹦﹀")
+ ("[" "〔【﹝︹︻「『﹁﹃" "〔【﹝︹︻「『﹁﹃")
+ ("]" "〕】﹞︺︼」』﹂﹄" "〕】﹞︺︼」』﹂﹄")
+ ("{" "｛﹛︷ " "｛﹛︷ ")
+ ("}" "｝﹜︸" "｝﹜︸")
+ ("`" "‵′" "′‵")
+ ("~" "～﹋﹌︴﹏" "∼﹋﹌����")
+ ("!" "！﹗" "！﹗")
+ ("@" "＠﹫" "＠﹫")
+ ("#" "＃﹟" "＃﹟")
+ ("$" "＄﹩" "＄﹩")
+ ("%" "％﹪" "％﹪")
+ ("&" "＆﹠" "＆﹠")
+ ("*" "＊﹡※☆★" "＊﹡※☆★")
+ ("(" "（﹙︵" "（﹙︵")
+ (")" "）﹚︶" "）﹚︶")
+ ("-" "–—¯￣－﹣" "—–‾��－﹣")
+ ("_" "＿ˍ" "＿��")
+ ("=" "＝﹦" "＝﹥")
+ ("+" "＋﹢" "＋﹢"))))
(dolist (elt punctuation)
(insert (format "(%S %S)\n" (concat "z" (car elt))
(if big5-p (nth 1 elt) (nth 2 elt))))))
@@ -850,11 +838,11 @@ To get complete usage, invoke \"emacs -batch -f
batch-titdic-convert -h\"."
(defun py-converter (dicbuf)
(goto-char (point-max))
- (insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B
+ (insert (format "%S\n" "汉字输入∷拼音∷
- $AF4Rt7=08(B
+ 拼音方案
- $AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B
+ 小写英文字母代表「拼音」符号， \"u(yu) 则用 u: 表示∶
Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
@@ -868,14 +856,14 @@ character. The sequence is made by the combination of
the initials
iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun
(Note: In the correct Pinyin writing, the sequence \"yu\" in the last
- four finals should be written by the character u-umlaut `$A(9(B'.)
+ four finals should be written by the character u-umlaut `ü'.)
With this input method, you enter a Chinese character by first
entering its pinyin spelling.
\\<quail-translation-docstring>
-For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\"
+For instance, to input 你, you type \"n i C-n 3\". The first \"n i\"
is a Pinyin, \"C-n\" selects the next group of candidates (each group
contains at most 10 characters), \"3\" select the third character in
that group.
@@ -953,27 +941,27 @@ method `chinese-tonepy' with which you must specify tones
by digits
(= (length (aref trans i)) 1))
(setq i (1+ i)))
(if (= i len)
- (setq trans (mapconcat 'identity trans "")))))
+ (setq trans (mapconcat #'identity trans "")))))
(setq dic (cons (cons key trans) dic)))
table)))
(setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
(goto-char (point-max))
- (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B
-
- $A<|EL6TUU1m(B:
- $A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B
- $A)'#Q(B $A)'#W(B $A)'#E(B $A)'#R(B $A)'#T(B $A)'#Y(B
$A)'#U(Bsh$A)'#I(Bch$A)'#O(B $A)'#P(B $A)'(B
- $A)'(B iu$A)'(B ua$A)'(B e$A)'(B uan$A)'(B ue$A)'(B
uai$A)'(B u$A)'(B i$A)'(B o$A)'(B un$A)'(B
- $A)'(B $A)'(B ia$A)'(B $A)'(B van$A)'(B ve$A)'(B
ing$A)'(B $A)'(B $A)'(B uo$A)'(B vn$A)'(B
- $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B
- $A)'#A(B $A)'#S(B $A)'#D(B $A)'#F(B $A)'#G(B $A)'#H(B
$A)'#J(B $A)'#K(B $A)'#L(B $A)'(B
- $A)'(B a$A)'(Biong$A)'(Buang$A)'(B en$A)'(B eng$A)'(B
ang$A)'(B an$A)'(B ao$A)'(B ai$A)'(B
- $A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B
$A)'(B $A)'(B $A)'(B $A)'(B
- $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B
- $A)'#Z(B $A)'#X(B $A)'#C(B $A)'#V(Bzh$A)'#B(B $A)'#N(B
$A)'#M(B $A)'#,(B $A)'#.(B $A)'(B $A#/(B $A)'(B
- $A)'(B ei$A)'(B ie$A)'(B iao$A)'(B ui$A)'(B ou$A)'(B
in$A)'(B ian$A)'G0R3)':sR3)'7{:E)'(B
- $A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B
$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
- $A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B
+ (insert (format "%S\n" "汉字输入∷【自然】∷
+
+ 键盘对照表:
+ ┏━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┳━━┓
+ ┃Ｑ ┃Ｗ ┃Ｅ ┃Ｒ ┃Ｔ ┃Ｙ ┃Ｕsh┃Ｉch┃Ｏ ┃Ｐ ┃
+ ┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃
+ ┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃
+ ┗┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┛
+ ┃Ａ ┃Ｓ ┃Ｄ ┃Ｆ ┃Ｇ ┃Ｈ ┃Ｊ ┃Ｋ ┃Ｌ ┃
+ ┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃
+ ┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃
+ ┗┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━┻┳━━┓
+ ┃Ｚ ┃Ｘ ┃Ｃ ┃Ｖzh┃Ｂ ┃Ｎ ┃Ｍ ┃， ┃． ┃ ／ ┃
+ ┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃前页┃后页┃符号┃
+ ┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃
+ ┗━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┻━━┛
Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312').
@@ -985,34 +973,34 @@ method `chinese-py'.
Unlike the standard spelling of Pinyin, in this input method all
initials and finals are assigned to single keys (see the above table).
For instance, the initial \"ch\" is assigned to the key `i', the final
-\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are
+\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are
assigned to the keys `q', `w', `e', `r', `t' respectively.
\\<quail-translation-docstring>
To input one-letter words, you type 4 keys, the first two for the
Pinyin of the letter, next one for tone, and the last one is always a
-quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these
+quote ('). For instance, \"vsq'\" input 中. Exceptions are these
letters. You can input them just by typing a single key.
- Character: $A04(B $A2;(B $A4N(B $A5D(B $A6~(B $A7"(B
$A8v(B $A:M(B $A3v(B $A<0(B $A?I(B $AAK(B $AC;(B
+ Character: 按 不 次 的 二 发 个 和 出 及 可 了 没
Key: a b c d e f g h i j k l m
- Character: $ADc(B $AE7(B $AF,(B $AF_(B $AHK(B $AH}(B
$AK{(B $AJG(B $AWE(B $ANR(B $AP!(B $AR;(B $ATZ(B
+ Character: 你 欧 片 七 人 三 他 是 着 我 小 一 在
Key: n o p q r s t u v w x y z
To input two-letter words, you have two ways. One way is to type 4
keys, two for the first Pinyin, two for the second Pinyin. For
-instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2
+instance, \"vsgo\" inputs 中国. Another way is to type 3 keys: 2
initials of two letters, and quote ('). For instance, \"vg'\" also
-inputs $AVP9z(B.
+inputs 中国.
To input three-letter words, you type 4 keys: initials of three
-letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B
-$A>)Q<(B (the last `2' is to select one of the candidates).
+letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北
+京鸭 (the last `2' is to select one of the candidates).
To input words of more than three letters, you type 4 keys, initials
of the first three letters and the last letter. For instance,
-\"bjdt\" inputs $A11>)5gJSL((B.
+\"bjdt\" inputs 北京电视台.
To input symbols and punctuation, type `/' followed by one of `a' to
`z', then select one of the candidates."))
@@ -1059,7 +1047,7 @@ To input symbols and punctuation, type `/' followed by
one of `a' to
;; which the file is converted have no Big5 equivalent. Go
;; through and delete them.
(goto-char pos)
- (while (search-forward "$(0!{(B" nil t)
+ (while (search-forward "□" nil t)
(delete-char -1))
;; Uppercase keys in dictionary need to be downcased. Backslashes
;; at the beginning of keys need to be turned into double
@@ -1083,31 +1071,31 @@ To input symbols and punctuation, type `/' followed by
one of `a' to
(defun ctlau-gb-converter (dicbuf)
(ctlau-converter dicbuf
-"$A::WVJdHk!KAuN}OiJ=TARt!K(B
+"汉字输入∷刘锡祥式粤音∷
- $AAuN}OiJ=TASoW"Rt7=08(B
+ 刘锡祥式粤语注音方案
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee ($A@n7c7e(B).
+ This file was prepared by Fung Fung Lee (李枫峰).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent GB characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical ($A2?JW(B)."))
+ the Cantonese romanization of the respective radical (部首)."))
(defun ctlau-b5-converter (dicbuf)
(ctlau-converter dicbuf
-"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B
+"漢字輸入：劉錫祥式粵音：
- $(0N,Tg>A*#GnM$0D5x'J7{(B
+ 劉錫祥式粵語注音方案
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee ($(0,XFS76(B).
+ This file was prepared by Fung Fung Lee (李楓峰).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical ($(0?f5}(B)."))
+ the Cantonese romanization of the respective radical (部首)."))
(declare-function dos-8+3-filename "dos-fns.el" (filename))
@@ -1147,6 +1135,8 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
+ (insert (format ";;; %s -*- lexical-binding:t -*-\n"
+ (file-name-nondirectory quailfile)))
(insert (format-message ";; Quail package `%s'\n" name))
(insert (format-message
";; Generated by the command `miscdic-convert'\n"))
@@ -1212,8 +1202,10 @@ The library is named pinyin.el, and contains the constant
(dst-file (cadr command-line-args-left))
(coding-system-for-write 'utf-8-unix))
(with-temp-file dst-file
- (insert ";; This file is automatically generated from pinyin.map,\
- by the\n;; function pinyin-convert.\n\n")
+ (insert ";;; " (file-name-nondirectory dst-file)
+ " -*- lexical-binding:t -*-
+;; This file is automatically generated from pinyin.map, by the
+;; function pinyin-convert.\n\n")
(insert "(defconst pinyin-character-map\n'(")
(let ((pos (point)))
(insert-file-contents src-file)
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index e941abb..dece184 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -1,4 +1,4 @@
-;;; utf-7.el --- utf-7 coding system
+;;; utf-7.el --- utf-7 coding system -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index a866785..a1e3fe2 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -513,7 +513,7 @@ This is like `describe-bindings', but displays only Isearch
keys."
(call-interactively command)))
(defvar isearch-menu-bar-commands
- '(isearch-tmm-menubar menu-bar-open mouse-minor-mode-menu)
+ '(isearch-tmm-menubar tmm-menubar menu-bar-open mouse-minor-mode-menu)
"List of commands that can open a menu during Isearch.")
(defvar isearch-menu-bar-yank-map
@@ -787,7 +787,6 @@ This is like `describe-bindings', but displays only Isearch
keys."
(define-key map [menu-bar search-menu]
(list 'menu-item "Isearch" isearch-menu-bar-map))
- (define-key map [remap tmm-menubar] 'isearch-tmm-menubar)
map)
"Keymap for `isearch-mode'.")
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index bb8dacf..303f38a 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -172,6 +172,7 @@ macro to be executed before appending to it."
(define-key map "\C-k" 'kmacro-end-or-call-macro-repeat)
(define-key map "r" 'apply-macro-to-region-lines)
(define-key map "q" 'kbd-macro-query) ;; Like C-x q
+ (define-key map "Q" 'kdb-macro-redisplay)
;; macro ring
(define-key map "\C-n" 'kmacro-cycle-ring-next)
@@ -1298,6 +1299,16 @@ To customize possible responses, change the \"bindings\"
in
(kmacro-push-ring)
(setq last-kbd-macro kmacro-step-edit-new-macro))))
+(defun kdb-macro-redisplay ()
+ "Force redisplay during kbd macro execution."
+ (interactive)
+ (or executing-kbd-macro
+ defining-kbd-macro
+ (user-error "Not defining or executing kbd macro"))
+ (when executing-kbd-macro
+ (let ((executing-kbd-macro nil))
+ (redisplay))))
+
(provide 'kmacro)
;;; kmacro.el ends here
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index d689e87..373f25a 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -51,7 +51,7 @@
regexp t t))))
regexp))
-(let ((elt (list (vector burmese-composable-pattern 0 'font-shape-gstring)
- (vector "." 0 'font-shape-gstring))))
+(let ((elt (list (vector burmese-composable-pattern 0 #'font-shape-gstring)
+ (vector "." 0 #'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1000 . #x107F) elt)
(set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt))
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index 089988d..3aac986 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -23,13 +23,13 @@
;;; Commentary:
-;; Tai Viet is being included in the Unicode at the range U+AA80..U+AADF.
+;; Cham script is included in the Unicode at the range U+AA00..U+AA5F.
;;; Code:
(set-char-table-range composition-function-table
'(#xAA00 . #xAA5F)
- (list (vector "[\xAA00-\xAA5F]+" 0 'font-shape-gstring)))
+ (list (vector "[\xAA00-\xAA5F]+" 0 #'font-shape-gstring)))
(set-language-info-alist
"Cham" '((charset unicode)
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 4bc2eaa..105e7a7 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -1,4 +1,4 @@
-;;; china-util.el --- utilities for Chinese -*- coding: utf-8 -*-
+;;; china-util.el --- utilities for Chinese -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index 72ceffd..04e681d 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -1,4 +1,4 @@
-;;; cyril-util.el --- utilities for Cyrillic scripts
+;;; cyril-util.el --- utilities for Cyrillic scripts -*- lexical-binding: t;
-*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 174b9ec..9b5fdf2 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1,4 +1,4 @@
-;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*-
+;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs;
lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2002-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -832,11 +832,12 @@ The 2nd and 3rd arguments BEGIN and END specify the
region."
(set-buffer-modified-p nil)))
;;;###autoload
-(defun ethio-tex-to-fidel-buffer nil
+(defun ethio-tex-to-fidel-buffer ()
"Convert fidel-tex commands in the current buffer into fidel chars."
(interactive)
- (let ((buffer-read-only nil)
- (p) (ch))
+ (let ((inhibit-read-only t)
+ ;; (p) (ch)
+ )
;; TeX macros to Ethiopic characters
(robin-convert-region (point-min) (point-max) "ethiopic-tex")
@@ -1018,7 +1019,7 @@ With ARG, insert that many delimiters."
;;
;;;###autoload
-(defun ethio-composition-function (pos to font-object string _direction)
+(defun ethio-composition-function (pos _to _font-object string _direction)
(setq pos (1- pos))
(let ((pattern "\\ce\\(፟\\|����\\)"))
(if string
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 8573f61..209dcd5 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -79,8 +79,8 @@
)))
;; For automatic composition
-(aset composition-function-table ?���� 'ethio-composition-function)
-(aset composition-function-table ?፟ 'ethio-composition-function)
+(aset composition-function-table ?���� #'ethio-composition-function)
+(aset composition-function-table ?፟ #'ethio-composition-function)
(provide 'ethiopic)
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 313fc63..9e92135 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -1,4 +1,4 @@
-;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*-
+;;; hanja-util.el --- Korean Hanja util module -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 3895656..c55d23f 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -245,9 +245,9 @@ Bidirectional editing is supported.")))
(pattern2 (concat base "\u200D" combining)))
(set-char-table-range
composition-function-table '(#x591 . #x5C7)
- (list (vector pattern2 3 'hebrew-shape-gstring)
- (vector pattern2 2 'hebrew-shape-gstring)
- (vector pattern1 1 'hebrew-shape-gstring)
+ (list (vector pattern2 3 #'hebrew-shape-gstring)
+ (vector pattern2 2 #'hebrew-shape-gstring)
+ (vector pattern1 1 #'hebrew-shape-gstring)
[nil 0 hebrew-shape-gstring]))
;; Exclude non-combining characters.
(set-char-table-range
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 4bd1cd7..8d4b2a8 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -1,4 +1,4 @@
-;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*-
coding: utf-8-emacs; -*-
+;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*-
coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -40,7 +40,7 @@
(defun indian-regexp-of-hashtbl-keys (hashtbl)
"Return the regular expression of hash table keys."
(let (keys)
- (maphash (lambda (key val) (push key keys)) hashtbl)
+ (maphash (lambda (key _val) (push key keys)) hashtbl)
(regexp-opt keys)))
(defvar indian-dev-base-table
@@ -565,7 +565,7 @@
(let ((regexp ,(indian-regexp-of-hashtbl-keys
(if encode-p (car (eval hashtable))
(cdr (eval hashtable))))))
- (narrow-to-region from to)
+ (narrow-to-region ,from ,to)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(let ((matchstr (gethash (match-string 0)
@@ -613,7 +613,7 @@
;; The followings provide conversion between IS 13194 (ISCII) and UCS.
-(let
+(dlet
;;Unicode vs IS13194 ;; only Devanagari is supported now.
((ucs-devanagari-to-is13194-alist
'((?\x0900 . "[U+0900]")
@@ -820,11 +820,11 @@ Returns new end position."
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
- (let* ((current-repertory is13194-default-repertory))
+ ;; (let* ((current-repertory is13194-default-repertory))
(while (re-search-forward indian-ucs-to-is13194-regexp nil t)
(replace-match
(get-char-code-property (string-to-char (match-string 0))
- 'iscii))))
+ 'iscii)));; )
(point-max))))
(defun indian-iscii-to-ucs-region (from to)
@@ -1246,7 +1246,7 @@ Returns new end position."
(interactive "r")
(save-excursion
(save-restriction
- (let ((pos from)
+ (let (;; (pos from)
(alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0)))
(narrow-to-region from to)
(decompose-region from to)
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 5ff5796..6f9d270 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -381,7 +381,7 @@ South Indian language Malayalam is supported in this
language environment."))
(if slot
(set-char-table-range
composition-function-table key
- (list (vector (cdr slot) 0 'font-shape-gstring))))))
+ (list (vector (cdr slot) 0 #'font-shape-gstring))))))
char-script-table))
(provide 'indian)
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 9dce17c..948bfef 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -1,4 +1,4 @@
-;;; japan-util.el --- utilities for Japanese
+;;; japan-util.el --- utilities for Japanese -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -236,7 +236,7 @@ of which charset is `japanese-jisx0201-kana'."
(composition
(and (not hankaku)
(get-char-code-property kana 'kana-composition)))
- next slot)
+ slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
@@ -258,7 +258,7 @@ of which charset is `japanese-jisx0201-kana'."
(while (re-search-forward "\\cK\\|\\ck" nil t)
(let* ((kata (preceding-char))
(composition (get-char-code-property kata 'kana-composition))
- next slot)
+ slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(get-char-code-property
@@ -305,7 +305,7 @@ Optional argument KATAKANA-ONLY non-nil means to convert
only KATAKANA char."
(re-search-forward "\\ca\\|\\ck" nil t)))
(let* ((hankaku (preceding-char))
(composition (get-char-code-property hankaku 'kana-composition))
- next slot)
+ slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index 37173c9..6f08e60 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -31,7 +31,7 @@
(documentation . t)))
(let ((val (list (vector "[\x1780-\x17FF\x19E0-\x19FF\x200C\x200D]+"
- 0 'font-shape-gstring))))
+ 0 #'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1780 . #x17FF) val)
(set-char-table-range composition-function-table '(#x19E0 . #x19FF) val))
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index eb7b85b..c99ff3c 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -1,4 +1,4 @@
-;;; korea-util.el --- utilities for Korean
+;;; korea-util.el --- utilities for Korean -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -45,7 +45,7 @@
(activate-input-method
(concat "korean-hangul" default-korean-keyboard))))
-(defun quail-hangul-switch-symbol-ksc (&rest ignore)
+(defun quail-hangul-switch-symbol-ksc (&rest _ignore)
"Switch to/from Korean symbol package."
(interactive "i")
(and current-input-method
@@ -54,7 +54,7 @@
default-korean-keyboard))
(activate-input-method "korean-symbol"))))
-(defun quail-hangul-switch-hanja (&rest ignore)
+(defun quail-hangul-switch-hanja (&rest _ignore)
"Switch to/from Korean hanja package."
(interactive "i")
(and current-input-method
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 22b33a4..bdf8240 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -92,10 +92,10 @@ and the following key bindings are available within Korean
input methods:
(pattern (concat choseong jungseong jongseong)))
(set-char-table-range composition-function-table
'(#x1100 . #x115F)
- (list (vector pattern 0 'font-shape-gstring)))
+ (list (vector pattern 0 #'font-shape-gstring)))
(set-char-table-range composition-function-table
'(#xA960 . #xA97C)
- (list (vector pattern 0 'font-shape-gstring))))
+ (list (vector pattern 0 #'font-shape-gstring))))
(provide 'korean)
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 59c9850..c8c3fe4 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -1,4 +1,4 @@
-;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*-
+;;; lao-util.el --- utilities for Lao -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -498,10 +498,10 @@ syllable. In that case, FROM and TO are indexes to STR."
(compose-gstring-for-graphic gstring direction)
(or (font-shape-gstring gstring direction)
(let ((glyph-len (lgstring-glyph-len gstring))
- (i 0)
- glyph)
+ (i 0)) ;; glyph
(while (and (< i glyph-len)
- (setq glyph (lgstring-glyph gstring i)))
+ ;; (setq glyph
+ (lgstring-glyph gstring i)) ;;)
(setq i (1+ i)))
(compose-glyph-string-relative gstring 0 i 0.1)))))
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 5252f1e..c699d57 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -66,7 +66,7 @@
(t (string c))))
(cdr l) ""))
;; Element of composition-function-table.
- (elt (list (vector regexp 1 'lao-composition-function)
+ (elt (list (vector regexp 1 #'lao-composition-function)
fallback-rule))
ch)
(dotimes (i len)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 0a274f1..a2ca678 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -137,9 +137,9 @@ thin (i.e. 1-dot width) space."
composition-function-table
'(#x600 . #x74F)
(list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
- 1 'arabic-shape-gstring)
+ 1 #'arabic-shape-gstring)
(vector "[\u0600-\u074F\u200C\u200D]+"
- 0 'arabic-shape-gstring)))
+ 0 #'arabic-shape-gstring)))
;; The Egyptian Hieroglyph Format Controls were introduced in Unicode
;; Standard v12.0. Apparently, they are not yet well supported in
@@ -186,13 +186,13 @@ thin (i.e. 1-dot width) space."
;; doesn't support these controls, the glyphs are
;; displayed individually, and not as a single
;; grapheme cluster.
- 1 'font-shape-gstring)))
+ 1 #'font-shape-gstring)))
;; Grouping controls
(set-char-table-range
composition-function-table
#x13437
(list (vector "\U00013437[\U00013000-\U0001343F]+"
- 0 'egyptian-shape-grouping))))
+ 0 #'egyptian-shape-grouping))))
(provide 'misc-lang)
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index 90fc41c..99a104e 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -43,6 +43,6 @@
"[\u0D85-\u0D96][\u0D82-\u0D83]?\\|"
;; any other singleton characters
"[\u0D80-\u0DFF]")
- 0 'font-shape-gstring)))
+ 0 #'font-shape-gstring)))
;; sinhala.el ends here
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index 17abf13..4549b11 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -30,7 +30,7 @@
(set-char-table-range composition-function-table
'(#xAA80 . #xAADF)
- 'tai-viet-composition-function)
+ #'tai-viet-composition-function)
(set-language-info-alist
"TaiViet" '((charset unicode)
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index f9c57e8..e11a054 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,4 +1,4 @@
-;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
+;;; thai-util.el --- utilities for Thai -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -232,10 +232,10 @@ positions (integers or markers) specifying the region."
(let ((glyph-len (lgstring-glyph-len gstring))
(last-char (lgstring-char gstring
(1- (lgstring-char-len gstring))))
- (i 0)
- glyph)
+ (i 0)) ;; glyph
(while (and (< i glyph-len)
- (setq glyph (lgstring-glyph gstring i)))
+ ;; (setq glyph
+ (lgstring-glyph gstring i)) ;; )
(setq i (1+ i)))
(if (= last-char ?ำ)
(setq i (1- i)))
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index 94c6ab9..ff1e802 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -1,4 +1,4 @@
-;;; thai-word.el -- find Thai word boundaries
+;;; thai-word.el -- find Thai word boundaries -*- lexical-binding: t; -*-
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -10973,8 +10973,7 @@ If COUNT is negative, move point backward (- COUNT)
words."
;; special instead of using forward-word.
(let ((start (point))
(limit (match-end 0))
- boundaries
- tail)
+ boundaries) ;; tail
;; If thai-forward-word has been called within a Thai
;; region, we must go back until the Thai region starts
;; to do the contextual analysis for finding word
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index e741af1..ddf4a0c 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -1,4 +1,4 @@
-;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*-
+;;; tibet-util.el --- utilities for Tibetan -*- 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,
@@ -126,42 +126,42 @@ The returned string has no composition information."
(setq t-str-list (cons (substring str idx) t-str-list)))
(apply 'concat (nreverse t-str-list))))
-;;;
+;;
;;; Functions for composing/decomposing Tibetan sequence.
-;;;
-;;; A Tibetan syllable is typically structured as follows:
-;;;
-;;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
-;;;
-;;; where C's are all vertically stacked, V appears below or above
-;;; consonant cluster and M is always put above the C[C+]V combination.
-;;; (Sanskrit visarga, though it is a vowel modifier, is considered
-;;; to be a punctuation.)
-;;;
-;;; Here are examples of the words "bsgrubs" and "hfauM"
-;;;
-;;; བསྒྲུབས ཧཱུཾ
-;;;
-;;; M
-;;; b s b s h
-;;; g fa
-;;; r u
-;;; u
-;;;
-;;; Consonants `'' (འ), `w' (ཝ), `y' (ཡ), `r' (ར) take special
-;;; forms when they are used as subjoined consonant. Consonant `r'
-;;; takes another special form when used as superjoined in such a case
-;;; as "rka", while it does not change its form when conjoined with
-;;; subjoined `'', `w' or `y' as in "rwa", "rya".
-
-;; Append a proper composition rule and glyph to COMPONENTS to compose
-;; CHAR with a composition that has COMPONENTS.
+;;
+;; A Tibetan syllable is typically structured as follows:
+;;
+;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
+;;
+;; where C's are all vertically stacked, V appears below or above
+;; consonant cluster and M is always put above the C[C+]V combination.
+;; (Sanskrit visarga, though it is a vowel modifier, is considered
+;; to be a punctuation.)
+;;
+;; Here are examples of the words "bsgrubs" and "hfauM"
+;;
+;; བསྒྲུབས ཧཱུཾ
+;;
+;; M
+;; b s b s h
+;; g fa
+;; r u
+;; u
+;;
+;; Consonants `'' (འ), `w' (ཝ), `y' (ཡ), `r' (ར) take special
+;; forms when they are used as subjoined consonant. Consonant `r'
+;; takes another special form when used as superjoined in such a case
+;; as "rka", while it does not change its form when conjoined with
+;; subjoined `'', `w' or `y' as in "rwa", "rya".
+
+; Append a proper composition rule and glyph to COMPONENTS to compose
+; CHAR with a composition that has COMPONENTS.
(defun tibetan-add-components (components char)
(let ((last (last components))
(stack-upper '(tc . bc))
(stack-under '(bc . tc))
- rule comp-vowel tmp)
+ rule comp-vowel)
;; Special treatment for 'a chung.
;; If 'a follows a consonant, turn it into the subjoined form.
;; * Disabled by Tomabechi 2000/06/09 *
@@ -246,7 +246,7 @@ The returned string has no composition information."
(defun tibetan-compose-region (beg end)
"Compose Tibetan text the region BEG and END."
(interactive "r")
- (let (str result chars)
+ ;; (let (str result chars)
(save-excursion
(save-restriction
(narrow-to-region beg end)
@@ -272,7 +272,7 @@ The returned string has no composition information."
(while (< (point) to)
(tibetan-add-components components (following-char))
(forward-char 1))
- (compose-region from to components)))))))
+ (compose-region from to components)))))) ;; )
(defvar tibetan-decompose-precomposition-alist
(mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x)))
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index edd9d76..48c7638 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -605,7 +605,7 @@ This also matches some punctuation characters which need
conversion.")
;; For automatic composition.
(set-char-table-range
composition-function-table '(#xF00 . #xFD1)
- (list (vector tibetan-composable-pattern 0 'font-shape-gstring)))
+ (list (vector tibetan-composable-pattern 0 #'font-shape-gstring)))
(provide 'tibetan)
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index 7ce8ee1..1a530d3 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -1,4 +1,4 @@
-;;; tv-util.el --- support for Tai Viet -*- coding:
utf-8 -*-
+;;; tv-util.el --- support for Tai Viet -*- lexical-binding: t;
-*-
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -128,7 +128,7 @@
;;;###autoload
-(defun tai-viet-composition-function (from to font-object string _direction)
+(defun tai-viet-composition-function (from _to _font-object string _direction)
(if string
(if (string-match tai-viet-re string from)
(tai-viet-compose-string from (match-end 0) string))
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index 177b04b..bfaf0f3 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -1,4 +1,4 @@
-;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*-
+;;; viet-util.el --- utilities for Vietnamese -*- 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/leim/quail/compose.el b/lisp/leim/quail/compose.el
index f7ac83a..264a9b4 100644
--- a/lisp/leim/quail/compose.el
+++ b/lisp/leim/quail/compose.el
@@ -1,4 +1,4 @@
-;;; compose.el --- Quail package for Multi_key character composition
-*-coding: utf-8;-*-
+;;; compose.el --- Quail package for Multi_key character composition
-*-coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
diff --git a/lisp/leim/quail/viqr.el b/lisp/leim/quail/viqr.el
index b7591b1..d127ff2 100644
--- a/lisp/leim/quail/viqr.el
+++ b/lisp/leim/quail/viqr.el
@@ -1,4 +1,4 @@
-;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system
-*-coding: utf-8;-*-
+;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system
-*-coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 9f6fd6d..d2601c3 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -104,7 +104,9 @@ being sent is used), or nil (in which case the value of
(defcustom mail-self-blind nil
"Non-nil means insert Bcc to self in messages to be sent.
This is done when the message is initialized,
-so you can remove or alter the Bcc field to override the default."
+so you can remove or alter the Bcc field to override the default.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead."
:type 'boolean)
;;;###autoload
@@ -172,14 +174,18 @@ This is used by the default mail-sending commands. See
also
(defcustom mail-archive-file-name nil
"Name of file to write all outgoing messages in, or nil for none.
This is normally an mbox file, but for backwards compatibility may also
-be a Babyl file."
+be a Babyl file.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead."
:type '(choice file (const nil)))
;;;###autoload
(defcustom mail-default-reply-to nil
"Address to insert as default Reply-To field of outgoing messages.
If nil, it will be initialized from the REPLYTO environment variable
-when you first send mail."
+when you first send mail.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead."
:type '(choice (const nil) string))
(defcustom mail-alias-file nil
@@ -388,7 +394,9 @@ in `message-auto-save-directory'."
(defcustom mail-default-headers nil
"A string containing header lines, to be inserted in outgoing messages.
It can contain newlines, and should end in one. It is inserted
-before you edit the message, so you can edit or delete the lines."
+before you edit the message, so you can edit or delete the lines.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead."
:type '(choice (const nil) string))
(defcustom mail-bury-selects-summary t
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 00b9680..7cbd42c 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -125,10 +125,9 @@ With non-nil FORCE, the update is always carried out."
;; Otherwise on to your regular programming
(t t)))
-(defun mh-speed-toggle (&rest ignored)
+(defun mh-speed-toggle (&rest _ignored)
"Toggle the display of child folders in the speedbar.
The optional arguments from speedbar are IGNORED."
- (declare (ignore args))
(interactive)
(beginning-of-line)
(let ((parent (get-text-property (point) 'mh-folder))
@@ -164,10 +163,9 @@ The optional arguments from speedbar are IGNORED."
(mh-line-beginning-position) (1+ (line-beginning-position))
'(mh-expanded t)))))))
-(defun mh-speed-view (&rest ignored)
+(defun mh-speed-view (&rest _ignored)
"Visits the selected folder just as if you had used
\\<mh-folder-mode-map>\\[mh-visit-folder].
The optional arguments from speedbar are IGNORED."
- (declare (ignore args))
(interactive)
(let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder))
(range (and (stringp folder)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 9559b12..fa13dd5 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -2547,7 +2547,7 @@ can parse the output from a DIR listing for a host of
type TYPE.")
FILE is the full name of the remote file, LSARGS is any args to pass to the
`ls' command, and PARSE specifies that the output should be parsed and stored
away in the internal cache."
- (when (string-match "^--dired\\s-+" lsargs)
+ (while (string-match "^--dired\\s-+" lsargs)
(setq lsargs (replace-match "" nil t lsargs)))
;; If parse is t, we assume that file is a directory. i.e. we only parse
;; full directory listings.
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 7a7bbef..195ddc6 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -2079,6 +2079,7 @@ daemon, it is rather the timestamp the corresponding
D-Bus event
has been handled by this function."
(with-current-buffer (get-buffer-create "*D-Bus Monitor*")
(special-mode)
+ (buffer-disable-undo)
;; Move forward and backward between messages.
(local-set-key [?n] #'forward-paragraph)
(local-set-key [?p] #'backward-paragraph)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d131b2b..e39a4c3 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1050,9 +1050,16 @@ the like."
;; multi-page isearch support
(setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer)
(setq truncate-lines t)
+ (setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . eww--url-at-point))))
(buffer-disable-undo)
(setq buffer-read-only t))
+(defun eww--url-at-point ()
+ "`thing-at-point' provider function."
+ (get-text-property (point) 'shr-url))
+
;;;###autoload
(defun eww-browse-url (url &optional new-window)
"Ask the EWW browser to load URL.
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index bc2612d..4022a35 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,4 +1,4 @@
-;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
+;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework -*-
lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index efc8f82..5afc195 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,4 +1,4 @@
-;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
+;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -*-
lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index 6658226..dfb7e71 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,4 +1,4 @@
-;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
+;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client
framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
@@ -40,7 +40,7 @@
"A list of functions to be called in sequence for the NTLM
authentication steps. They are called by `sasl-next-step'.")
-(defun sasl-ntlm-request (client step)
+(defun sasl-ntlm-request (client _step)
"SASL step function to generate a NTLM authentication request to the server.
Called from `sasl-next-step'.
CLIENT is a vector [mechanism user service server sasl-client-properties]
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 7f0431a..b7f814f 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,4 +1,4 @@
-;;; sasl.el --- SASL client framework
+;;; sasl.el --- SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
@@ -161,15 +161,8 @@ the current challenge. At the first time STEP should be
set to nil."
(if function
(vector function (funcall function client step)))))
-(defvar sasl-read-passphrase nil)
+(defvar sasl-read-passphrase 'read-passwd)
(defun sasl-read-passphrase (prompt)
- (if (not sasl-read-passphrase)
- (if (functionp 'read-passwd)
- (setq sasl-read-passphrase 'read-passwd)
- (if (load "passwd" t)
- (setq sasl-read-passphrase 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
(funcall sasl-read-passphrase prompt))
(defun sasl-unique-id ()
@@ -210,7 +203,7 @@ It contain at least 64 bits of entropy."
(defconst sasl-plain-steps
'(sasl-plain-response))
-(defun sasl-plain-response (client step)
+(defun sasl-plain-response (client _step)
(let ((passphrase
(sasl-read-passphrase
(format "PLAIN passphrase for %s: " (sasl-client-name client))))
@@ -236,12 +229,12 @@ It contain at least 64 bits of entropy."
sasl-login-response-1
sasl-login-response-2))
-(defun sasl-login-response-1 (client step)
+(defun sasl-login-response-1 (client _step)
;;; (unless (string-match "^Username:" (sasl-step-data step))
;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-client-name client))
-(defun sasl-login-response-2 (client step)
+(defun sasl-login-response-2 (client _step)
;;; (unless (string-match "^Password:" (sasl-step-data step))
;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-read-passphrase
@@ -257,7 +250,7 @@ It contain at least 64 bits of entropy."
'(ignore ;no initial response
sasl-anonymous-response))
-(defun sasl-anonymous-response (client step)
+(defun sasl-anonymous-response (client _step)
(or (sasl-client-property client 'trace)
(sasl-client-name client)))
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index fbc4e75..7bc1d16 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -128,6 +128,9 @@
(modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "_" st)
(modify-syntax-entry ?\' "\"" st)
+ (modify-syntax-entry ?\{ "(}" st)
+ (modify-syntax-entry ?\} "){" st)
+ (modify-syntax-entry ?\" "\"" st)
st)
"Syntax table in use in sieve-mode buffers.")
@@ -178,12 +181,8 @@
'syntax-table (string-to-syntax "|")))))
;;;###autoload
-(define-derived-mode sieve-mode c-mode "Sieve"
+(define-derived-mode sieve-mode prog-mode "Sieve"
"Major mode for editing Sieve code.
-This is much like C mode except for the syntax of comments. Its keymap
-inherits from C mode's and it has the same variables for customizing
-indentation. It has its own abbrev table and its own syntax table.
-
Turning on Sieve mode runs `sieve-mode-hook'."
(setq-local paragraph-start (concat "$\\|" page-delimiter))
(setq-local paragraph-separate paragraph-start)
@@ -194,8 +193,17 @@ Turning on Sieve mode runs `sieve-mode-hook'."
(setq-local syntax-propertize-function #'sieve-syntax-propertize)
(setq-local font-lock-defaults
'(sieve-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq-local indent-line-function #'sieve-mode-indent-function)
(easy-menu-add-item nil nil sieve-mode-menu))
+(defun sieve-mode-indent-function ()
+ (save-excursion
+ (beginning-of-line)
+ (let ((depth (car (syntax-ppss))))
+ (when (looking-at "[ \t]*}")
+ (setq depth (1- depth)))
+ (indent-line-to (* 2 depth)))))
+
(provide 'sieve-mode)
;; sieve-mode.el ends here
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2c4ef2a..73dffe1 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -636,7 +636,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(copy-directory filename newname keep-date t)
(let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
+ (t2 (tramp-tramp-file-p newname))
+ ;; We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t.
+ (jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
(tramp-error
@@ -717,7 +720,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(delete-directory filename 'recursive))
(let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
+ (t2 (tramp-tramp-file-p newname))
+ ;; We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t.
+ (jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
(tramp-error
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 618a9fb..2274efd 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -181,10 +181,9 @@ The string is used in `tramp-methods'.")
`("scpx"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("-t" "-t") ("%h")
- ("%l")))
+ ("-e" "none") ("-t" "-t")
+ ("-o" "RemoteCommand='%l'")
("%h")))
(tramp-async-args (("-q")))
- (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -238,10 +237,9 @@ The string is used in `tramp-methods'.")
`("sshx"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("-t" "-t") ("%h")
- ("%l")))
+ ("-e" "none") ("-t" "-t")
+ ("-o" "RemoteCommand='%l'")
("%h")))
(tramp-async-args (("-q")))
- (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
@@ -1710,6 +1708,12 @@ ID-FORMAT valid values are `string' and `integer'."
(= (tramp-compat-file-attribute-user-id attributes)
(tramp-get-remote-uid v 'integer))
(or (not group)
+ ;; On BSD-derived systems files always inherit the
+ ;; parent directory's group, so skip the group-gid
+ ;; test.
+ (string-match-p
+ "BSD\\|DragonFly\\|Darwin"
+ (tramp-get-connection-property v "uname" ""))
(= (tramp-compat-file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
@@ -2619,11 +2623,8 @@ The method used must be an out-of-band method."
filename switches wildcard full-directory-p)
(when (stringp switches)
(setq switches (split-string switches)))
- (when (tramp-get-ls-command-with ;FIXME: tramp-sh--quoting-style-options?
- v "--quoting-style=literal --show-control-chars")
- (setq switches
- (append
- switches '("--quoting-style=literal" "--show-control-chars"))))
+ (setq switches
+ (append switches (split-string (tramp-sh--quoting-style-options
v))))
(unless (tramp-get-ls-command-with v "--dired")
(setq switches (delete "--dired" switches)))
(when wildcard
@@ -5124,7 +5125,7 @@ connection if a previous connection has died for some
reason."
options (format-spec options spec)
spec (format-spec-make
?h l-host ?u l-user ?p l-port ?c options
- ?l (concat remote-shell " " extra-args))
+ ?l (concat remote-shell " " extra-args " -i"))
command
(concat
;; We do not want to see the trailing local
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 1604e89..c5a74a5 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -156,6 +156,7 @@ this variable (\"client min protocol=NT1\") ."
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_NOT_A_DIRECTORY"
+ "NT_STATUS_NOT_SUPPORTED"
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
@@ -371,17 +372,17 @@ pass to the OPERATION."
(tramp-error
v2 'file-error
"add-name-to-file: %s must not be a directory" filename))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- v2-localname)))))
- (tramp-error v2 'file-already-exists newname)
- (delete-file newname)))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v2 v2-localname)
@@ -1166,7 +1167,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(insert " -> " (tramp-compat-file-attribute-type attr))))
(insert "\n")
- (forward-line)
(beginning-of-line)))
entries))))))
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index e5941ae..1fa625c 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -96,9 +96,6 @@
("DuckDuckGo" .
[simple-query "duckduckgo.com"
"duckduckgo.com/?q=" ""])
- ("Google" .
- [simple-query "www.google.com"
- "www.google.com/search?q=" ""])
("Google Groups" .
[simple-query "groups.google.com"
"groups.google.com/groups?q=" ""])
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 5d0d105..ea47eec 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -832,12 +832,17 @@ Ensure that `comment-normalize-vars' has been called
before you use this."
(when (and (stringp str) (string-match "\\S-" str))
;; Separate the actual string from any leading/trailing padding
(string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
- (let ((s (match-string 1 str)) ;actual string
+ (let ((s (match-string 1 str)) ;actual string
(lpad (substring str 0 (match-beginning 1))) ;left padding
- (rpad (concat (substring str (match-end 1)) ;original right padding
- (substring comment-padding ;additional right padding
- (min (- (match-end 0) (match-end 1))
- (length comment-padding)))))
+ (rpad (concat
+ (substring str (match-end 1)) ;original right padding
+ (if (numberp comment-padding)
+ (make-string (min comment-padding
+ (- (match-end 0) (match-end 1)))
+ ?\s)
+ (substring comment-padding ;additional right padding
+ (min (- (match-end 0) (match-end 1))
+ (length comment-padding))))))
;; We can only duplicate C if the comment-end has multiple chars
;; or if comments can be nested, else the comment-end `}' would
;; be turned into `}}}' where only the first ends the comment
@@ -852,7 +857,7 @@ Ensure that `comment-normalize-vars' has been called before
you use this."
(concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
lpad "") ;padding is not required
(regexp-quote s)
- (when multi "+") ;the last char of S might be repeated
+ (when multi "+") ;the last char of S might be repeated
(mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
rpad "")))))) ;padding is not required
@@ -1221,21 +1226,33 @@ changed with `comment-style'."
;; FIXME: maybe we should call uncomment depending on ARG.
(funcall comment-region-function beg end arg)))
-(defun comment-region-default-1 (beg end &optional arg)
+(defun comment-region-default-1 (beg end &optional arg noadjust)
+ "Comment region between BEG and END.
+See `comment-region' for ARG. If NOADJUST, do not skip past
+leading/trailing space when determining the region to comment
+out."
(let* ((numarg (prefix-numeric-value arg))
(style (cdr (assoc comment-style comment-styles)))
(lines (nth 2 style))
(block (nth 1 style))
(multi (nth 0 style)))
- ;; We use `chars' instead of `syntax' because `\n' might be
- ;; of end-comment syntax rather than of whitespace syntax.
- ;; sanitize BEG and END
- (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
- (setq beg (max beg (point)))
- (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
- (setq end (min end (point)))
- (if (>= beg end) (error "Nothing to comment"))
+ (if noadjust
+ (when (bolp)
+ (setq end (1- end)))
+ ;; We use `chars' instead of `syntax' because `\n' might be
+ ;; of end-comment syntax rather than of whitespace syntax.
+ ;; sanitize BEG and END
+ (goto-char beg)
+ (skip-chars-forward " \t\n\r")
+ (beginning-of-line)
+ (setq beg (max beg (point)))
+ (goto-char end)
+ (skip-chars-backward " \t\n\r")
+ (end-of-line)
+ (setq end (min end (point)))
+ (when (>= beg end)
+ (error "Nothing to comment")))
;; sanitize LINES
(setq lines
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 59465c3..a20e950 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,4 +1,4 @@
-;;; rng-util.el --- utility functions for RELAX NG library
+;;; rng-util.el --- utility functions for RELAX NG library -*-
lexical-binding: t; -*-
;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 0b7d1e4..147efed 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -504,6 +504,7 @@ Add an entry here when adding a new search engine.")
,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-engines)))))
+
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
"Construct a result vector and add it to ARTLIST.
DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index d1db168..994e30f 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -376,9 +376,9 @@ changes to the current buffer."
Shell links can be dangerous: just think about a link
- [[shell:rm -rf ~/*][Google Search]]
+ [[shell:rm -rf ~/*][Web Search]]
-This link would show up in your Org document as \"Google Search\",
+This link would show up in your Org document as \"Web Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
@@ -401,9 +401,9 @@ single keystroke rather than having to type \"yes\"."
"Non-nil means ask for confirmation before executing Emacs Lisp links.
Elisp links can be dangerous: just think about a link
- [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
+ [[elisp:(shell-command \"rm -rf ~/*\")][Web Search]]
-This link would show up in your Org document as \"Google Search\",
+This link would show up in your Org document as \"Web Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 43aa0a1..2d21a44 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1846,7 +1846,7 @@ link types. The types are:
bracket The recommended [[link][description]] or [[link]] links with hiding.
angle Links in angular brackets that may contain whitespace like
<bbdb:Carsten Dominik>.
-plain Plain links in normal text, no whitespace, like http://google.com.
+plain Plain links in normal text, no whitespace, like https://gnu.org.
radio Text that is matched by a radio target, see manual for details.
tag Tag settings in a headline (link to tag search).
date Time stamps (link to calendar).
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 7ad3de6..98da26c 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,8 +1,9 @@
-;;; handwrite.el --- turns your emacs buffer into a handwritten document
+;;; handwrite.el --- turns your emacs buffer into a handwritten document -*-
lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
+;; Maintainer: emacs-devel@gnu.org
;; Created: October 21 1996
;; Keywords: wp, print, postscript, cursive writing
@@ -22,11 +23,11 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
+
+;; The function `handwrite' creates PostScript output containing a
+;; handwritten version of the current buffer.
;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; The function handwrite creates PostScript output containing a
-;; handwritten version of the current buffer..
-;; Other functions that may be useful are
+;; Other functions that may be useful are:
;;
;; handwrite-10pt: sets the font size to 10 and finds corresponding
;; values for the line spacing and the number of lines
@@ -54,8 +55,6 @@
;; unknown characters.
;;
;; Thanks to anyone who emailed me suggestions!
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
;;; Code:
@@ -64,7 +63,6 @@
(defvar ps-lpr-command)
(defvar ps-lpr-switches)
-
;; Variables
(defgroup handwrite nil
@@ -98,44 +96,43 @@
(defcustom handwrite-numlines 60
"The number of lines on a page of the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-fontsize 11
"The size of the font for the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-linespace 12
"The spacing for the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-xstart 30
"X-axis translation in the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-ystart 810
"Y-axis translation in the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-pagenumbering nil
"If non-nil, number each page of the PostScript output from `handwrite'."
- :type 'boolean
- :group 'handwrite)
+ :type 'boolean)
+
(defcustom handwrite-10pt-numlines 65
"The number of lines on a page for the function `handwrite-10pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-11pt-numlines 60
"The number of lines on a page for the function `handwrite-11pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-12pt-numlines 55
"The number of lines on a page for the function `handwrite-12pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-13pt-numlines 50
"The number of lines on a page for the function `handwrite-13pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
;; Interactive functions
@@ -150,17 +147,17 @@ Variables: `handwrite-linespace' (default 12)
`handwrite-numlines' (default 60)
`handwrite-pagenumbering' (default nil)"
(interactive)
+ (setq handwrite-psindex (1+ handwrite-psindex))
(let
- (;(pmin) ; thanks, Havard
- (cur-buf (current-buffer))
+ ((cur-buf (current-buffer))
(tpoint (point))
(ps-ypos 63)
(lcount 0)
(ipage 1)
- (nlan next-line-add-newlines) ;remember the old value
+ (next-line-add-newlines t)
(buf-name (buffer-name) )
(textp)
- (ps-buf-name) ;name of the PostScript buffer
+ (ps-buf-name (format "*handwritten%d.ps*" handwrite-psindex))
(trans-table
'(("ÿ" . "264") ("á" . "207") ("à" . "210") ("â" . "211")
("ä" . "212") ("ã" . "213") ("å" . "214") ("é" . "216")
@@ -175,10 +172,6 @@ Variables: `handwrite-linespace' (default 12)
; on inserted backslashes
line)
(goto-char (point-min)) ;start at beginning
- (setq handwrite-psindex (1+ handwrite-psindex))
- (setq ps-buf-name
- (format "*handwritten%d.ps*" handwrite-psindex))
- (setq next-line-add-newlines t)
(switch-to-buffer ps-buf-name)
(handwrite-insert-header buf-name)
(insert "%%Creator: GNU Emacs's handwrite version " emacs-version "\n")
@@ -258,9 +251,7 @@ Variables: `handwrite-linespace' (default 12)
(message "")
(bury-buffer ())
(switch-to-buffer cur-buf)
- (goto-char tpoint)
- (setq next-line-add-newlines nlan)
- ))
+ (goto-char tpoint)))
(defun handwrite-set-pagenumber ()
@@ -280,7 +271,6 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(setq handwrite-numlines handwrite-10pt-numlines)
(message "Handwrite output size set to 10 points"))
-
(defun handwrite-11pt ()
"Specify 11-point output for `handwrite'.
This sets `handwrite-fontsize' to 11 and finds correct
@@ -1238,28 +1228,16 @@ end
/Joepie Hwfdict definefont
%%EndFont Joepie\n\n"))
-;;Sets page numbering off
(defun handwrite-set-pagenumber-off ()
+ "Set page numbering off."
(setq handwrite-pagenumbering nil)
(message "page numbering off"))
-;;Sets page numbering on
(defun handwrite-set-pagenumber-on ()
+ "Set page numbering on."
(setq handwrite-pagenumbering t)
(message "page numbering on" ))
-
-;; Key bindings
-
-;; I'd rather not fill up the menu bar menus with
-;; lots of random miscellaneous features. -- rms.
-;;;(define-key-after
-;;; (lookup-key global-map [menu-bar edit])
-;;; [handwrite]
-;;; '("Write by hand" . menu-bar-handwrite-map)
-;;; 'spell)
-
(provide 'handwrite)
-
;;; handwrite.el ends here
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 7fff604..838bddf 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -1,4 +1,4 @@
-;;; mpuz.el --- multiplication puzzle for GNU Emacs
+;;; mpuz.el --- multiplication puzzle for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1990, 2001-2021 Free Software Foundation, Inc.
@@ -40,49 +40,41 @@
The value t means never ding, and `error' means only ding on wrong input."
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t)
- (const :tag "If correct" error))
- :group 'mpuz)
+ (const :tag "If correct" error)))
(defcustom mpuz-solve-when-trivial t
"Solve any row that can be trivially calculated from what you've found."
- :type 'boolean
- :group 'mpuz)
+ :type 'boolean)
(defcustom mpuz-allow-double-multiplicator nil
"Allow 2nd factors like 33 or 77."
- :type 'boolean
- :group 'mpuz)
+ :type 'boolean)
(defface mpuz-unsolved
'((default :weight bold)
(((class color)) :foreground "red1"))
- "Face for letters to be solved."
- :group 'mpuz)
+ "Face for letters to be solved.")
(defface mpuz-solved
'((default :weight bold)
(((class color)) :foreground "green1"))
- "Face for solved digits."
- :group 'mpuz)
+ "Face for solved digits.")
(defface mpuz-trivial
'((default :weight bold)
(((class color)) :foreground "blue"))
- "Face for trivial digits solved for you."
- :group 'mpuz)
+ "Face for trivial digits solved for you.")
(defface mpuz-text
'((t :inherit variable-pitch))
- "Face for text on right."
- :group 'mpuz)
+ "Face for text on right.")
;; Mpuz mode and keymaps
;;----------------------
(defcustom mpuz-mode-hook nil
"Hook to run upon entry to mpuz."
- :type 'hook
- :group 'mpuz)
+ :type 'hook)
(defvar mpuz-mode-map
(let ((map (make-sparse-keymap)))
@@ -341,8 +333,8 @@ You may abort a game by typing
\\<mpuz-mode-map>\\[mpuz-offer-abort]."
(defun mpuz-switch-to-window ()
"Find or create the Mult-Puzzle buffer, and display it."
- (let ((buf (mpuz-get-buffer)))
- (or buf (setq buf (mpuz-create-buffer)))
+ (let ((buf (or (mpuz-get-buffer)
+ (mpuz-create-buffer))))
(switch-to-buffer buf)
(setq buffer-read-only t)
(mpuz-mode)))
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 62ff783..99b2ec6 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -141,8 +141,7 @@ Special commands:
(setq-local comment-add 1)
(setq-local comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*")
(setq-local comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)")
- (setq-local comment-end "")
- (setq fill-prefix "\t"))
+ (setq-local comment-end ""))
(defun asm-indent-line ()
"Auto-indent the current line."
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 44295c3..7ba8a69 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -1,4 +1,4 @@
-;;; bat-mode.el --- Major mode for editing DOS/Windows scripts
+;;; bat-mode.el --- Major mode for editing DOS/Windows scripts -*-
lexical-binding: t -*-
;; Copyright (C) 2003, 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 94e4f3c..2c1e6ff 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -3041,7 +3041,12 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if
given."
;; Get the specified directory from FILE.
(spec-directory
(if (cdr file)
- (file-truename (concat comint-file-name-prefix (cdr file))))))
+ ;; This function is active in `compilation-filter'.
+ ;; There could be problems to call `file-truename'
+ ;; for remote compilation processes.
+ (if (file-remote-p default-directory)
+ (concat comint-file-name-prefix (cdr file))
+ (file-truename (concat comint-file-name-prefix (cdr
file)))))))
;; Check for a comint-file-name-prefix and prepend it if appropriate.
;; (This is very useful for compilation-minor-mode in an rlogin-mode
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 460af71..5d96c62 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -352,12 +352,20 @@ diagnostics at BEG."
(flymake--diag-accessor flymake-diagnostic-data flymake--diag-data backend)
(defun flymake-diagnostic-beg (diag)
- "Get Flymake diagnostic DIAG's start position."
- (overlay-start (flymake--diag-overlay diag)))
+ "Get Flymake diagnostic DIAG's start position.
+This position only be queried after DIAG has been reported to Flymake."
+ (let ((overlay (flymake--diag-overlay diag)))
+ (unless overlay
+ (error "DIAG %s not reported to Flymake yet" diag))
+ (overlay-start overlay)))
(defun flymake-diagnostic-end (diag)
- "Get Flymake diagnostic DIAG's end position."
- (overlay-end (flymake--diag-overlay diag)))
+ "Get Flymake diagnostic DIAG's end position.
+This position only be queried after DIAG has been reported to Flymake."
+ (let ((overlay (flymake--diag-overlay diag)))
+ (unless overlay
+ (error "DIAG %s not reported to Flymake yet" diag))
+ (overlay-end overlay)))
(cl-defun flymake--overlays (&key beg end filter compare key)
"Get flymake-related overlays.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index d047dd5..0120e4a 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -143,7 +143,7 @@
'(;; Functions
(nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1)
;;Variables
- ("Variables" "^[
\t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*="
1)
+ ("Variables" "^[
\t]*\\(?:has\\|local\\|my\\|our\\|state\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*="
1)
("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1)
("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
"Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
@@ -188,9 +188,8 @@
"\\>")
;;
;; Fontify declarators and prefixes as types.
-
("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" .
font-lock-type-face) ; declarators
- ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes
- ;;
+ ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-type-face) ;
declarators
+ ;;
;; Fontify function, variable and file name references.
("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 768cd58..fc5e301 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,8 +1,8 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
-;; Version: 0.5.3
-;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
+;; Version: 0.5.4
+;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
;; not compatible with the version of Emacs recorded above.
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index cc045a1..fd68952 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1957,12 +1957,18 @@ May return nil if the line should not be treated as
continued."
('(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt)
(sh-var-value 'sh-indent-for-case-label)))
(`(:before . ,(or "(" "{" "[" "while" "if" "for" "case"))
- (if (not (smie-rule-prev-p "&&" "||" "|"))
- (when (smie-rule-hanging-p)
- (smie-rule-parent))
+ (cond
+ ((and (equal token "{") (smie-rule-parent-p "for"))
+ (let ((data (smie-backward-sexp "in")))
+ (when (equal (nth 2 data) "for")
+ `(column . ,(smie-indent-virtual)))))
+ ((not (smie-rule-prev-p "&&" "||" "|"))
+ (when (smie-rule-hanging-p)
+ (smie-rule-parent)))
+ (t
(unless (smie-rule-bolp)
(while (equal "|" (nth 2 (smie-backward-sexp 'halfexp))))
- `(column . ,(smie-indent-virtual)))))
+ `(column . ,(smie-indent-virtual))))))
;; FIXME: Maybe this handling of ;; should be made into
;; a smie-rule-terminator function that takes the substitute ";" as arg.
(`(:before . ,(or ";;" ";&" ";;&"))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index aecb30a..18fdd96 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Version: 1.0.4
-;; Package-Requires: ((emacs "26.3"))
+;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
@@ -967,16 +967,16 @@ Return an alist of the form ((FILENAME . (XREF ...))
...)."
(let ((inhibit-read-only t)
(buffer-undo-list t))
(save-excursion
- (erase-buffer)
(condition-case err
- (xref--insert-xrefs
- (xref--analyze (funcall xref--fetcher)))
+ (let ((alist (xref--analyze (funcall xref--fetcher))))
+ (erase-buffer)
+ (xref--insert-xrefs alist))
(user-error
+ (erase-buffer)
(insert
(propertize
(error-message-string err)
- 'face 'error))))
- (goto-char (point-min)))))
+ 'face 'error)))))))
(defun xref-show-definitions-buffer (fetcher alist)
"Show the definitions list in a regular window.
diff --git a/lisp/recentf.el b/lisp/recentf.el
index a28a397..d39a523 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1352,7 +1352,14 @@ That is, remove duplicates, non-kept, and excluded
files."
When Recentf mode is enabled, a \"Open Recent\" submenu is
displayed in the \"File\" menu, containing a list of files that
-were operated on recently, in the most-recently-used order."
+were operated on recently, in the most-recently-used order.
+
+By default, only operations like opening a file, writing a buffer
+to a file, and killing a buffer is counted as \"operating\" on
+the file. If instead you want to prioritize files that appear in
+buffers you switch to a lot, you can say something like the following:
+
+ (add-hook 'buffer-list-update-hook 'recentf-track-opened-file)"
:global t
:group 'recentf
:keymap recentf-mode-map
diff --git a/lisp/replace.el b/lisp/replace.el
index db5b340..f13d27a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -186,6 +186,21 @@ See `replace-regexp' and `query-replace-regexp-eval'.")
length)
length)))))
+(defun query-replace-read-from-suggestions ()
+ "Return a list of standard suggestions for `query-replace-read-from'.
+By default, the list includes the active region, the identifier
+(a.k.a. \"tag\") at point (see Info node `(emacs) Identifier Search'),
+the last isearch string, and the last replacement regexp.
+`query-replace-read-from' appends the list returned
+by this function to the end of values available via
+\\<minibuffer-local-map>\\[next-history-element]."
+ (delq nil (list (when (use-region-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))
+ (find-tag-default)
+ (car search-ring)
+ (car (symbol-value query-replace-from-history-variable)))))
+
(defun query-replace-read-from (prompt regexp-flag)
"Query and return the `from' argument of a query-replace operation.
Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp.
@@ -242,7 +257,8 @@ wants to replace FROM with TO."
(if regexp-flag
(read-regexp prompt nil 'minibuffer-history)
(read-from-minibuffer
- prompt nil nil nil nil (car search-ring) t)))))
+ prompt nil nil nil nil
+ (query-replace-read-from-suggestions) t)))))
(to))
(if (and (zerop (length from)) query-replace-defaults)
(cons (caar query-replace-defaults)
@@ -327,14 +343,15 @@ Prompt with PROMPT. REGEXP-FLAG non-nil means the
response should a regexp."
(defun query-replace-read-args (prompt regexp-flag &optional noerror)
(unless noerror
(barf-if-buffer-read-only))
- (let* ((from (query-replace-read-from prompt regexp-flag))
- (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
- (query-replace-read-to from prompt regexp-flag))))
- (list from to
- (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
- (and (plist-member (text-properties-at 0 from)
'isearch-regexp-function)
- (get-text-property 0 'isearch-regexp-function from)))
- (and current-prefix-arg (eq current-prefix-arg '-)))))
+ (save-mark-and-excursion
+ (let* ((from (query-replace-read-from prompt regexp-flag))
+ (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
+ (query-replace-read-to from prompt regexp-flag))))
+ (list from to
+ (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
+ (and (plist-member (text-properties-at 0 from)
'isearch-regexp-function)
+ (get-text-property 0 'isearch-regexp-function from)))
+ (and current-prefix-arg (eq current-prefix-arg '-))))))
(defun query-replace (from-string to-string &optional delimited start end
backward region-noncontiguous-p)
"Replace some occurrences of FROM-STRING with TO-STRING.
@@ -808,11 +825,16 @@ the function that you set this to can check
`this-command'."
(defun read-regexp-suggestions ()
"Return a list of standard suggestions for `read-regexp'.
-By default, the list includes the tag at point, the last isearch regexp,
-the last isearch string, and the last replacement regexp. `read-regexp'
-appends the list returned by this function to the end of values available
-via \\<minibuffer-local-map>\\[next-history-element]."
+By default, the list includes the active region, the identifier
+(a.k.a. \"tag\") at point (see Info node `(emacs) Identifier Search'),
+the last isearch regexp, the last isearch string, and the last
+replacement regexp. `read-regexp' appends the list returned
+by this function to the end of values available via
+\\<minibuffer-local-map>\\[next-history-element]."
(list
+ (when (use-region-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))
(find-tag-default-as-regexp)
(find-tag-default-as-symbol-regexp)
(car regexp-search-ring)
@@ -825,31 +847,35 @@ Prompt with the string PROMPT. If PROMPT ends in \":\"
(followed by
optional whitespace), use it as-is. Otherwise, add \": \" to the end,
possibly preceded by the default result (see below).
-The optional argument DEFAULTS can be either: nil, a string, a list
-of strings, or a symbol. We use DEFAULTS to construct the default
-return value in case of empty input.
+The optional argument DEFAULTS is used to construct the default
+return value in case of empty input. DEFAULTS can be nil, a string,
+a list of strings, or a symbol.
-If DEFAULTS is a string, we use it as-is.
+If DEFAULTS is a string, the function uses it as-is.
If DEFAULTS is a list of strings, the first element is the
default return value, but all the elements are accessible
using the history command \\<minibuffer-local-map>\\[next-history-element].
-If DEFAULTS is a non-nil symbol, then if `read-regexp-defaults-function'
-is non-nil, we use that in place of DEFAULTS in the following:
- If DEFAULTS is the symbol `regexp-history-last', we use the first
- element of HISTORY (if specified) or `regexp-history'.
- If DEFAULTS is a function, we call it with no arguments and use
- what it returns, which should be either nil, a string, or a list of strings.
+If DEFAULTS is the symbol `regexp-history-last', the default return
+value will be the first element of HISTORY. If HISTORY is omitted or
+nil, `regexp-history' is used instead.
+If DEFAULTS is a symbol with a function definition, it is called with
+no arguments and should return either nil, a string, or a list of
+strings, which will be used as above.
+Other symbol values for DEFAULTS are ignored.
+
+If `read-regexp-defaults-function' is non-nil, its value is used
+instead of DEFAULTS in the two cases described in the last paragraph.
-We append the standard values from `read-regexp-suggestions' to DEFAULTS
-before using it.
+Before using whatever value DEFAULTS yields, the function appends the
+standard values from `read-regexp-suggestions' to that value.
If the first element of DEFAULTS is non-nil (and if PROMPT does not end
-in \":\", followed by optional whitespace), we add it to the prompt.
+in \":\", followed by optional whitespace), DEFAULT is added to the prompt.
The optional argument HISTORY is a symbol to use for the history list.
-If nil, uses `regexp-history'."
+If nil, use `regexp-history'."
(let* ((defaults
(if (and defaults (symbolp defaults))
(cond
diff --git a/lisp/simple.el b/lisp/simple.el
index 2c6e391..742fc50 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -820,9 +820,10 @@ With ARG, perform this action that many times."
(delete-horizontal-space t)
(unless arg
(setq arg 1))
- (dotimes (_ arg)
- (newline nil t)
- (indent-according-to-mode)))
+ (let ((electric-indent-mode nil))
+ (dotimes (_ arg)
+ (newline nil t)
+ (indent-according-to-mode))))
(defun reindent-then-newline-and-indent ()
"Reindent current line, insert newline, then indent the new line.
@@ -832,7 +833,8 @@ In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (let ((pos (point)))
+ (let ((pos (point))
+ (electric-indent-mode nil))
;; Be careful to insert the newline before indenting the line.
;; Otherwise, the indentation might be wrong.
(newline)
@@ -2470,11 +2472,24 @@ previous element of the minibuffer history in the
minibuffer."
(save-excursion
(goto-char (1- prompt-end))
(current-column)))
- 0)
+ 1)
(current-column)))))
(condition-case nil
(with-no-warnings
- (previous-line arg))
+ (previous-line arg)
+ ;; Avoid moving point to the prompt
+ (when (< (point) (minibuffer-prompt-end))
+ ;; If there is minibuffer contents on the same line
+ (if (<= (minibuffer-prompt-end)
+ (save-excursion
+ (if (or truncate-lines (not line-move-visual))
+ (end-of-line)
+ (end-of-visual-line))
+ (point)))
+ ;; Move to the beginning of minibuffer contents
+ (goto-char (minibuffer-prompt-end))
+ ;; Otherwise, go to the previous history element
+ (signal 'beginning-of-buffer nil))))
(beginning-of-buffer
;; Restore old position since `line-move-visual' moves point to
;; the beginning of the line when it fails to go to the previous line.
@@ -3976,6 +3991,9 @@ impose the use of a shell (with its need to quote
arguments)."
(start-process-shell-command "Shell" buffer command)))
(setq mode-line-process '(":%s"))
(shell-mode)
+ (setq-local revert-buffer-function
+ (lambda (&rest _)
+ (async-shell-command command buffer)))
(set-process-sentinel proc #'shell-command-sentinel)
;; Use the comint filter for proper handling of
;; carriage motion (see comint-inhibit-carriage-motion).
@@ -4242,6 +4260,9 @@ characters."
buffer))))
;; Report the output.
(with-current-buffer buffer
+ (setq-local revert-buffer-function
+ (lambda (&rest _)
+ (shell-command command)))
(setq mode-line-process
(cond ((null exit-status)
" - Error")
diff --git a/lisp/startup.el b/lisp/startup.el
index 7011fbf..60e1a20 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -320,6 +320,8 @@ early init file.")
This variable is used to define the proper function and keypad
keys for use under X. It is used in a fashion analogous to the
environment variable TERM.")
+(make-obsolete-variable 'keyboard-type nil "28.1")
+(internal-make-var-non-special 'keyboard-type)
(defvar window-setup-hook nil
"Normal hook run after loading init files and handling the command line.
diff --git a/lisp/subr.el b/lisp/subr.el
index f249ec3..34129ea 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2965,8 +2965,6 @@ Also discard all previous input in the minibuffer."
(minibuffer-message "Wrong answer")
(sit-for 2)))
-(defvar empty-history)
-
(defun read-char-from-minibuffer (prompt &optional chars history)
"Read a character from the minibuffer, prompting for it with PROMPT.
Like `read-char', but uses the minibuffer to read and return a character.
@@ -2981,6 +2979,7 @@ while calling this function, then pressing `help-char'
causes it to evaluate `help-form' and display the result.
There is no need to explicitly add `help-char' to CHARS;
`help-char' is bound automatically to `help-form-show'."
+ (defvar empty-history)
(let* ((empty-history '())
(map (if (consp chars)
(or (gethash (list help-form (cons help-char chars))
@@ -3093,8 +3092,6 @@ Also discard all previous input in the minibuffer."
"Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'.
Otherwise, use the minibuffer.")
-(defvar empty-history)
-
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question.
Return t if answer is \"y\" and nil if it is \"n\".
@@ -3190,6 +3187,7 @@ is nil and `use-dialog-box' is non-nil."
(discard-input)))
(t
(setq prompt (funcall padded prompt))
+ (defvar empty-history)
(let* ((empty-history '())
(enable-recursive-minibuffers t)
(msg help-form)
@@ -4923,7 +4921,9 @@ file, FORM is evaluated immediately after the provide
statement.
Usually FILE is just a library name like \"font-lock\" or a feature name
like `font-lock'.
-This function makes or adds to an entry on `after-load-alist'."
+This function makes or adds to an entry on `after-load-alist'.
+
+See also `with-eval-after-load'."
(declare (compiler-macro
(lambda (whole)
(if (eq 'quote (car-safe form))
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 5f4dd9e..94e9d5c 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -120,6 +120,15 @@ The properties returned may include `top', `left',
`height', and `width'."
(define-key global-map [?\s-d] 'isearch-repeat-backward)
(define-key global-map [?\s-e] 'isearch-yank-kill)
(define-key global-map [?\s-f] 'isearch-forward)
+(define-key esc-map [?\s-f] 'isearch-forward-regexp)
+(define-key minibuffer-local-isearch-map [?\s-f]
+ 'isearch-forward-exit-minibuffer)
+(define-key isearch-mode-map [?\s-f] 'isearch-repeat-forward)
+(define-key global-map [?\s-F] 'isearch-backward)
+(define-key esc-map [?\s-F] 'isearch-backward-regexp)
+(define-key minibuffer-local-isearch-map [?\s-F]
+ 'isearch-reverse-exit-minibuffer)
+(define-key isearch-mode-map [?\s-F] 'isearch-repeat-backward)
(define-key global-map [?\s-g] 'isearch-repeat-forward)
(define-key global-map [?\s-h] 'ns-do-hide-emacs)
(define-key global-map [?\s-H] 'ns-do-hide-others)
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 8859f13..4a925cd 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,4 +1,4 @@
-;;; w32console.el -- Setup w32 console keys and colors.
+;;; w32console.el -- Setup w32 console keys and colors. -*- lexical-binding:
t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 8965785..fe70e92 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,4 +1,4 @@
-;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
+;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source -*-
lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
@@ -43,7 +43,6 @@
(defcustom nroff-electric-mode nil
"Non-nil means automatically closing requests when you insert an open."
- :group 'nroff
:type 'boolean)
(defvar nroff-mode-map
@@ -111,7 +110,7 @@
;; arguments in common cases, like \f.
(concat "\\\\" ; backslash
"\\(" ; followed by various possibilities
- (mapconcat 'identity
+ (mapconcat #'identity
'("[f*n]*\\[.+?]" ; some groff extensions
"(.." ; two chars after (
"[^(\"#]" ; single char escape
@@ -119,13 +118,11 @@
"\\)")
)
"Font-lock highlighting control in `nroff-mode'."
- :group 'nroff
:type '(repeat regexp))
(defcustom nroff-mode-hook nil
"Hook run by function `nroff-mode'."
- :type 'hook
- :group 'nroff)
+ :type 'hook)
;;;###autoload
(define-derived-mode nroff-mode text-mode "Nroff"
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 811a265..820ee38 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -415,7 +415,7 @@ The default emulates `current-time-string' for backward
compatibility."
"The function to format the remembered text.
The function receives the remembered text as argument and should
return the text to be remembered."
- :type 'function
+ :type '(choice (const nil) function)
:group 'remember
:version "28.1")
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index c4e4864..ce665e6 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1169,7 +1169,12 @@ subshell is initiated, `tex-shell-hook' is run."
(setq-local outline-regexp latex-outline-regexp)
(setq-local outline-level #'latex-outline-level)
(setq-local forward-sexp-function #'latex-forward-sexp)
- (setq-local skeleton-end-hook nil))
+ (setq-local skeleton-end-hook nil)
+ (setq-local comment-region-function #'latex--comment-region)
+ (setq-local comment-style 'plain))
+
+(defun latex--comment-region (beg end &optional arg)
+ (comment-region-default-1 beg end arg t))
;;;###autoload
(define-derived-mode slitex-mode latex-mode "SliTeX"
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 67d4092..c52fcfc 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -52,8 +52,30 @@
;;; Code:
+(require 'cl-lib)
(provide 'thingatpt)
+(defvar thing-at-point-provider-alist nil
+ "Alist of providers for returning a \"thing\" at point.
+This variable can be set globally, or appended to buffer-locally
+by modes, to provide functions that will return a \"thing\" at
+point. The first provider for the \"thing\" that returns a
+non-nil value wins.
+
+For instance, a major mode could say:
+
+\(setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ \\='((url . my-mode--url-at-point))))
+
+to provide a way to get an `url' at point in that mode. The
+provider functions are called with no parameters at the point in
+question.
+
+\"things\" include `symbol', `list', `sexp', `defun', `filename',
+`url', `email', `uuid', `word', `sentence', `whitespace', `line',
+and `page'.")
+
;; Basic movement
;;;###autoload
@@ -143,11 +165,18 @@ strip text properties from the return value.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
(let ((text
- (if (get thing 'thing-at-point)
- (funcall (get thing 'thing-at-point))
+ (cond
+ ((cl-loop for (pthing . function) in thing-at-point-provider-alist
+ when (eq pthing thing)
+ for result = (funcall function)
+ when result
+ return result))
+ ((get thing 'thing-at-point)
+ (funcall (get thing 'thing-at-point)))
+ (t
(let ((bounds (bounds-of-thing-at-point thing)))
(when bounds
- (buffer-substring (car bounds) (cdr bounds)))))))
+ (buffer-substring (car bounds) (cdr bounds))))))))
(when (and text no-properties (sequencep text))
(set-text-properties 0 (length text) nil text))
text))
diff --git a/lisp/tmm.el b/lisp/tmm.el
index e49246a..2040f52 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -56,12 +56,14 @@ to invoke `tmm-menubar' instead, customize the variable
`tty-menu-open-use-tmm' to a non-nil value."
(interactive)
(run-hooks 'menu-bar-update-hook)
- (let ((menu-bar (menu-bar-keymap))
- (menu-bar-item-cons (and x-position
- (menu-bar-item-at-x x-position))))
- (tmm-prompt menu-bar
- nil
- (and menu-bar-item-cons (car menu-bar-item-cons)))))
+ (if isearch-mode
+ (isearch-tmm-menubar)
+ (let ((menu-bar (menu-bar-keymap))
+ (menu-bar-item-cons (and x-position
+ (menu-bar-item-at-x x-position))))
+ (tmm-prompt menu-bar
+ nil
+ (and menu-bar-item-cons (car menu-bar-item-cons))))))
;;;###autoload
(defun tmm-menubar-mouse (event)
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index bff5570..6ae90cc 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -1,4 +1,4 @@
-;;; url-about.el --- Show internal URLs
+;;; url-about.el --- Show internal URLs -*- lexical-binding: t; -*-
;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
@@ -44,7 +44,7 @@
(defvar url-scheme-registry)
-(defun url-about-protocols (url)
+(defun url-about-protocols (_url)
(url-probe-protocols)
(insert "<html>\n"
" <head>\n"
@@ -73,13 +73,15 @@
"ynchronous<br>\n"
(if (url-scheme-get-property k 'default-port)
(format "Default Port: %d<br>\n"
- (url-scheme-get-property k 'default-port)) "")
+ (url-scheme-get-property k 'default-port))
+ "")
(if (assoc k url-proxy-services)
(format "Proxy: %s<br>\n" (assoc k url-proxy-services))
""))
;; Now the description...
(insert " <td valign=top>"
(or (url-scheme-get-property k 'description) "N/A"))))
- (sort (let (x) (maphash (lambda (k v) (push k x)) url-scheme-registry)
x) 'string-lessp))
+ (sort (let (x) (maphash (lambda (k _v) (push k x)) url-scheme-registry)
x)
+ #'string-lessp))
(insert " </table>\n"
" </body>\n"
"</html>\n"))
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index acf88eb..830e6ba 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,4 +1,4 @@
-;;; url-cache.el --- Uniform Resource Locator retrieval tool
+;;; url-cache.el --- Uniform Resource Locator retrieval tool -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index d465cab..0ca2d8a 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,4 +1,4 @@
-;;; url-cid.el --- Content-ID URL loader
+;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*-
;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 12d5a68..edb1c1d 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -1,4 +1,4 @@
-;;; url-dav.el --- WebDAV support
+;;; url-dav.el --- WebDAV support -*- lexical-binding: t; -*-
;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
@@ -133,7 +133,8 @@ Returns nil if WebDAV is not supported."
(node-type nil)
(props nil)
(value nil)
- (handler-func nil))
+ ;; (handler-func nil)
+ )
(when (not children)
(error "No child nodes in DAV:prop"))
@@ -453,7 +454,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
" </DAV:owner>\n"))
(response nil) ; Responses to the LOCK request
(result nil) ; For walking thru the response list
- (child-url nil)
+ ;; (child-url nil)
(child-status nil)
(failures nil) ; List of failure cases (URL . STATUS)
(successes nil)) ; List of success cases (URL . STATUS)
@@ -468,7 +469,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
;; status code.
(while response
(setq result (pop response)
- child-url (url-expand-file-name (pop result) url)
+ ;; child-url (url-expand-file-name (pop result) url)
child-status (or (plist-get result 'DAV:status) 500))
(if (url-dav-http-success-p child-status)
(push (list url child-status "huh") successes)
@@ -478,7 +479,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
(defun url-dav-active-locks (url &optional depth)
"Return an assoc list of all active locks on URL."
(let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth))
- (properties nil)
+ ;; (properties nil)
(child nil)
(child-url nil)
(child-results nil)
@@ -676,7 +677,6 @@ Use with care, and even then think three times."
If optional second argument RECURSIVE is non-nil, then delete all
files in the collection as well."
(let ((status nil)
- (props nil)
(props nil))
(setq props (url-dav-delete-something
url lock-token
@@ -769,7 +769,7 @@ If NOSORT is non-nil, the list is not sorted--its order is
unpredictable.
(when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
t)))
-(defun url-dav-make-directory (url &optional parents)
+(defun url-dav-make-directory (url &optional _parents)
"Create the directory DIR and any nonexistent parent dirs."
(let* ((url-request-extra-headers nil)
(url-request-method "MKCOL")
@@ -849,7 +849,9 @@ that start with FILE.
If there is only one and FILE matches it exactly, returns t.
Returns nil if URL contains no name starting with FILE."
(let ((matches (url-dav-file-name-all-completions file url))
- (result nil))
+ ;; (result nil)
+ )
+ ;; FIXME: Use `try-completion'!
(cond
((null matches)
;; No matches
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index a42b4c7..05088e3 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -66,7 +66,7 @@ path components followed by `..' are removed, along with the
`..' itself."
;; Need to nuke newlines and spaces in the URL, or we open
;; ourselves up to potential security holes.
(setq url (mapconcat (lambda (x)
- (if (memq x '(? ?\n ?\r))
+ (if (memq x '(?\s ?\n ?\r))
""
(char-to-string x)))
url "")))
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 52a9588..0e2ab55 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -154,7 +154,7 @@ to them."
;; not the compressed one.
;; FIXME should this regexp not include more extensions; basically
;; everything that url-file-find-possibly-compressed-file does?
- (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)$"
filename)
+ (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)\\'"
filename)
(substring filename 0 (match-beginning 0))
filename))
(setq content-type (mailcap-extension-to-mime
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 68df67f..d2bf843 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,4 +1,4 @@
-;;; url-gw.el --- Gateway munging for URL loading
+;;; url-gw.el --- Gateway munging for URL loading -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2004-2021 Free Software Foundation, Inc.
@@ -222,18 +222,17 @@ overriding the value of `url-gateway-method'."
host))
'native
gwm))
- ;; An attempt to deal with denied connections, and attempt
- ;; to reconnect
- (cur-retries 0)
- (retry t)
- (errobj nil)
- (conn nil))
+ ;; An attempt to deal with denied connections, and attempt
+ ;; to reconnect
+ ;; (cur-retries 0)
+ ;; (retry t)
+ (conn nil))
;; If the user told us to do DNS for them, do it.
(if url-gateway-broken-resolution
(setq host (url-gateway-nslookup-host host)))
- (condition-case errobj
+ (condition-case nil
;; This is a clean way to ensure the new process inherits the
;; right coding systems in both Emacs and XEmacs.
(let ((coding-system-for-read 'binary)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 324cf99..61e07a0 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -66,7 +66,7 @@
(defconst url-http-default-port 80 "Default HTTP port.")
(defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.")
-(defalias 'url-http-expand-file-name 'url-default-expander)
+(defalias 'url-http-expand-file-name #'url-default-expander)
(defvar url-http-real-basic-auth-storage nil)
(defvar url-http-proxy-basic-auth-storage nil)
@@ -150,7 +150,7 @@ request.")
;; These routines will allow us to implement persistent HTTP
;; connections.
(defsubst url-http-debug (&rest args)
- (apply 'url-debug 'http args))
+ (apply #'url-debug 'http args))
(defun url-http-mark-connection-as-busy (host port proc)
(url-http-debug "Marking connection as busy: %s:%d %S" host port proc)
@@ -1203,8 +1203,7 @@ the end of the document."
;; We got back a headerless malformed response from the
;; server.
(url-http-activate-callback))
- ((or (= url-http-response-status 204)
- (= url-http-response-status 205))
+ ((memq url-http-response-status '(204 205))
(url-http-debug "%d response must have headers only (%s)."
url-http-response-status (buffer-name))
(when (url-http-parse-headers)
@@ -1239,11 +1238,11 @@ the end of the document."
(url-http-debug
"Saw HTTP/0.9 response, connection closed means end of document.")
(setq url-http-after-change-function
- 'url-http-simple-after-change-function))
+ #'url-http-simple-after-change-function))
((equal url-http-transfer-encoding "chunked")
(url-http-debug "Saw chunked encoding.")
(setq url-http-after-change-function
- 'url-http-chunked-encoding-after-change-function)
+ #'url-http-chunked-encoding-after-change-function)
(when (> nd url-http-end-of-headers)
(url-http-debug
"Calling initial chunked-encoding for extra data at end of
headers")
@@ -1254,7 +1253,7 @@ the end of the document."
(url-http-debug
"Got a content-length, being smart about document end.")
(setq url-http-after-change-function
- 'url-http-content-length-after-change-function)
+ #'url-http-content-length-after-change-function)
(cond
((= 0 url-http-content-length)
;; We got a NULL body! Activate the callback
@@ -1275,7 +1274,7 @@ the end of the document."
(t
(url-http-debug "No content-length, being dumb.")
(setq url-http-after-change-function
- 'url-http-simple-after-change-function)))))
+ #'url-http-simple-after-change-function)))))
;; We are still at the beginning of the buffer... must just be
;; waiting for a response.
(url-http-debug "Spinning waiting for headers...")
@@ -1374,7 +1373,7 @@ The return value of this function is the retrieval
buffer."
url-http-referer referer)
(set-process-buffer connection buffer)
- (set-process-filter connection 'url-http-generic-filter)
+ (set-process-filter connection #'url-http-generic-filter)
(pcase (process-status connection)
('connect
;; Asynchronous connection
@@ -1388,12 +1387,12 @@ The return value of this function is the retrieval
buffer."
(url-type url-current-object)))
(url-https-proxy-connect connection)
(set-process-sentinel connection
- 'url-http-end-of-document-sentinel)
+ #'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
buffer))
(defun url-https-proxy-connect (connection)
- (setq url-http-after-change-function 'url-https-proxy-after-change-function)
+ (setq url-http-after-change-function #'url-https-proxy-after-change-function)
(process-send-string
connection
(format
@@ -1441,7 +1440,7 @@ The return value of this function is the retrieval
buffer."
(with-current-buffer process-buffer (erase-buffer))
(set-process-buffer tls-connection process-buffer)
(setq url-http-after-change-function
- 'url-http-wait-for-headers-change-function)
+ #'url-http-wait-for-headers-change-function)
(set-process-filter tls-connection 'url-http-generic-filter)
(process-send-string tls-connection
(url-http-create-request)))
@@ -1510,7 +1509,7 @@ The return value of this function is the retrieval
buffer."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defalias 'url-http-symbol-value-in-buffer
(if (fboundp 'symbol-value-in-buffer)
- 'symbol-value-in-buffer
+ #'symbol-value-in-buffer
(lambda (symbol buffer &optional unbound-value)
"Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is
unbound."
(with-current-buffer buffer
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index 05c3e73..492907f 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -1,4 +1,4 @@
-;;; url-imap.el --- IMAP retrieval routines
+;;; url-imap.el --- IMAP retrieval routines -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
@@ -37,6 +37,9 @@
(defconst url-imap-default-port 143 "Default IMAP port.")
+(defvar imap-username)
+(defvar imap-password)
+
(defun url-imap-open-host (host port user pass)
;; xxx use user and password
(if (fboundp 'nnheader-init-server-buffer)
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 0fa9970..d26562b 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,4 +1,4 @@
-;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
+;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 688f102..72884c0 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,4 +1,4 @@
-;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
+;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -67,7 +67,7 @@
;; mailto:wmperry@gnu.org
(setf (url-filename url) (concat (url-user url) "@" (url-filename url))))
(setq url (url-filename url))
- (let (to args source-url subject func headers-start)
+ (let (to args source-url subject headers-start) ;; func
(if (string-match (regexp-quote "?") url)
(setq headers-start (match-end 0)
to (url-unhex-string (substring url 0 (match-beginning 0)))
@@ -76,10 +76,11 @@
(setq to (url-unhex-string url)))
(setq source-url (url-view-url t))
(if (and url-request-data (not (assoc "subject" args)))
- (setq args (cons (list "subject"
+ (push (list "subject"
(concat "Automatic submission from "
url-package-name "/"
- url-package-version)) args)))
+ url-package-version))
+ args))
(if (and source-url (not (assoc "x-url-from" args)))
(setq args (cons (list "x-url-from" source-url) args)))
@@ -107,7 +108,7 @@
(replace-regexp-in-string "\r\n" "\n" string))
(cdar args) "\n")))
(url-mail-goto-field (caar args))
- (setq func (intern-soft (concat "mail-" (caar args))))
+ ;; (setq func (intern-soft (concat "mail-" (caar args))))
(insert (mapconcat 'identity (cdar args) ", ")))
(setq args (cdr args)))
;; (url-mail-goto-field "User-Agent")
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 7aad741..cfe7d5b 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -1,4 +1,4 @@
-;;; url-methods.el --- Load URL schemes as needed
+;;; url-methods.el --- Load URL schemes as needed -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -57,7 +57,7 @@
'file-exists-p 'ignore
'file-attributes 'ignore))
-(defun url-scheme-default-loader (url &optional callback cbargs)
+(defun url-scheme-default-loader (url &optional _callback _cbargs)
"Signal an error for an unknown URL scheme."
(error "Unknown URL scheme: %s" (url-type url)))
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index d3db31d..fe2393b 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,4 +1,4 @@
-;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
+;;; url-misc.el --- Misc Uniform Resource Locator retrieval code -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2002, 2004-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index d5f8483..585a282 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,4 +1,4 @@
-;;; url-news.el --- News Uniform Resource Locator retrieval code
+;;; url-news.el --- News Uniform Resource Locator retrieval code -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -106,7 +106,7 @@
;; Find a news reference
(let* ((host (or (url-host url) url-news-server))
(port (url-port url))
- (article-brackets nil)
+ ;; (article-brackets nil)
(buf nil)
(article (url-unhex-string (url-filename url))))
(url-news-open-host host port (url-user url) (url-password url))
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 3c80c80..0449930 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,4 +1,4 @@
-;;; url-nfs.el --- NFS URL interface
+;;; url-nfs.el --- NFS URL interface -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index e3ca0f6..d926775 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,4 +1,4 @@
-;;; url-privacy.el --- Global history tracking for URL package
+;;; url-privacy.el --- Global history tracking for URL package -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
(require 'url-vars)
-(defun url-device-type (&optional device)
+(defun url-device-type (&optional _device)
(declare (obsolete nil "27.1"))
(or window-system 'tty))
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 6bf6584..8436c7a 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -1,4 +1,4 @@
-;;; url-proxy.el --- Proxy server support
+;;; url-proxy.el --- Proxy server support -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 325d25c..5b9dd8a 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -1,4 +1,4 @@
-;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
+;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
-*- lexical-binding: t; -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 172a3af..8daf9f0 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -156,16 +156,16 @@ If INHIBIT-COOKIES, cookies will neither be stored nor
sent to
the server.
If URL is a multibyte string, it will be encoded as utf-8 and
URL-encoded before it's used."
-;;; XXX: There is code in Emacs that does dynamic binding
-;;; of the following variables around url-retrieve:
-;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
-;;; url-confirmation-func, url-cookie-multiple-line,
-;;; url-cookie-{{,secure-}storage,confirmation}
-;;; url-standalone-mode and url-gateway-unplugged should work as
-;;; usual. url-confirmation-func is only used in nnwarchive.el and
-;;; webmail.el; the latter should be updated. Is
-;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
-;;; are (for now) only used in synchronous retrievals.
+ ;; XXX: There is code in Emacs that does dynamic binding
+ ;; of the following variables around url-retrieve:
+ ;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
+ ;; url-confirmation-func, url-cookie-multiple-line,
+ ;; url-cookie-{{,secure-}storage,confirmation}
+ ;; url-standalone-mode and url-gateway-unplugged should work as
+ ;; usual. url-confirmation-func is only used in nnwarchive.el and
+ ;; webmail.el; the latter should be updated. Is
+ ;; url-cookie-multiple-line needed anymore? The other url-cookie-*
+ ;; are (for now) only used in synchronous retrievals.
(url-retrieve-internal url callback (cons nil cbargs) silent
inhibit-cookies))
@@ -210,7 +210,7 @@ URL-encoded before it's used."
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
(if url-using-proxy
(setq asynch t
- loader 'url-proxy))
+ loader #'url-proxy))
(if asynch
(let ((url-current-object url))
(setq buffer (funcall loader url callback cbargs)))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index bbb7324..9d0808c 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -300,7 +300,6 @@ See `run-hooks'."
(define-key map "\C-o" 'vc-dir-display-file)
(define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
(define-key map [down-mouse-3] 'vc-dir-menu)
- (define-key map [mouse-2] 'vc-dir-toggle-mark)
(define-key map [follow-link] 'mouse-face)
(define-key map "x" 'vc-dir-hide-up-to-date)
(define-key map [?\C-k] 'vc-dir-kill-line)
@@ -1085,7 +1084,6 @@ U - if the cursor is on a file: unmark all the files with
the same state
as the current file
- if the cursor is on a directory: unmark all child files
- with a prefix argument: unmark all files
-mouse-2 - toggles the mark state
VC commands
VC commands in the `C-x v' prefix can be used.
@@ -1392,6 +1390,12 @@ These are the commands available for use in the file
status buffer:
(propertize "Please add backend specific headers here. It's easy!"
'face 'font-lock-warning-face)))
+(defvar vc-dir-status-mouse-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'vc-dir-toggle-mark)
+ map)
+ "Local keymap for toggling mark.")
+
(defvar vc-dir-filename-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'vc-dir-find-file-other-window)
@@ -1418,7 +1422,8 @@ These are the commands available for use in the file
status buffer:
((memq state '(missing conflict)) 'font-lock-warning-face)
((eq state 'edited) 'font-lock-constant-face)
(t 'font-lock-variable-name-face))
- 'mouse-face 'highlight)
+ 'mouse-face 'highlight
+ 'keymap vc-dir-status-mouse-map)
" "
(propertize
(format "%s" filename)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index a9ee28e..94fac3a 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -481,7 +481,8 @@ or an empty string if none."
'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
((eq state 'missing) 'font-lock-warning-face)
(t 'font-lock-variable-name-face))
- 'mouse-face 'highlight)
+ 'mouse-face 'highlight
+ 'keymap vc-dir-status-mouse-map)
" " (vc-git-permissions-as-string old-perm new-perm)
" "
(propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
diff --git a/lisp/wdired.el b/lisp/wdired.el
index f4a0b6d..a096abd 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -27,26 +27,26 @@
;; wdired.el (the "w" is for writable) provides an alternative way of
;; renaming files.
;;
-;; Have you ever wished to use C-x r t (string-rectangle), M-%
+;; Have you ever wanted to use C-x r t (string-rectangle), M-%
;; (query-replace), M-c (capitalize-word), etc... to change the name of
-;; the files in a "dired" buffer? Now you can do this. All the power
-;; of Emacs commands are available to renaming files!
+;; the files in a "dired" buffer? Now you can do this. All the power
+;; of Emacs commands are available when renaming files!
;;
;; This package provides a function that makes the filenames of a
;; dired buffer editable, by changing the buffer mode (which inhibits
-;; all of the commands of dired mode). Here you can edit the names of
+;; all of the commands of dired mode). Here you can edit the names of
;; one or more files and directories, and when you press C-c C-c, the
;; renaming takes effect and you are back to dired mode.
;;
-;; Another things you can do with WDired:
+;; Other things you can do with WDired:
;;
-;; - To move files to another directory (by typing their path,
+;; - Move files to another directory (by typing their path,
;; absolute or relative, as a part of the new filename).
;;
-;; - To change the target of symbolic links.
+;; - Change the target of symbolic links.
;;
-;; - To change the permission bits of the filenames (in systems with a
-;; working unix-alike `dired-chmod-program'). See and customize the
+;; - Change the permission bits of the filenames (in systems with a
+;; working unix-alike `dired-chmod-program'). See and customize the
;; variable `wdired-allow-to-change-permissions'. To change a single
;; char (toggling between its two more usual values) you can press
;; the space bar over it or left-click the mouse. To set any char to
@@ -56,7 +56,7 @@
;; the change would affect to their targets, and this would not be
;; WYSIWYG :-).
;;
-;; - To mark files for deletion, by deleting their whole filename.
+;; - Mark files for deletion, by deleting their whole filename.
;;; Usage:
@@ -68,8 +68,8 @@
;;; Change Log:
-;; Google is your friend (previous versions with complete changelogs
-;; were posted to gnu.emacs.sources)
+;; Previous versions with complete changelogs were posted to
+;; gnu.emacs.sources.
;;; Code:
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 7b8e5b7..22bfae0 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1000,8 +1000,8 @@ See also `whitespace-style', `whitespace-newline' and
((eq whitespace-global-modes t))
((listp whitespace-global-modes)
(if (eq (car-safe whitespace-global-modes) 'not)
- (not (memq major-mode (cdr whitespace-global-modes)))
- (memq major-mode whitespace-global-modes)))
+ (not (apply #'derived-mode-p (cdr whitespace-global-modes)))
+ (apply #'derived-mode-p whitespace-global-modes)))
(t nil))
;; ...we have a display (not running a batch job)
(not noninteractive)
diff --git a/lisp/window.el b/lisp/window.el
index 0a37d16..d587691 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8196,8 +8196,8 @@ such alists.
If ALIST has a non-nil `inhibit-same-window' entry, the selected
window is not usable. A dedicated window is usable only if it
already shows BUFFER. If ALIST contains a `previous-window'
-entry, the window specified by that entry is usable even if it
-never showed BUFFER before.
+entry, the window specified by that entry (either a variable
+or a value) is usable even if it never showed BUFFER before.
If ALIST contains a `reusable-frames' entry, its value determines
which frames to search for a usable window:
@@ -8239,6 +8239,7 @@ indirectly called by the latter."
0)
(display-buffer-reuse-frames 0)
(t (last-nonminibuffer-frame))))
+ (previous-window (cdr (assq 'previous-window alist)))
best-window second-best-window window)
;; Scan windows whether they have shown the buffer recently.
(catch 'best
@@ -8252,7 +8253,9 @@ indirectly called by the latter."
(throw 'best t)))))
;; When ALIST has a `previous-window' entry, that entry may override
;; anything we found so far.
- (when (and (setq window (cdr (assq 'previous-window alist)))
+ (when (and previous-window (boundp previous-window))
+ (setq previous-window (symbol-value previous-window)))
+ (when (and (setq window previous-window)
(window-live-p window)
(or (eq buffer (window-buffer window))
(not (window-dedicated-p window))))
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index 475fa15..0dfb2da 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,4 +1,4 @@
-# canonicalize.m4 serial 35
+# canonicalize.m4 serial 37
dnl Copyright (C) 2003-2007, 2009-2021 Free Software Foundation, Inc.
@@ -78,68 +78,106 @@ AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE],
# so is the latter.
AC_DEFUN([gl_FUNC_REALPATH_WORKS],
[
- AC_CHECK_FUNCS_ONCE([realpath])
+ AC_CHECK_FUNCS_ONCE([realpath lstat])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether realpath works], [gl_cv_func_realpath_works], [
rm -rf conftest.a conftest.d
touch conftest.a
+ # Assume that if we have lstat, we can also check symlinks.
+ if test $ac_cv_func_lstat = yes; then
+ ln -s conftest.a conftest.l
+ fi
mkdir conftest.d
AC_RUN_IFELSE([
AC_LANG_PROGRAM([[
]GL_NOCRASH[
+ #include <errno.h>
#include <stdlib.h>
#include <string.h>
]], [[
int result = 0;
+ /* This test fails on Solaris 10. */
{
char *name = realpath ("conftest.a", NULL);
if (!(name && *name == '/'))
result |= 1;
free (name);
}
+ /* This test fails on older versions of Cygwin. */
{
char *name = realpath ("conftest.b/../conftest.a", NULL);
if (name != NULL)
result |= 2;
free (name);
}
+ /* This test fails on Cygwin 2.9. */
+ #if HAVE_LSTAT
+ {
+ char *name = realpath ("conftest.l/../conftest.a", NULL);
+ if (name != NULL || errno != ENOTDIR)
+ result |= 4;
+ free (name);
+ }
+ #endif
+ /* This test fails on Mac OS X 10.13, OpenBSD 6.0. */
{
char *name = realpath ("conftest.a/", NULL);
if (name != NULL)
- result |= 4;
+ result |= 8;
free (name);
}
+ /* This test fails on AIX 7, Solaris 10. */
{
char *name1 = realpath (".", NULL);
char *name2 = realpath ("conftest.d//./..", NULL);
if (! name1 || ! name2 || strcmp (name1, name2))
- result |= 8;
+ result |= 16;
free (name1);
free (name2);
}
+ #ifdef __linux__
+ /* On Linux, // is the same as /. See also double-slash-root.m4.
+ realpath() should respect this.
+ This test fails on musl libc 1.2.2. */
+ {
+ char *name = realpath ("//", NULL);
+ if (! name || strcmp (name, "/"))
+ result |= 32;
+ free (name);
+ }
+ #endif
return result;
]])
],
[gl_cv_func_realpath_works=yes],
- [gl_cv_func_realpath_works=no],
+ [case $? in
+ 32) gl_cv_func_realpath_works=nearly ;;
+ *) gl_cv_func_realpath_works=no ;;
+ esac
+ ],
[case "$host_os" in
# Guess yes on glibc systems.
*-gnu* | gnu*) gl_cv_func_realpath_works="guessing yes" ;;
- # Guess yes on musl systems.
- *-musl*) gl_cv_func_realpath_works="guessing yes" ;;
+ # Guess 'nearly' on musl systems.
+ *-musl*) gl_cv_func_realpath_works="guessing nearly" ;;
+ # Guess no on Cygwin.
+ cygwin*) gl_cv_func_realpath_works="guessing no" ;;
# Guess no on native Windows.
mingw*) gl_cv_func_realpath_works="guessing no" ;;
# If we don't know, obey --enable-cross-guesses.
*) gl_cv_func_realpath_works="$gl_cross_guess_normal" ;;
esac
])
- rm -rf conftest.a conftest.d
+ rm -rf conftest.a conftest.l conftest.d
])
case "$gl_cv_func_realpath_works" in
*yes)
- AC_DEFINE([FUNC_REALPATH_WORKS], [1], [Define to 1 if realpath()
- can malloc memory, always gives an absolute path, and handles
- trailing slash correctly.])
+ AC_DEFINE([FUNC_REALPATH_WORKS], [1],
+ [Define to 1 if realpath() can malloc memory, always gives an absolute
path, and handles leading slashes and a trailing slash correctly.])
+ ;;
+ *nearly)
+ AC_DEFINE([FUNC_REALPATH_NEARLY_WORKS], [1],
+ [Define to 1 if realpath() can malloc memory, always gives an absolute
path, and handles a trailing slash correctly.])
;;
esac
])
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index f7333ac..5792a95 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,4 +1,4 @@
-# serial 21 -*- Autoconf -*-
+# serial 22 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
# Copyright (C) 2003, 2006-2021 Free Software Foundation, Inc.
@@ -212,4 +212,16 @@ dnl it should only be defined when necessary.
AC_DEFUN_ONCE([gl_USE_SYSTEM_EXTENSIONS],
[
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ dnl On OpenBSD 6.8 with GCC, the include files contain a couple of
+ dnl definitions that are only activated with an explicit -D_ISOC11_SOURCE.
+ dnl That's because this version of GCC (4.2.1) supports the option
+ dnl '-std=gnu99' but not the option '-std=gnu11'.
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ case "$host_os" in
+ openbsd*)
+ AC_DEFINE([_ISOC11_SOURCE], [1],
+ [Define to enable the declarations of ISO C 11 types and functions.])
+ ;;
+ esac
])
diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4
index 0938032..66c0e30 100644
--- a/m4/fchmodat.m4
+++ b/m4/fchmodat.m4
@@ -1,4 +1,4 @@
-# fchmodat.m4 serial 5
+# fchmodat.m4 serial 6
dnl Copyright (C) 2004-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -16,11 +16,9 @@ AC_DEFUN([gl_FUNC_FCHMODAT],
HAVE_FCHMODAT=0
else
AC_CACHE_CHECK(
- [whether fchmodat+AT_SYMLINK_NOFOLLOW works on non-symlinks],
+ [whether fchmodat works],
[gl_cv_func_fchmodat_works],
- [dnl This test fails on GNU/Linux with glibc 2.31 (but not on
- dnl GNU/kFreeBSD nor GNU/Hurd) and Cygwin 2.9.
- AC_RUN_IFELSE(
+ [AC_RUN_IFELSE(
[AC_LANG_PROGRAM(
[
AC_INCLUDES_DEFAULT[
@@ -44,27 +42,49 @@ AC_DEFUN([gl_FUNC_FCHMODAT],
[[
int permissive = S_IRWXU | S_IRWXG | S_IRWXO;
int desired = S_IRUSR | S_IWUSR;
- static char const f[] = "conftest.fchmodat";
+ int result = 0;
+ #define file "conftest.fchmodat"
struct stat st;
- if (creat (f, permissive) < 0)
+ if (creat (file, permissive) < 0)
return 1;
- if (fchmodat (AT_FDCWD, f, desired, AT_SYMLINK_NOFOLLOW) != 0)
+ /* Test whether fchmodat rejects a trailing slash on a
non-directory.
+ This test fails on AIX 7.2. */
+ if (fchmodat (AT_FDCWD, file "/", desired, 0) == 0)
+ result |= 2;
+ /* Test whether fchmodat+AT_SYMLINK_NOFOLLOW works on
non-symlinks.
+ This test fails on GNU/Linux with glibc 2.31 (but not on
+ GNU/kFreeBSD nor GNU/Hurd) and Cygwin 2.9. */
+ if (fchmodat (AT_FDCWD, file, desired, AT_SYMLINK_NOFOLLOW) != 0)
+ result |= 4;
+ if (stat (file, &st) != 0)
return 1;
- if (stat (f, &st) != 0)
- return 1;
- return ! ((st.st_mode & permissive) == desired);
+ if ((st.st_mode & permissive) != desired)
+ result |= 4;
+ return result;
]])],
[gl_cv_func_fchmodat_works=yes],
- [gl_cv_func_fchmodat_works=no],
+ [case $? in
+ 2) gl_cv_func_fchmodat_works='nearly' ;;
+ *) gl_cv_func_fchmodat_works=no ;;
+ esac
+ ],
[case "$host_os" in
- dnl Guess no on Linux with glibc and Cygwin, yes otherwise.
+ # Guess no on Linux with glibc and Cygwin.
linux-gnu* | cygwin*) gl_cv_func_fchmodat_works="guessing no" ;;
+ # Guess 'nearly' on AIX.
+ aix*) gl_cv_func_fchmodat_works="guessing nearly"
;;
+ # If we don't know, obey
--enable-cross-guesses.
*)
gl_cv_func_fchmodat_works="$gl_cross_guess_normal" ;;
esac
])
rm -f conftest.fchmodat])
- case $gl_cv_func_fchmodat_works in
+ case "$gl_cv_func_fchmodat_works" in
*yes) ;;
+ *nearly)
+ AC_DEFINE([HAVE_NEARLY_WORKING_FCHMODAT], [1],
+ [Define to 1 if fchmodat works, except for the trailing slash
handling.])
+ REPLACE_FCHMODAT=1
+ ;;
*)
AC_DEFINE([NEED_FCHMODAT_NONSYMLINK_FIX], [1],
[Define to 1 if fchmodat+AT_SYMLINK_NOFOLLOW does not work right on
non-symlinks.])
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 535359b..f2eff10 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -39,11 +39,12 @@ AC_DEFUN([gl_COMMON_BODY], [
this syntax with 'extern'. */
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
- && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || _GL_GNUC_PREREQ (4, 7) \
- || (defined __apple_build_version__ \
- ? 6000000 <= __apple_build_version__ \
- : 3 < __clang_major__ + (5 <= __clang_minor__))))
+ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
+ || (!defined __STRICT_ANSI__ \
+ && (_GL_GNUC_PREREQ (4, 7) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))))
/* _Noreturn works as-is. */
# elif _GL_GNUC_PREREQ (2, 8) || defined __clang__ || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
@@ -66,7 +67,9 @@ AC_DEFUN([gl_COMMON_BODY], [
#endif])
AH_VERBATIM([attribute],
[/* Attributes. */
-#ifdef __has_attribute
+#if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
#else
# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index ad10952..cd6f7b4 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -75,6 +75,7 @@ AC_DEFUN([gl_EARLY],
# Code from module dtoastr:
# Code from module dtotimespec:
# Code from module dup2:
+ # Code from module dynarray:
# Code from module eloop-threshold:
# Code from module environ:
# Code from module errno:
@@ -517,6 +518,7 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
gl_gnulib_enabled_cloexec=false
gl_gnulib_enabled_dirfd=false
+ gl_gnulib_enabled_dynarray=false
gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c=false
gl_gnulib_enabled_euidaccess=false
gl_gnulib_enabled_getdtablesize=false
@@ -564,6 +566,12 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_dirfd=true
fi
}
+ func_gl_gnulib_m4code_dynarray ()
+ {
+ if ! $gl_gnulib_enabled_dynarray; then
+ gl_gnulib_enabled_dynarray=true
+ fi
+ }
func_gl_gnulib_m4code_925677f0343de64b89a9f0c790b4104c ()
{
if ! $gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c; then
@@ -797,6 +805,9 @@ AC_DEFUN([gl_INIT],
if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
fi
+ if test $ac_use_included_regex = yes; then
+ func_gl_gnulib_m4code_dynarray
+ fi
if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test
$ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
@@ -819,6 +830,7 @@ AC_DEFUN([gl_INIT],
AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b],
[$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b])
AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_dynarray], [$gl_gnulib_enabled_dynarray])
AM_CONDITIONAL([gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c],
[$gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c])
AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess],
[$gl_gnulib_enabled_euidaccess])
AM_CONDITIONAL([gl_GNULIB_ENABLED_getdtablesize],
[$gl_gnulib_enabled_getdtablesize])
@@ -1021,6 +1033,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/dtoastr.c
lib/dtotimespec.c
lib/dup2.c
+ lib/dynarray.h
lib/eloop-threshold.h
lib/errno.in.h
lib/euidaccess.c
@@ -1076,6 +1089,13 @@ AC_DEFUN([gl_FILE_LIST], [
lib/libc-config.h
lib/limits.in.h
lib/lstat.c
+ lib/malloc/dynarray-skeleton.c
+ lib/malloc/dynarray.h
+ lib/malloc/dynarray_at_failure.c
+ lib/malloc/dynarray_emplace_enlarge.c
+ lib/malloc/dynarray_finalize.c
+ lib/malloc/dynarray_resize.c
+ lib/malloc/dynarray_resize_clear.c
lib/malloc/scratch_buffer.h
lib/malloc/scratch_buffer_dupfree.c
lib/malloc/scratch_buffer_grow.c
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index 4674442..b510554 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,4 +1,4 @@
-# serial 36
+# serial 37
# Copyright (C) 1996-1997, 1999-2007, 2009-2021 Free Software Foundation, Inc.
#
@@ -12,7 +12,7 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME],
[
AC_REQUIRE([AC_C_RESTRICT])
- # This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE.
+ # This defines (or not) HAVE_TZNAME and HAVE_STRUCT_TM_TM_ZONE.
AC_REQUIRE([AC_STRUCT_TIMEZONE])
AC_REQUIRE([gl_TM_GMTOFF])
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 18e872f..cd666c4 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,14 +1,19 @@
-dnl A placeholder for <stddef.h>, for platforms that have issues.
-# stddef_h.m4 serial 7
+# stddef_h.m4 serial 9
dnl Copyright (C) 2009-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
+dnl A placeholder for <stddef.h>, for platforms that have issues.
+
AC_DEFUN([gl_STDDEF_H],
[
AC_REQUIRE([gl_STDDEF_H_DEFAULTS])
AC_REQUIRE([gt_TYPE_WCHAR_T])
+
+ dnl Persuade OpenBSD <stddef.h> to declare max_align_t.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
STDDEF_H=
dnl Test whether the type max_align_t exists and whether its alignment
@@ -23,6 +28,13 @@ AC_DEFUN([gl_STDDEF_H],
int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t))
- 1];
int check2[2 * (__alignof__ (long double) <= __alignof__
(max_align_t)) - 1];
#endif
+ typedef struct { char a; max_align_t b; } max_helper;
+ typedef struct { char a; long b; } long_helper;
+ typedef struct { char a; double b; } double_helper;
+ typedef struct { char a; long double b; } long_double_helper;
+ int check3[2 * (offsetof (long_helper, b) <= offsetof (max_helper,
b)) - 1];
+ int check4[2 * (offsetof (double_helper, b) <= offsetof
(max_helper, b)) - 1];
+ int check5[2 * (offsetof (long_double_helper, b) <= offsetof
(max_helper, b)) - 1];
]])],
[gl_cv_type_max_align_t=yes],
[gl_cv_type_max_align_t=no])
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 3e65355..a4cc5b4 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -5,7 +5,7 @@
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# serial 28
+# serial 29
# Written by Paul Eggert.
@@ -113,6 +113,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
HAVE_SIGDESCR_NP=1; AC_SUBST([HAVE_SIGDESCR_NP])
HAVE_DECL_STRSIGNAL=1; AC_SUBST([HAVE_DECL_STRSIGNAL])
HAVE_STRVERSCMP=1; AC_SUBST([HAVE_STRVERSCMP])
+ REPLACE_FFSLL=0; AC_SUBST([REPLACE_FFSLL])
REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR])
REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM])
REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY])
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index e8eac71..23cbdd2 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,4 +1,4 @@
-# sys_stat_h.m4 serial 36 -*- Autoconf -*-
+# sys_stat_h.m4 serial 38 -*- Autoconf -*-
dnl Copyright (C) 2006-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -104,7 +104,9 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
REPLACE_LSTAT=0; AC_SUBST([REPLACE_LSTAT])
REPLACE_MKDIR=0; AC_SUBST([REPLACE_MKDIR])
REPLACE_MKFIFO=0; AC_SUBST([REPLACE_MKFIFO])
+ REPLACE_MKFIFOAT=0; AC_SUBST([REPLACE_MKFIFOAT])
REPLACE_MKNOD=0; AC_SUBST([REPLACE_MKNOD])
+ REPLACE_MKNODAT=0; AC_SUBST([REPLACE_MKNODAT])
REPLACE_STAT=0; AC_SUBST([REPLACE_STAT])
REPLACE_UTIMENSAT=0; AC_SUBST([REPLACE_UTIMENSAT])
])
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 07e6967..b6a1aa3 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -2,7 +2,7 @@
# Copyright (C) 2000-2001, 2003-2007, 2009-2021 Free Software Foundation, Inc.
-# serial 13
+# serial 15
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -25,6 +25,22 @@ AC_DEFUN([gl_HEADER_TIME_H_BODY],
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
AC_REQUIRE([AC_C_RESTRICT])
+
+ AC_CACHE_CHECK([for TIME_UTC in <time.h>],
+ [gl_cv_time_h_has_TIME_UTC],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <time.h>
+ ]],
+ [[static int x = TIME_UTC; x++;]])],
+ [gl_cv_time_h_has_TIME_UTC=yes],
+ [gl_cv_time_h_has_TIME_UTC=no])])
+ if test $gl_cv_time_h_has_TIME_UTC = yes; then
+ TIME_H_DEFINES_TIME_UTC=1
+ else
+ TIME_H_DEFINES_TIME_UTC=0
+ fi
+ AC_SUBST([TIME_H_DEFINES_TIME_UTC])
])
dnl Check whether 'struct timespec' is declared
@@ -113,6 +129,7 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
GNULIB_STRFTIME=0; AC_SUBST([GNULIB_STRFTIME])
GNULIB_STRPTIME=0; AC_SUBST([GNULIB_STRPTIME])
GNULIB_TIMEGM=0; AC_SUBST([GNULIB_TIMEGM])
+ GNULIB_TIMESPEC_GET=0; AC_SUBST([GNULIB_TIMESPEC_GET])
GNULIB_TIME_R=0; AC_SUBST([GNULIB_TIME_R])
GNULIB_TIME_RZ=0; AC_SUBST([GNULIB_TIME_RZ])
GNULIB_TZSET=0; AC_SUBST([GNULIB_TZSET])
@@ -123,6 +140,7 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
HAVE_NANOSLEEP=1; AC_SUBST([HAVE_NANOSLEEP])
HAVE_STRPTIME=1; AC_SUBST([HAVE_STRPTIME])
HAVE_TIMEGM=1; AC_SUBST([HAVE_TIMEGM])
+ HAVE_TIMESPEC_GET=1; AC_SUBST([HAVE_TIMESPEC_GET])
dnl Even GNU libc does not have timezone_t yet.
HAVE_TIMEZONE_T=0; AC_SUBST([HAVE_TIMEZONE_T])
dnl If another module says to replace or to not replace, do that.
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
index bdabe24..b5bff16 100644
--- a/m4/utimensat.m4
+++ b/m4/utimensat.m4
@@ -1,4 +1,4 @@
-# serial 7
+# serial 9
# See if we need to provide utimensat replacement.
dnl Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -12,6 +12,7 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
[
AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([utimensat])
if test $ac_cv_func_utimensat = no; then
HAVE_UTIMENSAT=0
@@ -28,10 +29,19 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
const char *f = "conftest.file";
if (close (creat (f, 0600)))
return 1;
+ /* Test whether a trailing slash is handled correctly.
+ This fails on AIX 7.2. */
+ {
+ struct timespec ts[2];
+ ts[0].tv_sec = 345183300; ts[0].tv_nsec = 0;
+ ts[1] = ts[0];
+ if (utimensat (AT_FDCWD, "conftest.file/", ts, 0) == 0)
+ result |= 2;
+ }
/* Test whether the AT_SYMLINK_NOFOLLOW flag is supported. */
{
if (utimensat (AT_FDCWD, f, NULL, AT_SYMLINK_NOFOLLOW))
- result |= 2;
+ result |= 4;
}
/* Test whether UTIME_NOW and UTIME_OMIT work. */
{
@@ -41,7 +51,7 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
ts[1].tv_sec = 1;
ts[1].tv_nsec = UTIME_NOW;
if (utimensat (AT_FDCWD, f, ts, 0))
- result |= 4;
+ result |= 8;
}
sleep (1);
{
@@ -52,19 +62,44 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
ts[1].tv_sec = 1;
ts[1].tv_nsec = UTIME_OMIT;
if (utimensat (AT_FDCWD, f, ts, 0))
- result |= 8;
- if (stat (f, &st))
result |= 16;
- else if (st.st_ctime < st.st_atime)
+ if (stat (f, &st))
result |= 32;
+ else if (st.st_ctime < st.st_atime)
+ result |= 64;
}
return result;
]])],
[gl_cv_func_utimensat_works=yes],
- [gl_cv_func_utimensat_works=no],
- [gl_cv_func_utimensat_works="guessing yes"])])
- if test "$gl_cv_func_utimensat_works" = no; then
- REPLACE_UTIMENSAT=1
- fi
+ [case $? in
+ 2) gl_cv_func_utimensat_works='nearly' ;;
+ *) gl_cv_func_utimensat_works=no ;;
+ esac
+ ],
+ [case "$host_os" in
+ # Guess yes on Linux or glibc systems.
+ linux-* | linux | *-gnu* | gnu*)
+ gl_cv_func_utimensat_works="guessing yes" ;;
+ # Guess 'nearly' on AIX.
+ aix*)
+ gl_cv_func_utimensat_works="guessing nearly" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *)
+ gl_cv_func_utimensat_works="$gl_cross_guess_normal" ;;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_utimensat_works" in
+ *yes)
+ ;;
+ *nearly)
+ AC_DEFINE([HAVE_NEARLY_WORKING_UTIMENSAT], [1],
+ [Define to 1 if utimensat works, except for the trailing slash
handling.])
+ REPLACE_UTIMENSAT=1
+ ;;
+ *)
+ REPLACE_UTIMENSAT=1
+ ;;
+ esac
fi
])
diff --git a/src/cmds.c b/src/cmds.c
index 1547db8..c8a96d9 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -99,6 +99,7 @@ DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1,
"^p",
Precisely, if point is on line I, move to the start of line I + N
\("start of line" in the logical order).
If there isn't room, go as far as possible (no error).
+Interactively, N is the numeric prefix argument and defaults to 1.
Returns the count of lines left to move. If moving forward,
that is N minus number of lines moved; if backward, N plus number
diff --git a/src/conf_post.h b/src/conf_post.h
index bd56f29..176ab28 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -71,7 +71,9 @@ typedef bool bool_bf;
It is used only on arguments like cleanup that are handled here.
This macro should be used only in #if expressions, as Oracle
Studio 12.5's __has_attribute does not work in plain code. */
-#ifdef __has_attribute
+#if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
# define HAS_ATTRIBUTE(a) __has_attribute (__##a##__)
#else
# define HAS_ATTRIBUTE(a) HAS_ATTR_##a
diff --git a/src/dispextern.h b/src/dispextern.h
index 3ad98b8..f4e8726 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1826,6 +1826,7 @@ enum face_id
WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID,
WINDOW_DIVIDER_LAST_PIXEL_FACE_ID,
INTERNAL_BORDER_FACE_ID,
+ CHILD_FRAME_BORDER_FACE_ID,
TAB_BAR_FACE_ID,
TAB_LINE_FACE_ID,
BASIC_FACE_ID_SENTINEL
diff --git a/src/editfns.c b/src/editfns.c
index 6f04c99..e328549 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -52,6 +52,9 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "window.h"
#include "blockinput.h"
+#ifdef WINDOWSNT
+# include "w32common.h"
+#endif
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
@@ -121,12 +124,14 @@ init_editfns (void)
else if (NILP (Vuser_full_name))
Vuser_full_name = build_string ("unknown");
-#ifdef HAVE_SYS_UTSNAME_H
+#if defined HAVE_SYS_UTSNAME_H
{
struct utsname uts;
uname (&uts);
Voperating_system_release = build_string (uts.release);
}
+#elif defined WINDOWSNT
+ Voperating_system_release = build_string (w32_version_string ());
#else
Voperating_system_release = Qnil;
#endif
@@ -4479,7 +4484,9 @@ functions if all the text being accessed has this
property. */);
doc: /* The user's name, based upon the real uid only. */);
DEFVAR_LISP ("operating-system-release", Voperating_system_release,
- doc: /* The release of the operating system Emacs is running on.
*/);
+ doc: /* The kernel version of the operating system on which
Emacs is running.
+The value is a string. It can also be nil if Emacs doesn't
+know how to get the kernel version on the underlying OS. */);
DEFVAR_BOOL ("binary-as-unsigned",
binary_as_unsigned,
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 2989b43..fe52587 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -51,7 +51,9 @@ information how to write modules and use this header file.
#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__)
# define EMACS_ATTRIBUTE_NONNULL(...) \
__attribute__ ((__nonnull__ (__VA_ARGS__)))
-#elif defined __has_attribute
+#elif (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
# if __has_attribute (__nonnull__)
# define EMACS_ATTRIBUTE_NONNULL(...) \
__attribute__ ((__nonnull__ (__VA_ARGS__)))
diff --git a/src/emacs.c b/src/emacs.c
index 7711427..fd08667 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -186,7 +186,8 @@ bool build_details;
/* Name for the server started by the daemon.*/
static char *daemon_name;
-/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). */
+/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background).
+ A negative value means the daemon initialization was already done. */
int daemon_type;
#ifndef WINDOWSNT
@@ -2354,7 +2355,10 @@ all of which are called before Emacs is actually killed.
*/
int exit_code;
#ifdef HAVE_LIBSYSTEMD
- sd_notify(0, "STOPPING=1");
+ /* Notify systemd we are shutting down, but only if we have notified
+ it about startup. */
+ if (daemon_type == -1)
+ sd_notify(0, "STOPPING=1");
#endif /* HAVE_LIBSYSTEMD */
/* Fsignal calls emacs_abort () if it sees that waiting_for_input is
@@ -2866,7 +2870,7 @@ from the parent process and its tty file descriptors. */)
}
/* Set it to an invalid value so we know we've already run this function. */
- daemon_type = -1;
+ daemon_type = -daemon_type;
#else /* WINDOWSNT */
/* Signal the waiting emacsclient process. */
diff --git a/src/fns.c b/src/fns.c
index 7ab2e8f..bd4afa0 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4599,33 +4599,29 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool
remove_entries_p)
EMACS_UINT
hash_string (char const *ptr, ptrdiff_t len)
{
- EMACS_UINT const *p = (EMACS_UINT const *) ptr;
- EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len);
+ char const *p = ptr;
+ char const *end = ptr + len;
EMACS_UINT hash = len;
/* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course,
* but dividing by 8 is cheaper. */
- ptrdiff_t step = 1 + ((end - p) >> 3);
+ ptrdiff_t step = sizeof hash + ((end - p) >> 3);
- /* Beware: `end` might be unaligned, so `p < end` is not always the same
- * as `p <= end - 1`. */
- while (p <= end - 1)
+ while (p + sizeof hash <= end)
{
- EMACS_UINT c = *p;
+ EMACS_UINT c;
+ /* We presume that the compiler will replace this `memcpy` with
+ a single load/move instruction when applicable. */
+ memcpy (&c, p, sizeof hash);
p += step;
hash = sxhash_combine (hash, c);
}
- if (p < end)
- { /* A few last bytes remain (smaller than an EMACS_UINT). */
- /* FIXME: We could do this without a loop, but it'd require
- endian-dependent code :-( */
- char const *p1 = (char const *)p;
- char const *end1 = (char const *)end;
- do
- {
- unsigned char c = *p1++;
- hash = sxhash_combine (hash, c);
- }
- while (p1 < end1);
+ /* A few last bytes may remain (smaller than an EMACS_UINT). */
+ /* FIXME: We could do this without a loop, but it'd require
+ endian-dependent code :-( */
+ while (p < end)
+ {
+ unsigned char c = *p++;
+ hash = sxhash_combine (hash, c);
}
return hash;
diff --git a/src/frame.c b/src/frame.c
index 599c407..a2167ce 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3543,6 +3543,13 @@ DEFUN ("frame-fringe-width", Ffringe_width,
Sfringe_width, 0, 1, 0,
return make_fixnum (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
}
+DEFUN ("frame-child-frame-border-width", Fframe_child_frame_border_width,
Sframe_child_frame_border_width, 0, 1, 0,
+ doc: /* Return width of FRAME's child-frame border in pixels. */)
+ (Lisp_Object frame)
+{
+ return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame
(frame)));
+}
+
DEFUN ("frame-internal-border-width", Fframe_internal_border_width,
Sframe_internal_border_width, 0, 1, 0,
doc: /* Return width of FRAME's internal border in pixels. */)
(Lisp_Object frame)
@@ -3759,6 +3766,7 @@ static const struct frame_parm_table frame_parms[] =
{"foreground-color", -1},
{"icon-name", SYMBOL_INDEX (Qicon_name)},
{"icon-type", SYMBOL_INDEX (Qicon_type)},
+ {"child-frame-border-width", SYMBOL_INDEX (Qchild_frame_border_width)},
{"internal-border-width", SYMBOL_INDEX (Qinternal_border_width)},
{"right-divider-width", SYMBOL_INDEX (Qright_divider_width)},
{"bottom-divider-width", SYMBOL_INDEX (Qbottom_divider_width)},
@@ -4302,6 +4310,8 @@ gui_report_frame_params (struct frame *f, Lisp_Object
*alistptr)
store_in_alist (alistptr, Qborder_width,
make_fixnum (f->border_width));
+ store_in_alist (alistptr, Qchild_frame_border_width,
+ make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f)));
store_in_alist (alistptr, Qinternal_border_width,
make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)));
store_in_alist (alistptr, Qright_divider_width,
@@ -5999,6 +6009,7 @@ syms_of_frame (void)
DEFSYM (Qhorizontal_scroll_bars, "horizontal-scroll-bars");
DEFSYM (Qicon_name, "icon-name");
DEFSYM (Qicon_type, "icon-type");
+ DEFSYM (Qchild_frame_border_width, "child-frame-border-width");
DEFSYM (Qinternal_border_width, "internal-border-width");
DEFSYM (Qleft_fringe, "left-fringe");
DEFSYM (Qline_spacing, "line-spacing");
@@ -6423,6 +6434,7 @@ iconify the top level frame instead. */);
defsubr (&Sscroll_bar_width);
defsubr (&Sscroll_bar_height);
defsubr (&Sfringe_width);
+ defsubr (&Sframe_child_frame_border_width);
defsubr (&Sframe_internal_border_width);
defsubr (&Sright_divider_width);
defsubr (&Sbottom_divider_width);
diff --git a/src/frame.h b/src/frame.h
index 8cf41dc..9b0852c 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -534,6 +534,10 @@ struct frame
/* Border width of the frame window as known by the (X) window system. */
int border_width;
+ /* Width of child frames' internal border. Acts as
+ internal_border_width for child frames. */
+ int child_frame_border_width;
+
/* Width of the internal border. This is a line of background color
just inside the window's border. When the frame is selected,
a highlighting is displayed inside the internal border. */
@@ -1432,11 +1436,27 @@ FRAME_TOTAL_FRINGE_WIDTH (struct frame *f)
return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
}
-/* Pixel-width of internal border lines. */
+INLINE int
+FRAME_CHILD_FRAME_BORDER_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->child_frame_border_width);
+}
+
+/* Pixel-width of internal border. Uses child_frame_border_width for
+ child frames if possible, and falls back on internal_border_width
+ otherwise. */
INLINE int
FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
{
+#ifdef HAVE_WINDOW_SYSTEM
+ return FRAME_PARENT_FRAME(f)
+ ? (f->child_frame_border_width
+ ? FRAME_CHILD_FRAME_BORDER_WIDTH(f)
+ : frame_dimension (f->internal_border_width))
+ : frame_dimension (f->internal_border_width);
+#else
return frame_dimension (f->internal_border_width);
+#endif
}
/* Pixel-size of window divider lines. */
diff --git a/src/nsfns.m b/src/nsfns.m
index ae114f8..c383e2f 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -687,6 +687,21 @@ ns_set_tool_bar_lines (struct frame *f, Lisp_Object value,
Lisp_Object oldval)
}
}
+static void
+ns_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
+{
+ int old_width = FRAME_CHILD_FRAME_BORDER_WIDTH (f);
+ int new_width = check_int_nonnegative (arg);
+
+ if (new_width == old_width)
+ return;
+ f->child_frame_border_width = new_width;
+
+ if (FRAME_NATIVE_WINDOW (f) != 0)
+ adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width);
+
+ SET_FRAME_GARBAGED (f);
+}
static void
ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
@@ -912,6 +927,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
ns_set_foreground_color,
ns_set_icon_name,
ns_set_icon_type,
+ ns_set_child_frame_border_width,
ns_set_internal_border_width,
gui_set_right_divider_width, /* generic OK */
gui_set_bottom_divider_width, /* generic OK */
@@ -1197,6 +1213,9 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2),
"internalBorderWidth", "InternalBorderWidth",
RES_TYPE_NUMBER);
+ gui_default_parameter (f, parms, Qchild_frame_border_width, make_fixnum (2),
+ "childFrameBorderWidth", "childFrameBorderWidth",
+ RES_TYPE_NUMBER);
gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0),
NULL, NULL, RES_TYPE_NUMBER);
gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0),
@@ -1487,7 +1506,6 @@ Some window managers may refuse to restack windows. */)
{
EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f1) window];
NSWindow *window2 = [FRAME_NS_VIEW (f2) window];
- BOOL flag = !NILP (above);
if ([window restackWindow:window2 above:!NILP (above)])
return Qt;
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 8086f56..f8219d2 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -101,7 +101,6 @@ popup_activated (void)
static void
ns_update_menubar (struct frame *f, bool deep_p)
{
- NSAutoreleasePool *pool;
BOOL needsSet = NO;
id menu = [NSApp mainMenu];
bool owfi;
diff --git a/src/nsterm.m b/src/nsterm.m
index c5815ce..1b23286 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -272,7 +272,9 @@ long context_menu_value = 0;
/* display update */
static struct frame *ns_updating_frame;
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static NSView *focus_view = NULL;
+#endif
static int ns_window_num = 0;
static BOOL gsaved = NO;
static BOOL ns_fake_keydown = NO;
@@ -1139,7 +1141,9 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after gui_update_window_end
--------------------------------------------------------------------------
*/
{
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
EmacsView *view = FRAME_NS_VIEW (f);
+#endif
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
@@ -1449,7 +1453,7 @@ ns_ring_bell (struct frame *f)
}
}
-
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static void
hide_bell (void)
/* --------------------------------------------------------------------------
@@ -1463,6 +1467,7 @@ hide_bell (void)
[bell_view remove];
}
}
+#endif
/* ==========================================================================
@@ -2876,6 +2881,8 @@ ns_get_shifted_character (NSEvent *event)
==========================================================================
*/
+#if 0
+/* FIXME: Remove this function. */
static void
ns_redraw_scroll_bars (struct frame *f)
{
@@ -2890,6 +2897,7 @@ ns_redraw_scroll_bars (struct frame *f)
[view display];
}
}
+#endif
void
@@ -3029,9 +3037,13 @@ ns_clear_under_internal_border (struct frame *f)
NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge};
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
if (!face)
@@ -8399,21 +8411,23 @@ not_in_argv (NSString *arg)
void *pixels = CGBitmapContextGetData (context);
int rowSize = CGBitmapContextGetBytesPerRow (context);
int srcRowSize = NSWidth (srcRect) * scale * bpp;
- void *srcPixels = pixels + (int)(NSMinY (srcRect) * scale * rowSize
- + NSMinX (srcRect) * scale * bpp);
- void *dstPixels = pixels + (int)(NSMinY (dstRect) * scale * rowSize
- + NSMinX (dstRect) * scale * bpp);
+ void *srcPixels = (char *) pixels
+ + (int) (NSMinY (srcRect) * scale * rowSize
+ + NSMinX (srcRect) * scale * bpp);
+ void *dstPixels = (char *) pixels
+ + (int) (NSMinY (dstRect) * scale * rowSize
+ + NSMinX (dstRect) * scale * bpp);
if (NSIntersectsRect (srcRect, dstRect)
&& NSMinY (srcRect) < NSMinY (dstRect))
for (int y = NSHeight (srcRect) * scale - 1 ; y >= 0 ; y--)
- memmove (dstPixels + y * rowSize,
- srcPixels + y * rowSize,
+ memmove ((char *) dstPixels + y * rowSize,
+ (char *) srcPixels + y * rowSize,
srcRowSize);
else
for (int y = 0 ; y < NSHeight (srcRect) * scale ; y++)
- memmove (dstPixels + y * rowSize,
- srcPixels + y * rowSize,
+ memmove ((char *) dstPixels + y * rowSize,
+ (char *) srcPixels + y * rowSize,
srcRowSize);
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
@@ -8742,7 +8756,8 @@ not_in_argv (NSString *arg)
/* 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)
+static NSInteger
+nswindow_orderedIndex_sort (id w1, id w2, void *c)
{
NSInteger i1 = [w1 orderedIndex];
NSInteger i2 = [w2 orderedIndex];
diff --git a/src/process.c b/src/process.c
index 5710598..3beb9cf 100644
--- a/src/process.c
+++ b/src/process.c
@@ -290,7 +290,9 @@ static int child_signal_read_fd = -1;
status changes. */
static int child_signal_write_fd = -1;
static void child_signal_init (void);
+#ifndef WINDOWSNT
static void child_signal_read (int, void *);
+#endif
static void child_signal_notify (void);
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
@@ -7148,8 +7150,23 @@ process has been transmitted to the serial port. */)
have the same process ID.
To avoid a deadlock when receiving SIGCHLD while
- `wait_reading_process_output' is in `pselect', the SIGCHLD handler
- will notify the `pselect' using a pipe. */
+ 'wait_reading_process_output' is in 'pselect', the SIGCHLD handler
+ will notify the `pselect' using a self-pipe. The deadlock could
+ occur if SIGCHLD is delivered outside of the 'pselect' call, in
+ which case 'pselect' will not be interrupted by the signal, and
+ will therefore wait on the process's output descriptor for the
+ output that will never come.
+
+ WINDOWSNT doesn't need this facility because its 'pselect'
+ emulation (see 'sys_select' in w32proc.c) waits on a subprocess
+ handle, which becomes signaled when the process exits, and also
+ because that emulation delays the delivery of the simulated SIGCHLD
+ until all the output from the subprocess has been consumed. */
+
+/* FIXME: On Unix-like systems that have a proper 'pselect'
+ (HAVE_PSELECT), we should block SIGCHLD in
+ 'wait_reading_process_output' and pass a non-NULL signal mask to
+ 'pselect' to avoid the need for the self-pipe. */
/* Set up `child_signal_read_fd' and `child_signal_write_fd'. */
@@ -7159,6 +7176,7 @@ child_signal_init (void)
/* Either both are initialized, or both are uninitialized. */
eassert ((child_signal_read_fd < 0) == (child_signal_write_fd < 0));
+#ifndef WINDOWSNT
if (0 <= child_signal_read_fd)
return; /* already done */
@@ -7181,12 +7199,16 @@ child_signal_init (void)
eassert (0 <= fds[1]);
if (fcntl (fds[0], F_SETFL, O_NONBLOCK) != 0)
emacs_perror ("fcntl");
+ if (fcntl (fds[1], F_SETFL, O_NONBLOCK) != 0)
+ emacs_perror ("fcntl");
add_read_fd (fds[0], child_signal_read, NULL);
fd_callback_info[fds[0]].flags &= ~KEYBOARD_FD;
child_signal_read_fd = fds[0];
child_signal_write_fd = fds[1];
+#endif /* !WINDOWSNT */
}
+#ifndef WINDOWSNT
/* Consume a process status change. */
static void
@@ -7195,9 +7217,10 @@ child_signal_read (int fd, void *data)
eassert (0 <= fd);
eassert (fd == child_signal_read_fd);
char dummy;
- if (emacs_read (fd, &dummy, 1) < 0)
+ if (emacs_read (fd, &dummy, 1) < 0 && errno != EAGAIN)
emacs_perror ("reading from child signal FD");
}
+#endif /* !WINDOWSNT */
/* Notify `wait_reading_process_output' of a process status
change. */
@@ -7205,11 +7228,13 @@ child_signal_read (int fd, void *data)
static void
child_signal_notify (void)
{
+#ifndef WINDOWSNT
int fd = child_signal_write_fd;
eassert (0 <= fd);
char dummy = 0;
if (emacs_write (fd, &dummy, 1) != 1)
emacs_perror ("writing to child signal FD");
+#endif
}
/* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
diff --git a/src/term.c b/src/term.c
index 2e2ab2b..1059b06 100644
--- a/src/term.c
+++ b/src/term.c
@@ -790,7 +790,7 @@ tty_write_glyphs (struct frame *f, struct glyph *string,
int len)
cmcheckmagic (tty);
}
-#ifdef HAVE_GPM /* Only used by GPM code. */
+#ifndef DOS_NT
static void
tty_write_glyphs_with_face (register struct frame *f, register struct glyph
*string,
@@ -847,6 +847,7 @@ tty_write_glyphs_with_face (register struct frame *f,
register struct glyph *str
cmcheckmagic (tty);
}
+
#endif
/* An implementation of insert_glyphs for termcap frames. */
@@ -2380,23 +2381,9 @@ frame's terminal). */)
Mouse
***********************************************************************/
-#ifdef HAVE_GPM
-
-void
-term_mouse_moveto (int x, int y)
-{
- /* TODO: how to set mouse position?
- const char *name;
- int fd;
- name = (const char *) ttyname (0);
- fd = emacs_open (name, O_WRONLY, 0);
- SOME_FUNCTION (x, y, fd);
- emacs_close (fd);
- last_mouse_x = x;
- last_mouse_y = y; */
-}
+#ifndef DOS_NT
-/* Implementation of draw_row_with_mouse_face for TTY/GPM. */
+/* Implementation of draw_row_with_mouse_face for TTY/GPM and macOS. */
void
tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
int start_hpos, int end_hpos,
@@ -2428,6 +2415,24 @@ tty_draw_row_with_mouse_face (struct window *w, struct
glyph_row *row,
cursor_to (f, save_y, save_x);
}
+#endif
+
+#ifdef HAVE_GPM
+
+void
+term_mouse_moveto (int x, int y)
+{
+ /* TODO: how to set mouse position?
+ const char *name;
+ int fd;
+ name = (const char *) ttyname (0);
+ fd = emacs_open (name, O_WRONLY, 0);
+ SOME_FUNCTION (x, y, fd);
+ emacs_close (fd);
+ last_mouse_x = x;
+ last_mouse_y = y; */
+}
+
/* Return the current time, as a Time value. Wrap around on overflow. */
static Time
current_Time (void)
diff --git a/src/w32common.h b/src/w32common.h
index 94bb457..714a238 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -50,6 +50,11 @@ extern int os_subtype;
/* Cache system info, e.g., the NT page size. */
extern void cache_system_info (void);
+#ifdef WINDOWSNT
+/* Return a static buffer with the MS-Windows version string. */
+extern char * w32_version_string (void);
+#endif
+
typedef void (* VOIDFNPTR) (void);
/* Load a function address from a DLL. Cast the result via VOIDFNPTR
diff --git a/src/w32fns.c b/src/w32fns.c
index c1e18ff..e93a0b8 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1519,9 +1519,13 @@ w32_clear_under_internal_border (struct frame *f)
int width = FRAME_PIXEL_WIDTH (f);
int height = FRAME_PIXEL_HEIGHT (f);
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
@@ -1548,6 +1552,32 @@ w32_clear_under_internal_border (struct frame *f)
}
}
+/**
+ * w32_set_child_frame_border_width:
+ *
+ * Set width of child frame F's internal border to ARG pixels.
+ * ARG < 0 is treated like ARG = 0.
+ */
+static void
+w32_set_child_frame_border_width (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
+{
+ int argval = check_integer_range (arg, INT_MIN, INT_MAX);
+ int border = max (argval, 0);
+
+ if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
+ {
+ f->child_frame_border_width = border;
+
+ if (FRAME_NATIVE_WINDOW (f) != 0)
+ {
+ adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
+
+ if (FRAME_VISIBLE_P (f))
+ w32_clear_under_internal_border (f);
+ }
+ }
+}
+
/**
* w32_set_internal_border_width:
@@ -5873,6 +5903,28 @@ DEFUN ("x-create-frame", Fx_create_frame,
Sx_create_frame,
parameters);
}
+ /* Same for child frames. */
+ if (NILP (Fassq (Qchild_frame_border_width, parameters)))
+ {
+ Lisp_Object value;
+
+ value = gui_display_get_arg (dpyinfo, parameters,
Qchild_frame_border_width,
+ "childFrameBorderWidth",
"childFrameBorderWidth",
+ RES_TYPE_NUMBER);
+ if (! EQ (value, Qunbound))
+ parameters = Fcons (Fcons (Qchild_frame_border_width, value),
+ parameters);
+
+ }
+
+ gui_default_parameter (f, parameters, Qchild_frame_border_width,
+#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
+ make_fixnum (0),
+#else
+ make_fixnum (1),
+#endif
+ "childFrameBorderWidth", "childFrameBorderWidth",
+ RES_TYPE_NUMBER);
gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum
(0),
"internalBorderWidth", "InternalBorder",
RES_TYPE_NUMBER);
gui_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0),
@@ -9428,6 +9480,18 @@ cache_system_info (void)
w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
}
+#ifdef WINDOWSNT
+char *
+w32_version_string (void)
+{
+ /* NNN.NNN.NNNNNNNNNN */
+ static char version_string[3 + 1 + 3 + 1 + 10 + 1];
+ _snprintf (version_string, sizeof version_string, "%d.%d.%d",
+ w32_major_version, w32_minor_version, w32_build_number);
+ return version_string;
+}
+#endif
+
#ifdef EMACSDEBUG
void
_DebPrint (const char *fmt, ...)
@@ -10232,6 +10296,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
w32_set_foreground_color,
w32_set_icon_name,
w32_set_icon_type,
+ w32_set_child_frame_border_width,
w32_set_internal_border_width,
gui_set_right_divider_width,
gui_set_bottom_divider_width,
diff --git a/src/w32term.c b/src/w32term.c
index 109aa58..0ee805a 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2404,14 +2404,29 @@ w32_draw_stretch_glyph_string (struct glyph_string *s)
else if (!s->background_filled_p)
{
int background_width = s->background_width;
- int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA);
+ int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
- /* Don't draw into left margin, fringe or scrollbar area
- except for header line and mode line. */
- if (x < left_x && !s->row->mode_line_p)
+ /* Don't draw into left fringe or scrollbar area except for
+ header line and mode line. */
+ if (x < text_left_x && !s->row->mode_line_p)
{
- background_width -= left_x - x;
- x = left_x;
+ int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
+ int right_x = text_left_x;
+
+ if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
+ left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
+ else
+ right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
+
+ /* Adjust X and BACKGROUND_WIDTH to fit inside the space
+ between LEFT_X and RIGHT_X. */
+ if (x < left_x)
+ {
+ background_width -= left_x - x;
+ x = left_x;
+ }
+ if (x + background_width > right_x)
+ background_width = right_x - x;
}
if (background_width > 0)
w32_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
diff --git a/src/xdisp.c b/src/xdisp.c
index 32e9773..11b9e1b 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -29813,7 +29813,8 @@ produce_stretch_glyph (struct it *it)
#endif /* HAVE_WINDOW_SYSTEM */
height = 1;
- if (width > 0 && it->line_wrap != TRUNCATE
+ if (width > 0
+ && it->area == TEXT_AREA && it->line_wrap != TRUNCATE
&& it->current_x + width > it->last_visible_x)
{
width = it->last_visible_x - it->current_x;
@@ -31927,9 +31928,8 @@ draw_row_with_mouse_face (struct window *w, int
start_x, struct glyph_row *row,
return;
}
#endif
-#if defined (HAVE_GPM) || defined (MSDOS) || defined (WINDOWSNT)
+
tty_draw_row_with_mouse_face (w, row, start_hpos, end_hpos, draw);
-#endif
}
/* Display the active region described by mouse_face_* according to DRAW. */
diff --git a/src/xfaces.c b/src/xfaces.c
index 258b365..1208713 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -4914,6 +4914,7 @@ lookup_basic_face (struct window *w, struct frame *f, int
face_id)
case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID: name =
Qwindow_divider_first_pixel; break;
case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID: name =
Qwindow_divider_last_pixel; break;
case INTERNAL_BORDER_FACE_ID: name = Qinternal_border; break;
+ case CHILD_FRAME_BORDER_FACE_ID: name = Qchild_frame_border; break;
default:
emacs_abort (); /* the caller is supposed to pass us a basic face id */
@@ -5620,6 +5621,7 @@ realize_basic_faces (struct frame *f)
realize_named_face (f, Qwindow_divider_last_pixel,
WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
realize_named_face (f, Qinternal_border, INTERNAL_BORDER_FACE_ID);
+ realize_named_face (f, Qchild_frame_border, CHILD_FRAME_BORDER_FACE_ID);
realize_named_face (f, Qtab_bar, TAB_BAR_FACE_ID);
realize_named_face (f, Qtab_line, TAB_LINE_FACE_ID);
@@ -6973,6 +6975,7 @@ syms_of_xfaces (void)
DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel");
DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel");
DEFSYM (Qinternal_border, "internal-border");
+ DEFSYM (Qchild_frame_border, "child-frame-border");
/* TTY color-related functions (defined in tty-colors.el). */
DEFSYM (Qtty_color_desc, "tty-color-desc");
diff --git a/src/xfns.c b/src/xfns.c
index 9ab537c..cac41ee 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1800,6 +1800,28 @@ x_change_tool_bar_height (struct frame *f, int height)
#endif /* USE_GTK */
}
+static void
+x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
+{
+ int border = check_int_nonnegative (arg);
+
+ if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
+ {
+ f->child_frame_border_width = border;
+
+#ifdef USE_X_TOOLKIT
+ if (FRAME_X_OUTPUT (f)->edit_widget)
+ widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
+#endif
+
+ if (FRAME_X_WINDOW (f))
+ {
+ adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
+ x_clear_under_internal_border (f);
+ }
+ }
+
+}
static void
x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
@@ -3897,6 +3919,29 @@ This function is an internal primitive--use `make-frame'
instead. */)
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
+
+ /* Same for child frames. */
+ if (NILP (Fassq (Qchild_frame_border_width, parms)))
+ {
+ Lisp_Object value;
+
+ value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width,
+ "childFrameBorderWidth",
"childFrameBorderWidth",
+ RES_TYPE_NUMBER);
+ if (! EQ (value, Qunbound))
+ parms = Fcons (Fcons (Qchild_frame_border_width, value),
+ parms);
+
+ }
+
+ gui_default_parameter (f, parms, Qchild_frame_border_width,
+#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
+ make_fixnum (0),
+#else
+ make_fixnum (1),
+#endif
+ "childFrameBorderWidth", "childFrameBorderWidth",
+ RES_TYPE_NUMBER);
gui_default_parameter (f, parms, Qinternal_border_width,
#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
make_fixnum (0),
@@ -7762,6 +7807,7 @@ frame_parm_handler x_frame_parm_handlers[] =
x_set_foreground_color,
x_set_icon_name,
x_set_icon_type,
+ x_set_child_frame_border_width,
x_set_internal_border_width,
gui_set_right_divider_width,
gui_set_bottom_divider_width,
diff --git a/src/xterm.c b/src/xterm.c
index b8374fe..744b80c 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1293,9 +1293,13 @@ x_clear_under_internal_border (struct frame *f)
int height = FRAME_PIXEL_HEIGHT (f);
int margin = FRAME_TOP_MARGIN_HEIGHT (f);
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
@@ -1360,9 +1364,13 @@ x_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
@@ -3577,14 +3585,29 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
else if (!s->background_filled_p)
{
int background_width = s->background_width;
- int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA);
+ int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
- /* Don't draw into left margin, fringe or scrollbar area
- except for header line and mode line. */
- if (x < left_x && !s->row->mode_line_p)
+ /* Don't draw into left fringe or scrollbar area except for
+ header line and mode line. */
+ if (x < text_left_x && !s->row->mode_line_p)
{
- background_width -= left_x - x;
- x = left_x;
+ int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
+ int right_x = text_left_x;
+
+ if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
+ left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
+ else
+ right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
+
+ /* Adjust X and BACKGROUND_WIDTH to fit inside the space
+ between LEFT_X and RIGHT_X. */
+ if (x < left_x)
+ {
+ background_width -= left_x - x;
+ x = left_x;
+ }
+ if (x + background_width > right_x)
+ background_width = right_x - x;
}
if (background_width > 0)
x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
diff --git a/test/Makefile.in b/test/Makefile.in
index c5e86df..f907602 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -122,8 +122,9 @@ MODULES_EMACSOPT :=
endif
# The actual Emacs command run in the targets below.
-# Prevent any setting of EMACSLOADPATH in user environment causing problems.
-emacs = EMACSLOADPATH= \
+# Prevent any setting of EMACSLOADPATH in user environment causing problems,
+# and prevent locals to influence the text of the errors we expect to receive.
+emacs = LANG=C EMACSLOADPATH= \
EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
$(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT)
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
index 2f71d12..5a0ab54 100644
--- a/test/infra/gitlab-ci.yml
+++ b/test/infra/gitlab-ci.yml
@@ -72,6 +72,7 @@ default:
- lisp/**/*.el
- src/*.{h,c}
- test/infra/*
+ - test/lib-src/*.el
- test/lisp/**/*.el
- test/src/*.el
- changes:
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 6da515b..45cf635 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -524,8 +524,10 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-test--write-file "1-b" file-1)
(auto-revert-test--wait-for-buffer-text
buf-1 "1-b" (auto-revert--timeout))
- (should (buffer-local-value
- 'auto-revert-notify-watch-descriptor buf-1))
+ ;; On emba, `buf-1' is a killed buffer.
+ (when (buffer-live-p buf-1)
+ (should (buffer-local-value
+ 'auto-revert-notify-watch-descriptor buf-1)))
;; Write a buffer to a new file, then modify the new file on disk.
(with-current-buffer buf-2
@@ -607,11 +609,12 @@ This expects `auto-revert--messages' to be bound by
(should auto-revert-mode))
(dotimes (i num-buffers)
- (add-to-list
- 'buffers
- (make-indirect-buffer
- (car buffers) (format "%s-%d" (buffer-file-name (car buffers))
i) 'clone)
- 'append))
+ (push (make-indirect-buffer
+ (car buffers)
+ (format "%s-%d" (buffer-file-name (car buffers)) i)
+ 'clone)
+ buffers))
+ (setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
@@ -638,10 +641,10 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(dotimes (i num-buffers)
- (add-to-list
- 'buffers
- (generate-new-buffer (format "%s-%d" (file-name-nondirectory
tmpfile) i))
- 'append))
+ (push (generate-new-buffer
+ (format "%s-%d" (file-name-nondirectory tmpfile) i))
+ buffers))
+ (setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(insert-file-contents tmpfile 'visit)
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 1b7beea..62a42b7 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -1,4 +1,4 @@
-;;; electric-tests.el --- tests for electric.el
+;;; electric-tests.el --- tests for electric.el -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -135,9 +135,11 @@ The buffer's contents should %s:
(length fixture)
fixture
(if fixture-fn (format "\nNow call this:\n\n%s"
- (pp-to-string fixture-fn)) "")
+ (pp-to-string fixture-fn))
+ "")
(if bindings (format "\nEnsure the following bindings:\n\n%s"
- (pp-to-string bindings)) "")
+ (pp-to-string bindings))
+ "")
char
(if (string= fixture expected-string) "stay" "become")
(replace-regexp-in-string "\n" "\\\\n" expected-string)
@@ -163,8 +165,11 @@ The buffer's contents should %s:
(test-in-comments t)
(test-in-strings t)
(test-in-code t)
- (fixture-fn #'(lambda ()
- (electric-pair-mode 1))))
+ ;; The semantics of CL's defmacro "default values" is subtle:
+ ;; contrary to the actual arguments, these are evaluated (and
+ ;; are expected to return the "default form").
+ ;; `fixture-fn' contains a form whose evaluation returns a function.
+ (fixture-fn '#'electric-pair-mode))
`(progn
,@(cl-loop
for mode in (eval modes) ;FIXME: avoid `eval'
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el
b/test/lisp/emacs-lisp/cl-lib-tests.el
index 97a44c4..065ca4f 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -543,15 +543,7 @@
(apply (lambda (x) (+ x 1)) (list 8)))))
'(5 (6 5) (6 6) 9))))
-(defun cl-lib-tests--dummy-function ()
- ;; Dummy function to see if the file is compiled.
- t)
-
(ert-deftest cl-lib-defstruct-record ()
- ;; This test fails when compiled, see Bug#24402/27718.
- :expected-result (if (byte-code-function-p
- (symbol-function 'cl-lib-tests--dummy-function))
- :failed :passed)
(cl-defstruct foo x)
(let ((x (make-foo :x 42)))
(should (recordp x))
@@ -566,6 +558,7 @@
(should (eq (type-of x) 'vector))
(cl-old-struct-compat-mode 1)
+ (defvar cl-struct-foo)
(let ((cl-struct-foo (cl--struct-get-class 'foo)))
(setf (symbol-function 'cl-struct-foo) :quick-object-witness-check)
(should (eq (type-of x) 'foo))
diff --git a/test/lisp/emacs-lisp/seq-tests.el
b/test/lisp/emacs-lisp/seq-tests.el
index 6703983..05c7fbe 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -29,6 +29,9 @@
(require 'ert)
(require 'seq)
+(eval-when-compile
+ (require 'cl-lib))
+
(defmacro with-test-sequences (spec &rest body)
"Successively bind VAR to a list, vector, and string built from SEQ.
Evaluate BODY for each created sequence.
@@ -108,16 +111,12 @@ Evaluate BODY for each created sequence.
'((a 0) (b 1) (c 2) (d 3)))))
(ert-deftest test-seq-do-indexed ()
- (let ((result nil))
- (seq-do-indexed (lambda (elt i)
- (add-to-list 'result (list elt i)))
- nil)
- (should (equal result nil)))
+ (let (result)
+ (seq-do-indexed (lambda (elt i) (push (list elt i) result)) ())
+ (should-not result))
(with-test-sequences (seq '(4 5 6))
- (let ((result nil))
- (seq-do-indexed (lambda (elt i)
- (add-to-list 'result (list elt i)))
- seq)
+ (let (result)
+ (seq-do-indexed (lambda (elt i) (push (list elt i) result)) seq)
(should (equal (seq-elt result 0) '(6 2)))
(should (equal (seq-elt result 1) '(5 1)))
(should (equal (seq-elt result 2) '(4 0))))))
@@ -410,12 +409,10 @@ Evaluate BODY for each created sequence.
(ert-deftest test-seq-random-elt-take-all ()
(let ((seq '(a b c d e))
- (elts '()))
- (should (= 0 (length elts)))
+ elts)
(dotimes (_ 1000)
(let ((random-elt (seq-random-elt seq)))
- (add-to-list 'elts
- random-elt)))
+ (cl-pushnew random-elt elts)))
(should (= 5 (length elts)))))
(ert-deftest test-seq-random-elt-signal-on-empty ()
diff --git a/test/lisp/find-cmd-tests.el b/test/lisp/find-cmd-tests.el
new file mode 100644
index 0000000..b8e0f27
--- /dev/null
+++ b/test/lisp/find-cmd-tests.el
@@ -0,0 +1,45 @@
+;;; find-cmd-tests.el --- tests for find-cmd.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 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'find-cmd)
+
+(ert-deftest find-cmd-test-find-cmd ()
+ (should
+ (string-match
+ (rx "find " (+ any)
+ " \\( \\( -name .svn -or -name .git -or -name .CVS \\)"
+ " -prune -or -true \\)"
+ " \\( \\( \\(" " -name \\*.pl -or -name \\*.pm -or -name \\*.t \\)"
+ " -or -mtime \\+1 \\) -and \\( -fstype nfs -or -fstype ufs \\) \\) ")
+ (find-cmd '(prune (name ".svn" ".git" ".CVS"))
+ '(and (or (name "*.pl" "*.pm" "*.t")
+ (mtime "+1"))
+ (fstype "nfs" "ufs"))))))
+
+(ert-deftest find-cmd-test-find-cmd/error-unknown-atom ()
+ (should-error (find-cmd '(unknown 123))))
+
+(ert-deftest find-cmd-test-find-cmd/error-wrong-argnum ()
+ (should-error (find-cmd '(name))))
+
+(provide 'find-cmd-tests)
+;;; find-cmd-tests.el ends here
diff --git a/test/lisp/net/sasl-cram-tests.el b/test/lisp/net/sasl-cram-tests.el
new file mode 100644
index 0000000..e0230dd
--- /dev/null
+++ b/test/lisp/net/sasl-cram-tests.el
@@ -0,0 +1,46 @@
+;;; sasl-cram-tests.el --- tests for sasl-cram.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Test case from RFC 2195.
+
+;;; Code:
+
+(require 'ert)
+(require 'sasl)
+(require 'sasl-cram)
+
+(ert-deftest sasl-cram-md5-response-test ()
+ ;; The following strings are taken from section 2 of RFC 2195.
+ (let ((client
+ (sasl-make-client (sasl-find-mechanism '("CRAM-MD5"))
+ "user"
+ "imap"
+ "localhost"))
+ (data (base64-decode-string
"PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+"))
+ (sasl-read-passphrase
+ (lambda (_prompt) (copy-sequence "tanstaaftanstaaf"))))
+ (should (equal (sasl-cram-md5-response client (vector nil data))
+ "user b913a602c7eda7a495b4e6e7334d3890"))))
+
+(provide 'sasl-cram-tests)
+;;; sasl-cram-tests.el ends here
diff --git a/test/lisp/net/sasl-tests.el b/test/lisp/net/sasl-tests.el
new file mode 100644
index 0000000..dab4075
--- /dev/null
+++ b/test/lisp/net/sasl-tests.el
@@ -0,0 +1,59 @@
+;;; sasl-tests.el --- tests for sasl.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'sasl)
+
+(ert-deftest sasl-test-make-client ()
+ (let ((client (sasl-make-client 'foo 'bar 'baz 'zut)))
+ (should (eq (sasl-client-mechanism client) 'foo))
+ (should (eq (sasl-client-name client) 'bar))
+ (should (eq (sasl-client-service client) 'baz))
+ (should (eq (sasl-client-server client) 'zut))))
+
+(ert-deftest sasl-test-client-set-properties ()
+ (let ((client (sasl-make-client 'foo 'bar 'baz 'zut)))
+ (sasl-client-set-property client 'foo 'bar)
+ (should (eq (sasl-client-property client 'foo) 'bar))))
+
+(ert-deftest sasl-test-step-data ()
+ (let ((step [nil nil]))
+ (sasl-step-set-data step "foo")
+ (should (equal (sasl-step-data step) "foo"))))
+
+(ert-deftest sasl-test-unique-id ()
+ (should (stringp (sasl-unique-id)))
+ (should-not (equal (sasl-unique-id) (sasl-unique-id))))
+
+(ert-deftest sasl-test-find-mechanism ()
+ (should (sasl-find-mechanism '("ANONYMOUS")))
+ (should-not (sasl-find-mechanism '("nonexistent mechanism"))))
+
+(ert-deftest sasl-test-mechanism-name ()
+ (let ((mechanism (sasl-find-mechanism '("ANONYMOUS"))))
+ (should (equal (sasl-mechanism-name mechanism) "ANONYMOUS"))))
+
+(provide 'sasl-tests)
+;;; sasl-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5deee65..19a40fd 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3192,6 +3192,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test17-insert-directory-one-file ()
"Check `insert-directory' inside directory listing."
(skip-unless (tramp--test-enabled))
+ ;; Relative file names in dired are not supported in tramp-crypt.el.
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -5247,7 +5249,7 @@ Use direct async.")
;; order to avoid a question. `explicit-sh-args' echoes the
;; test data.
(with-current-buffer (get-buffer-create "*shell*")
- (ignore-errors (kill-process (current-buffer)))
+ (ignore-errors (kill-process (get-buffer-process (current-buffer))))
(should-not explicit-shell-file-name)
(call-interactively #'shell)
(with-timeout (10)
@@ -5720,16 +5722,16 @@ This requires restrictions of file name syntax."
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-ftp-file-name-handler))
+(defun tramp--test-crypt-p ()
+ "Check, whether the remote directory is crypted"
+ (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-docker-p ()
"Check, whether the docker method is used.
This does not support some special file names."
(string-equal
"docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
-(defun tramp--test-crypt-p ()
- "Check, whether the remote directory is crypted"
- (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
-
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
@@ -5748,7 +5750,7 @@ If optional METHOD is given, it is checked first."
"Check, whether the remote host runs HP-UX.
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory) nil
+ (file-truename tramp-test-temporary-file-directory)
(string-match-p
"^HP-UX" (tramp-get-connection-property tramp-test-vec "uname" "")))
@@ -5757,7 +5759,7 @@ Several special characters do not work properly there."
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory) nil
+ (file-truename tramp-test-temporary-file-directory)
(string-match-p
"ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
@@ -5787,6 +5789,17 @@ This does not support special file names."
"Check, whether the remote host runs a based method from tramp-sh.el."
(tramp-sh-file-name-handler-p tramp-test-vec))
+(defun tramp--test-sh-no-ls--dired-p ()
+ "Check, whether the remote host runs a based method from tramp-sh.el.
+Additionally, ls does not support \"--dired\"."
+ (and (tramp--test-sh-p)
+ (with-temp-buffer
+ ;; We must refill the cache. `insert-directory' does it.
+ ;; This fails for tramp-crypt.el, so we ignore that.
+ (ignore-errors
+ (insert-directory tramp-test-temporary-file-directory "-al"))
+ (not (tramp-get-connection-property tramp-test-vec "ls--dired" nil)))))
+
(defun tramp--test-share-p ()
"Check, whether the method needs a share."
(and (tramp--test-gvfs-p)
@@ -6023,17 +6036,20 @@ This requires restrictions of file name syntax."
;; expanded to <TAB>.
(let ((files
(list
- (if (or (tramp--test-ange-ftp-p)
- (tramp--test-gvfs-p)
- (tramp--test-rclone-p)
- (tramp--test-sudoedit-p)
- (tramp--test-windows-nt-or-smb-p))
- "foo bar baz"
- (if (or (tramp--test-adb-p)
- (tramp--test-docker-p)
- (eq system-type 'cygwin))
- " foo bar baz "
- " foo\tbar baz\t"))
+ (cond ((or (tramp--test-ange-ftp-p)
+ (tramp--test-docker-p)
+ (tramp--test-gvfs-p)
+ (tramp--test-rclone-p)
+ (tramp--test-sudoedit-p)
+ (tramp--test-windows-nt-or-smb-p))
+ "foo bar baz")
+ ((or (tramp--test-adb-p)
+ (eq system-type 'cygwin))
+ " foo bar baz ")
+ ((tramp--test-sh-no-ls--dired-p)
+ "\tfoo bar baz\t")
+ (t " foo\tbar baz\t"))
+ "@foo@bar@baz@"
"$foo$bar$$baz$"
"-foo-bar-baz-"
"%foo%bar%baz%"
diff --git a/test/lisp/progmodes/asm-mode-tests.el
b/test/lisp/progmodes/asm-mode-tests.el
index 6ae4fdf..8787217 100644
--- a/test/lisp/progmodes/asm-mode-tests.el
+++ b/test/lisp/progmodes/asm-mode-tests.el
@@ -69,4 +69,14 @@
(should (string-match-p ";;; \nlabel:" (buffer-string)))
(should (= (current-column) 4))))
+(ert-deftest asm-mode-tests-fill-comment ()
+ (asm-mode-tests--with-temp-buffer
+ (call-interactively #'comment-dwim)
+ (insert "Pellentesque condimentum, magna ut suscipit hendrerit, \
+ipsum augue ornare nulla, non luctus diam neque sit amet urna.")
+ (call-interactively #'fill-paragraph)
+ (should (equal (buffer-string) "\t;; Pellentesque condimentum, \
+magna ut suscipit hendrerit,\n\t;; ipsum augue ornare nulla, non \
+luctus diam neque sit amet\n\t;; urna."))))
+
;;; asm-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index fd43707..badcad6 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -834,5 +834,61 @@ to (xref-elisp-test-descr-to-target xref)."
(indent-region (point-min) (point-max))
(should (equal (buffer-string) orig)))))
+(defun test--font (form search)
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (if (stringp form)
+ (insert form)
+ (pp form (current-buffer)))
+ (font-lock-debug-fontify)
+ (goto-char (point-min))
+ (and (re-search-forward search nil t)
+ (get-text-property (match-beginning 1) 'face))))
+
+(ert-deftest test-elisp-font-keywords-1 ()
+ ;; Special form.
+ (should (eq (test--font '(if foo bar) "(\\(if\\)")
+ 'font-lock-keyword-face))
+ ;; Macro.
+ (should (eq (test--font '(when foo bar) "(\\(when\\)")
+ 'font-lock-keyword-face))
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ (error (if a b)))
+ "(\\(if\\)")
+ 'font-lock-keyword-face))
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ (when (if a b)))
+ "(\\(when\\)")
+ 'nil)))
+
+(ert-deftest test-elisp-font-keywords-2 ()
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ (error (when a b)))
+ "(\\(when\\)")
+ 'font-lock-keyword-face)))
+
+(ert-deftest test-elisp-font-keywords-3 ()
+ (should (eq (test--font '(setq a '(if when zot))
+ "(\\(if\\)")
+ nil)))
+
+(ert-deftest test-elisp-font-keywords-4 ()
+ :expected-result :failed ; FIXME bug#43265
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ ((if foo) (when a b)))
+ "(\\(if\\)")
+ nil)))
+
+(ert-deftest test-elisp-font-keywords-5 ()
+ (should (eq (test--font '(condition-case (when a)
+ (foo)
+ (error t))
+ "(\\(when\\)")
+ nil)))
+
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here
diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh
index dc184ea..bd4a74f 100755
--- a/test/manual/indent/shell.sh
+++ b/test/manual/indent/shell.sh
@@ -6,6 +6,13 @@ setlock -n /tmp/getmail.lock && echo getmail isn\'t running
toto=$(grep hello foo |
wc)
+myfun () {
+ for ((it=0; it<${limit}; ++it))
+ {
+ echo "whatever $it"
+ }
+}
+
# adsgsdg
if foo; then
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 949f735..a3fba8d 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -789,6 +789,36 @@ have written output."
(should (equal calls
(list (list process "finished\n"))))))))))
+(ert-deftest process-tests/multiple-threads-waiting ()
+ (skip-unless (fboundp 'make-thread))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (process-tests--with-processes processes
+ (let ((threads ())
+ (cat (executable-find "cat")))
+ (skip-unless cat)
+ (dotimes (i 10)
+ (let* ((name (format "test %d" i))
+ (process (make-process :name name
+ :command (list cat)
+ :coding 'no-conversion
+ :noquery t
+ :connection-type 'pipe)))
+ (push process processes)
+ (set-process-thread process nil)
+ (push (make-thread
+ (lambda ()
+ (while (accept-process-output process)))
+ name)
+ threads)))
+ (mapc #'process-send-eof processes)
+ (cl-loop for process in processes
+ and thread in threads
+ do
+ (should-not (thread-join thread))
+ (should-not (thread-last-error))
+ (should (eq (process-status process) 'exit))
+ (should (eql (process-exit-status process) 0)))))))
+
(defun process-tests--eval (command form)
"Return a command that evaluates FORM in an Emacs subprocess.
COMMAND must be a list returned by
- scratch/etags-regen updated (153a549 -> f4a1d47), Dmitry Gutov, 2021/02/07
- scratch/etags-regen 8d00e2f 1/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 1daad17 2/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 44f19c7 3/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 25b2915 7/8: Introduce project-files-filtered and use it, Dmitry Gutov, 2021/02/07
- scratch/etags-regen f4a1d47 8/8: Brute force refresh implementation, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 3098e47 4/8: Merge branch 'master' into scratch/etags-regen,
Dmitry Gutov <=
- scratch/etags-regen 4f7b533 6/8: etags-regen--all-files: Extract to a separate function, Dmitry Gutov, 2021/02/07
- scratch/etags-regen f520e5d 5/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07