aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2021-01-30 14:09:37 +0100
committerAndrea Corallo2021-01-30 14:09:37 +0100
commita8b8d220b4fccaa812e85f9b2b3715593dc285ac (patch)
tree07051469f09277b1993eee37870059e3d0abf71e
parentb8d3ae78c54db7c7bb65d367a80f9be3d8744c48 (diff)
parented2f2cc5577d5d9b61db7a5b61e93e79d678be41 (diff)
downloademacs-a8b8d220b4fccaa812e85f9b2b3715593dc285ac.tar.gz
emacs-a8b8d220b4fccaa812e85f9b2b3715593dc285ac.zip
Merge remote-tracking branch 'savannah/master' into native-comp
-rw-r--r--admin/notes/unicode10
-rw-r--r--admin/unidata/unidata-gen.el6
-rw-r--r--doc/emacs/glossary.texi8
-rw-r--r--doc/emacs/kmacro.texi8
-rw-r--r--doc/emacs/maintaining.texi22
-rw-r--r--doc/lispref/frames.texi50
-rw-r--r--doc/lispref/text.texi17
-rw-r--r--doc/misc/org.texi6
-rw-r--r--doc/misc/tramp.texi3
-rw-r--r--etc/NEWS29
-rw-r--r--leim/leim-ext.el12
-rw-r--r--lisp/auth-source.el2
-rw-r--r--lisp/autorevert.el105
-rw-r--r--lisp/calc/calc-graph.el6
-rw-r--r--lisp/dired-aux.el2
-rw-r--r--lisp/dired.el21
-rw-r--r--lisp/emacs-lisp/bindat.el112
-rw-r--r--lisp/emacs-lisp/checkdoc.el4
-rw-r--r--lisp/emacs-lisp/crm.el2
-rw-r--r--lisp/emacs-lisp/derived.el2
-rw-r--r--lisp/emacs-lisp/eieio-opt.el2
-rw-r--r--lisp/emacs-lisp/generic.el9
-rw-r--r--lisp/emacs-lisp/helper.el29
-rw-r--r--lisp/emacs-lisp/lisp-mode.el81
-rw-r--r--lisp/emacs-lisp/macroexp.el39
-rw-r--r--lisp/emacs-lisp/package-x.el2
-rw-r--r--lisp/emacs-lisp/pcase.el44
-rw-r--r--lisp/emacs-lisp/regi.el55
-rw-r--r--lisp/emacs-lisp/shadow.el22
-rw-r--r--lisp/emacs-lisp/tcover-ses.el28
-rw-r--r--lisp/emacs-lisp/unsafep.el9
-rw-r--r--lisp/ezimage.el2
-rw-r--r--lisp/faces.el11
-rw-r--r--lisp/files.el2
-rw-r--r--lisp/find-cmd.el4
-rw-r--r--lisp/flow-ctrl.el13
-rw-r--r--lisp/generic-x.el109
-rw-r--r--lisp/gnus/gnus-agent.el383
-rw-r--r--lisp/gnus/gnus-async.el9
-rw-r--r--lisp/gnus/gnus-cache.el126
-rw-r--r--lisp/gnus/gnus-cloud.el16
-rw-r--r--lisp/gnus/gnus-icalendar.el1
-rw-r--r--lisp/gnus/gnus-sum.el65
-rw-r--r--lisp/gnus/gnus.el9
-rw-r--r--lisp/gnus/nnvirtual.el172
-rw-r--r--lisp/image/gravatar.el15
-rw-r--r--lisp/international/isearch-x.el5
-rw-r--r--lisp/international/iso-cvt.el24
-rw-r--r--lisp/international/ja-dic-cnv.el11
-rw-r--r--lisp/international/ja-dic-utl.el2
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/kkc.el2
-rw-r--r--lisp/international/latexenc.el4
-rw-r--r--lisp/international/latin1-disp.el19
-rw-r--r--lisp/international/mule-cmds.el2
-rw-r--r--lisp/international/mule-diag.el27
-rw-r--r--lisp/international/ogonek.el2
-rw-r--r--lisp/international/quail.el18
-rw-r--r--lisp/international/robin.el2
-rw-r--r--lisp/international/titdic-cnv.el254
-rw-r--r--lisp/international/utf-7.el2
-rw-r--r--lisp/isearch.el3
-rw-r--r--lisp/kmacro.el11
-rw-r--r--lisp/language/burmese.el4
-rw-r--r--lisp/language/cham.el4
-rw-r--r--lisp/language/china-util.el2
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/ethio-util.el11
-rw-r--r--lisp/language/ethiopic.el4
-rw-r--r--lisp/language/hanja-util.el2
-rw-r--r--lisp/language/hebrew.el6
-rw-r--r--lisp/language/ind-util.el14
-rw-r--r--lisp/language/indian.el2
-rw-r--r--lisp/language/japan-util.el8
-rw-r--r--lisp/language/khmer.el2
-rw-r--r--lisp/language/korea-util.el6
-rw-r--r--lisp/language/korean.el4
-rw-r--r--lisp/language/lao-util.el8
-rw-r--r--lisp/language/lao.el2
-rw-r--r--lisp/language/misc-lang.el8
-rw-r--r--lisp/language/sinhala.el2
-rw-r--r--lisp/language/tai-viet.el2
-rw-r--r--lisp/language/thai-util.el8
-rw-r--r--lisp/language/thai-word.el5
-rw-r--r--lisp/language/tibet-util.el66
-rw-r--r--lisp/language/tibetan.el2
-rw-r--r--lisp/language/tv-util.el4
-rw-r--r--lisp/language/viet-util.el2
-rw-r--r--lisp/leim/quail/compose.el2
-rw-r--r--lisp/leim/quail/viqr.el2
-rw-r--r--lisp/mail/rmail.el8
-rw-r--r--lisp/mail/rmailsum.el5
-rw-r--r--lisp/mail/sendmail.el16
-rw-r--r--lisp/net/ange-ftp.el2
-rw-r--r--lisp/net/dbus.el1
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el2
-rw-r--r--lisp/net/sasl-ntlm.el4
-rw-r--r--lisp/net/sasl.el19
-rw-r--r--lisp/net/sieve-mode.el18
-rw-r--r--lisp/net/tramp-adb.el10
-rw-r--r--lisp/net/tramp-sh.el6
-rw-r--r--lisp/net/webjump.el3
-rw-r--r--lisp/newcomment.el47
-rw-r--r--lisp/nxml/rng-util.el2
-rw-r--r--lisp/obsolete/nnir.el1
-rw-r--r--lisp/org/ol.el8
-rw-r--r--lisp/org/org.el2
-rw-r--r--lisp/play/handwrite.el86
-rw-r--r--lisp/play/mpuz.el30
-rw-r--r--lisp/progmodes/asm-mode.el3
-rw-r--r--lisp/progmodes/bat-mode.el2
-rw-r--r--lisp/progmodes/compile.el7
-rw-r--r--lisp/progmodes/flymake.el16
-rw-r--r--lisp/progmodes/perl-mode.el7
-rw-r--r--lisp/progmodes/project.el4
-rw-r--r--lisp/progmodes/sh-script.el14
-rw-r--r--lisp/progmodes/xref.el3
-rw-r--r--lisp/recentf.el9
-rw-r--r--lisp/replace.el80
-rw-r--r--lisp/simple.el23
-rw-r--r--lisp/startup.el2
-rw-r--r--lisp/subr.el10
-rw-r--r--lisp/tab-line.el4
-rw-r--r--lisp/term/w32console.el2
-rw-r--r--lisp/textmodes/nroff-mode.el9
-rw-r--r--lisp/textmodes/sgml-mode.el4
-rw-r--r--lisp/textmodes/tex-mode.el7
-rw-r--r--lisp/tmm.el14
-rw-r--r--lisp/url/url-about.el10
-rw-r--r--lisp/url/url-cache.el2
-rw-r--r--lisp/url/url-cid.el2
-rw-r--r--lisp/url/url-dav.el18
-rw-r--r--lisp/url/url-expand.el2
-rw-r--r--lisp/url/url-file.el2
-rw-r--r--lisp/url/url-gw.el15
-rw-r--r--lisp/url/url-http.el25
-rw-r--r--lisp/url/url-imap.el5
-rw-r--r--lisp/url/url-ldap.el2
-rw-r--r--lisp/url/url-mailto.el11
-rw-r--r--lisp/url/url-methods.el4
-rw-r--r--lisp/url/url-misc.el2
-rw-r--r--lisp/url/url-news.el4
-rw-r--r--lisp/url/url-nfs.el2
-rw-r--r--lisp/url/url-privacy.el4
-rw-r--r--lisp/url/url-proxy.el2
-rw-r--r--lisp/url/url-tramp.el2
-rw-r--r--lisp/url/url.el22
-rw-r--r--lisp/vc/vc-dir.el11
-rw-r--r--lisp/vc/vc-git.el3
-rw-r--r--lisp/vc/vc-hg.el3
-rw-r--r--lisp/wdired.el24
-rw-r--r--lisp/whitespace.el4
-rw-r--r--lisp/window.el9
-rw-r--r--src/cmds.c1
-rw-r--r--src/dispextern.h1
-rw-r--r--src/editfns.c11
-rw-r--r--src/emacs.c10
-rw-r--r--src/fns.c34
-rw-r--r--src/frame.c12
-rw-r--r--src/frame.h22
-rw-r--r--src/nsfns.m19
-rw-r--r--src/nsterm.m10
-rw-r--r--src/process.c2
-rw-r--r--src/w32common.h5
-rw-r--r--src/w32fns.c71
-rw-r--r--src/w32term.c27
-rw-r--r--src/xdisp.c3
-rw-r--r--src/xfaces.c3
-rw-r--r--src/xfns.c46
-rw-r--r--src/xterm.c47
-rw-r--r--test/Makefile.in5
-rw-r--r--test/lisp/electric-tests.el15
-rw-r--r--test/lisp/find-cmd-tests.el45
-rw-r--r--test/lisp/net/sasl-cram-tests.el46
-rw-r--r--test/lisp/net/sasl-tests.el59
-rw-r--r--test/lisp/net/tramp-tests.el8
-rw-r--r--test/lisp/progmodes/asm-mode-tests.el10
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el11
-rwxr-xr-xtest/manual/indent/shell.sh7
180 files changed, 2222 insertions, 1248 deletions
diff --git a/admin/notes/unicode b/admin/notes/unicode
index 45455d897f3..bcede9c6ed1 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -256,15 +256,6 @@ nontrivial changes to the build process.
256 256
257 etc/tutorials/TUTORIAL.ja 257 etc/tutorials/TUTORIAL.ja
258 258
259 * iso-2022-7bit
260
261 This file contains multiple Chinese charsets, and converting it
262 to UTF-8 would lose the charset property and would change the
263 code's behavior. Although this could be worked around by
264 propertizing the strings, that hasn't been done.
265
266 lisp/international/titdic-cnv.el
267
268 * utf-8-emacs 259 * utf-8-emacs
269 260
270 These files contain characters that cannot be encoded in UTF-8. 261 These files contain characters that cannot be encoded in UTF-8.
@@ -276,6 +267,7 @@ nontrivial changes to the build process.
276 lisp/language/tibetan.el 267 lisp/language/tibetan.el
277 lisp/leim/quail/ethiopic.el 268 lisp/leim/quail/ethiopic.el
278 lisp/leim/quail/tibetan.el 269 lisp/leim/quail/tibetan.el
270 lisp/international/titdic-cnv.el
279 271
280 * binary files 272 * binary files
281 273
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 3918853088f..221c9b104e0 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)."
1416 (or elt (user-error "Unknown output file: %s" basename)) 1416 (or elt (user-error "Unknown output file: %s" basename))
1417 (or noninteractive (message "Generating %s..." file)) 1417 (or noninteractive (message "Generating %s..." file))
1418 (with-temp-file file 1418 (with-temp-file file
1419 (insert ";; " copyright " 1419 (insert ";;; " basename " -*- lexical-binding:t -*-
1420;; " copyright "
1420;; Generated from Unicode data files by unidata-gen.el. 1421;; Generated from Unicode data files by unidata-gen.el.
1421;; The sources for this file are found in the admin/unidata/ directory in 1422;; The sources for this file are found in the admin/unidata/ directory in
1422;; the Emacs sources. The Unicode data files are used under the 1423;; 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)."
1451(defun unidata-gen-charprop (&optional charprop-file) 1452(defun unidata-gen-charprop (&optional charprop-file)
1452 (or charprop-file (setq charprop-file (pop command-line-args-left))) 1453 (or charprop-file (setq charprop-file (pop command-line-args-left)))
1453 (with-temp-file charprop-file 1454 (with-temp-file charprop-file
1454 (insert ";; Automatically generated by unidata-gen.el.\n" 1455 (insert ";; Automatically generated by unidata-gen.el."
1456 " -*- lexical-binding: t -*-\n"
1455 ";; See the admin/unidata/ directory in the Emacs sources.\n") 1457 ";; See the admin/unidata/ directory in the Emacs sources.\n")
1456 (dolist (elt unidata-file-alist) 1458 (dolist (elt unidata-file-alist)
1457 (dolist (proplist (cdr elt)) 1459 (dolist (proplist (cdr elt))
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 35df06591eb..4f971eb1e01 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -1369,10 +1369,14 @@ configurations. @xref{Tab Bars}.
1369The tab line is a line of tabs at the top of an Emacs window. 1369The tab line is a line of tabs at the top of an Emacs window.
1370Clicking on one of these tabs switches window buffers. @xref{Tab Line}. 1370Clicking on one of these tabs switches window buffers. @xref{Tab Line}.
1371 1371
1372@item Tag
1373A tag is an identifier in a program source. @xref{Xref}.
1374
1372@anchor{Glossary---Tags Table} 1375@anchor{Glossary---Tags Table}
1373@item Tags Table 1376@item Tags Table
1374A tags table is a file that serves as an index to the function 1377A tags table is a file that serves as an index to identifiers: definitions
1375definitions in one or more other files. @xref{Tags Tables}. 1378of functions, macros, data structures, etc., in one or more other files.
1379@xref{Tags Tables}.
1376 1380
1377@item Termscript File 1381@item Termscript File
1378A termscript file contains a record of all characters sent by Emacs to 1382A 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 adb2ab8d561..e713c6ef8c0 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
179define it, so @kbd{C-u 4 C-x )} executes the macro immediately 3 179define it, so @kbd{C-u 4 C-x )} executes the macro immediately 3
180additional times. 180additional times.
181 181
182@findex kdb-macro-redisplay
183@kindex C-x C-k Q
184 While executing a long-running keyboard macro, it can sometimes be
185useful to trigger a redisplay (to show how far we've gotten). The
186@kbd{C-x C-k Q} can be used for this. As a not very useful example,
187@kbd{C-x ( M-f C-x C-k Q C-x )} will create a macro that will
188redisplay once per iteration when saying @kbd{C-u 42 C-x e}.
189
182@node Keyboard Macro Ring 190@node Keyboard Macro Ring
183@section The Keyboard Macro Ring 191@section The Keyboard Macro Ring
184 192
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 415815473e5..bc276c49046 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.
1994@section Find Identifier References 1994@section Find Identifier References
1995@cindex xref 1995@cindex xref
1996 1996
1997@cindex tag
1997 An @dfn{identifier} is a name of a syntactical subunit of the 1998 An @dfn{identifier} is a name of a syntactical subunit of the
1998program: a function, a subroutine, a method, a class, a data type, a 1999program: a function, a subroutine, a method, a class, a data type, a
1999macro, etc. In a programming language, each identifier is a symbol in 2000macro, etc. In a programming language, each identifier is a symbol in
2000the language's syntax. Program development and maintenance requires 2001the language's syntax. Identifiers are also known as @dfn{tags}.
2001capabilities to quickly find where each identifier was defined and 2002
2002referenced, to rename identifiers across the entire project, etc. 2003Program development and maintenance requires capabilities to quickly
2003 2004find where each identifier was defined and referenced, to rename
2004These capabilities are also useful for finding references in major 2005identifiers across the entire project, etc. These capabilities are
2005modes other than those defined to support programming languages. For 2006also useful for finding references in major modes other than those
2006example, chapters, sections, appendices, etc.@: of a text or a @TeX{} 2007defined to support programming languages. For example, chapters,
2007document can be treated as subunits as well, and their names can be 2008sections, appendices, etc.@: of a text or a @TeX{} document can be
2008used as identifiers. In this chapter, we use the term ``identifiers'' 2009treated as subunits as well, and their names can be used as
2009to collectively refer to the names of any kind of subunits, in program 2010identifiers. In this chapter, we use the term ``identifiers'' to
2011collectively refer to the names of any kind of subunits, in program
2010source and in other kinds of text alike. 2012source and in other kinds of text alike.
2011 2013
2012Emacs provides a unified interface to these capabilities, called 2014Emacs provides a unified interface to these capabilities, called
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 7f2a6f75422..a15511dc9f5 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -694,9 +694,17 @@ parameter (@pxref{Management Parameters}).
694 694
695@item Internal Border 695@item Internal Border
696The internal border is a border drawn by Emacs around the inner frame 696The internal border is a border drawn by Emacs around the inner frame
697(see below). Its width is specified by the @code{internal-border-width} 697(see below). The specification of its appearance depends on whether
698frame parameter (@pxref{Layout Parameters}). Its color is specified by 698or not the given frame is a child frame (@pxref{Child Frames}).
699the background of the @code{internal-border} face. 699
700For normal frames its width is specified by the @code{internal-border-width}
701frame parameter (@pxref{Layout Parameters}), and its color is specified by the
702background of the @code{internal-border} face.
703
704For child frames its width is specified by the @code{child-frame-border-width}
705frame parameter (but will use the @code{internal-border-width} parameter as
706fallback), and its color is specified by the background of the
707@code{child-frame-border} face.
700 708
701@item Inner Frame 709@item Inner Frame
702@cindex inner frame 710@cindex inner frame
@@ -1790,6 +1798,11 @@ The width in pixels of the frame's outer border (@pxref{Frame Geometry}).
1790The width in pixels of the frame's internal border (@pxref{Frame 1798The width in pixels of the frame's internal border (@pxref{Frame
1791Geometry}). 1799Geometry}).
1792 1800
1801@vindex child-frame-border-width@r{, a frame parameter}
1802@item child-frame-border-width
1803The width in pixels of the frame's internal border (@pxref{Frame
1804Geometry}) if the given frame is a child frame (@pxref{Child Frames}).
1805
1793@vindex vertical-scroll-bars@r{, a frame parameter} 1806@vindex vertical-scroll-bars@r{, a frame parameter}
1794@item vertical-scroll-bars 1807@item vertical-scroll-bars
1795Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical 1808Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
@@ -2398,7 +2411,7 @@ attribute of the @code{default} face.
2398 2411
2399@vindex foreground-color@r{, a frame parameter} 2412@vindex foreground-color@r{, a frame parameter}
2400@item foreground-color 2413@item foreground-color
2401The color to use for the image of a character. It is equivalent to 2414The color to use for characters. It is equivalent to
2402the @code{:foreground} attribute of the @code{default} face. 2415the @code{:foreground} attribute of the @code{default} face.
2403 2416
2404@vindex background-color@r{, a frame parameter} 2417@vindex background-color@r{, a frame parameter}
@@ -3748,10 +3761,31 @@ for instance using the window manager, then this produces a quit and
3748 You can specify the mouse pointer style for particular text or 3761 You can specify the mouse pointer style for particular text or
3749images using the @code{pointer} text property, and for images with the 3762images using the @code{pointer} text property, and for images with the
3750@code{:pointer} and @code{:map} image properties. The values you can 3763@code{:pointer} and @code{:map} image properties. The values you can
3751use in these properties are @code{text} (or @code{nil}), @code{arrow}, 3764use in these properties are in the table below. The actual shapes
3752@code{hand}, @code{vdrag}, @code{hdrag}, @code{modeline}, and 3765may vary between systems; the descriptions are examples.
3753@code{hourglass}. @code{text} stands for the usual mouse pointer 3766
3754style used over text. 3767@table @code
3768@item text
3769@itemx nil
3770The usual mouse pointer style used over text (an ``I''-like shape).
3771
3772@item arrow
3773@itemx vdrag
3774@itemx modeline
3775An arrow that points north-west.
3776
3777@item hand
3778A hand that points upwards.
3779
3780@item hdrag
3781A right-left arrow.
3782
3783@item nhdrag
3784An up-down arrow.
3785
3786@item hourglass
3787A rotating ring.
3788@end table
3755 3789
3756 Over void parts of the window (parts that do not correspond to any 3790 Over void parts of the window (parts that do not correspond to any
3757of the buffer contents), the mouse pointer usually uses the 3791of the buffer contents), the mouse pointer usually uses the
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 14854a5aafa..b3673465240 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -1441,6 +1441,11 @@ the @code{amalgamating-undo-limit} variable. If this variable is 1,
1441no changes are amalgamated. 1441no changes are amalgamated.
1442@end defun 1442@end defun
1443 1443
1444A Lisp program can amalgamate a series of changes into a single change
1445group by calling @code{undo-amalgamate-change-group} (@pxref{Atomic
1446Changes}). Note that @code{amalgamating-undo-limit} has no effect on
1447the groups produced by that function.
1448
1444@defvar undo-auto-current-boundary-timer 1449@defvar undo-auto-current-boundary-timer
1445Some buffers, such as process buffers, can change even when no 1450Some buffers, such as process buffers, can change even when no
1446commands are executing. In these cases, @code{undo-boundary} is 1451commands are executing. In these cases, @code{undo-boundary} is
@@ -5629,9 +5634,17 @@ This function cancels and undoes all the changes in the change group
5629specified by @var{handle}. 5634specified by @var{handle}.
5630@end defun 5635@end defun
5631 5636
5637 You can cause some or all of the changes in a change group to be
5638considered as a single unit for the purposes of the @code{undo}
5639commands (@pxref{Undo}) by using @code{undo-amalgamate-change-group}.
5640
5632@defun undo-amalgamate-change-group 5641@defun undo-amalgamate-change-group
5633Amalgamate changes in change-group since @var{handle}. I.e., remove 5642Amalgamate all the changes made in the change-group since the state
5634all undo boundaries between the state of @var{handle} and now. 5643identified by @var{handle}. This function removes all undo boundaries
5644between undo records of changes since the state described by
5645@var{handle}. Usually, @var{handle} is the handle returned by
5646@code{prepare-change-group}, in which case all the changes since the
5647beginning of the change-group are amalgamated into a single undo unit.
5635@end defun 5648@end defun
5636 5649
5637 Your code should use @code{unwind-protect} to make sure the group is 5650 Your code should use @code{unwind-protect} to make sure the group is
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index 5eeb098cc72..8902d628875 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
4071argument. 4071argument.
4072 4072
4073With the above setting, you could link to a specific bug with 4073With the above setting, you could link to a specific bug with
4074@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[google:OrgMode]]}, 4074@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[duckduckgo:OrgMode]]},
4075show the map location of the Free Software Foundation @samp{[[gmap:51 4075show the map location of the Free Software Foundation @samp{[[gmap:51
4076Franklin Street, Boston]]} or of Carsten office @samp{[[omap:Science Park 904, 4076Franklin Street, Boston]]} or of Carsten office @samp{[[omap:Science Park 904,
4077Amsterdam, The Netherlands]]} and find out what the Org author is doing 4077Amsterdam, The Netherlands]]} and find out what the Org author is doing
@@ -4082,8 +4082,8 @@ can define them in the file with
4082 4082
4083@cindex @samp{LINK}, keyword 4083@cindex @samp{LINK}, keyword
4084@example 4084@example
4085#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id= 4085#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
4086#+LINK: google http://www.google.com/search?q=%s 4086#+LINK: duckduckgo https://duckduckgo.com/?q=%s
4087@end example 4087@end example
4088 4088
4089In-buffer completion (see @ref{Completion}) can be used after @samp{[} to 4089In-buffer completion (see @ref{Completion}) can be used after @samp{[} to
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 5d89b065882..efe839574d2 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1286,6 +1286,9 @@ This method uses @command{sftp} in order to securely access remote
1286hosts. @command{sftp} is a more secure option for connecting to hosts 1286hosts. @command{sftp} is a more secure option for connecting to hosts
1287that for security reasons refuse @command{ssh} connections. 1287that for security reasons refuse @command{ssh} connections.
1288 1288
1289When there is a respective entry in your @command{ssh} configuration,
1290do @emph{not} set the @option{RemoteCommand} option.
1291
1289@end table 1292@end table
1290 1293
1291@defopt tramp-gvfs-methods 1294@defopt tramp-gvfs-methods
diff --git a/etc/NEWS b/etc/NEWS
index 6b1cdaaf005..94086426100 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -504,6 +504,12 @@ time zones will use a form like "+0100" instead of "CET".
504 504
505** Dired 505** Dired
506 506
507---
508*** Behaviour change on 'dired-clean-confirm-killing-deleted-buffers'.
509Previously, if 'dired-clean-up-buffers-too' was non-nil, and
510'dired-clean-confirm-killing-deleted-buffers' was nil, the buffers
511wouldn't be killed. This combination will now kill the buffers.
512
507+++ 513+++
508*** New user option 'dired-switches-in-mode-line'. 514*** New user option 'dired-switches-in-mode-line'.
509This user option controls how 'ls' switches are displayed in the mode 515This user option controls how 'ls' switches are displayed in the mode
@@ -1102,6 +1108,11 @@ If present in 'whitespace-style' (as it is by default), the final
1102character in the buffer will be highlighted if the buffer doesn't end 1108character in the buffer will be highlighted if the buffer doesn't end
1103with a newline. 1109with a newline.
1104 1110
1111---
1112*** The default 'whitespace-enable-predicate' predicate has changed.
1113It used to check elements in the list version of
1114'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'.
1115
1105** Texinfo 1116** Texinfo
1106 1117
1107--- 1118---
@@ -1131,6 +1142,11 @@ bindings, will be aborted, and Emacs will not ask you whether to
1131enlarge 'max-specpdl-size' to complete the rendering. The default is 1142enlarge 'max-specpdl-size' to complete the rendering. The default is
1132t, which preserves the original behavior. 1143t, which preserves the original behavior.
1133 1144
1145---
1146*** New user option 'rmail-show-message-set-modified'.
1147If set non-nil, showing an unseen message will set the Rmail buffer's
1148modified flag.
1149
1134** Apropos 1150** Apropos
1135 1151
1136*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. 1152*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
@@ -1576,6 +1592,9 @@ This allows mode-specific alterations to how `thing-at-point' works.
1576 1592
1577** Miscellaneous 1593** Miscellaneous
1578 1594
1595+++
1596*** New command `C-x C-k Q' to force redisplay in keyboard macros.
1597
1579--- 1598---
1580*** New user option 'remember-diary-regexp'. 1599*** New user option 'remember-diary-regexp'.
1581 1600
@@ -2022,6 +2041,14 @@ hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and
2022'buffer-list-update-hook' for the temporary buffers they create. This 2041'buffer-list-update-hook' for the temporary buffers they create. This
2023avoids slowing them down when a lot of these hooks are defined. 2042avoids slowing them down when a lot of these hooks are defined.
2024 2043
2044** New face 'child-frame-border' and frame parameter 'child-frame-border-width'.
2045The face and width of child frames borders can now be determined
2046separately from those of normal frames. To minimize backward
2047incompatibility, child frames without a 'child-frame-border-width'
2048parameter will fall back to using 'internal-border-width'. However,
2049the new 'child-frame-border' face does constitute a breaking change
2050since child frames' borders no longer use the 'internal-border' face.
2051
2025--- 2052---
2026** The obsolete function 'thread-alive-p' has been removed. 2053** The obsolete function 'thread-alive-p' has been removed.
2027 2054
@@ -2137,6 +2164,8 @@ obsolete back in Emacs-23.1. The affected functions are:
2137make-obsolete, define-obsolete-function-alias, make-obsolete-variable, 2164make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
2138define-obsolete-variable-alias. 2165define-obsolete-variable-alias.
2139 2166
2167** The variable 'keyboard-type' is obsolete and not dynamically scoped any more
2168
2140 2169
2141* Lisp Changes in Emacs 28.1 2170* Lisp Changes in Emacs 28.1
2142 2171
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index 2378f6fdb4f..687379db9f0 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -1,4 +1,4 @@
1;; leim-ext.el -- extra leim configuration -*- coding:utf-8; -*- 1;; leim-ext.el -- extra leim configuration -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
4;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 4;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -39,13 +39,13 @@
39(eval-after-load "quail/Punct-b5" 39(eval-after-load "quail/Punct-b5"
40 '(quail-defrule " " ?  nil t)) 40 '(quail-defrule " " ?  nil t))
41 41
42(register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+" 42(register-input-method "ucs" "UTF-8" #'ucs-input-activate "U+"
43 "Unicode input as hex in the form Uxxxx.") 43 "Unicode input as hex in the form Uxxxx.")
44 44
45(register-input-method 45(register-input-method
46 "korean-hangul" 46 "korean-hangul"
47 "UTF-8" 47 "UTF-8"
48 'hangul-input-method-activate 48 #'hangul-input-method-activate
49 "한2" 49 "한2"
50 "Hangul 2-Bulsik Input" 50 "Hangul 2-Bulsik Input"
51 'hangul2-input-method 51 'hangul2-input-method
@@ -54,7 +54,7 @@
54(register-input-method 54(register-input-method
55 "korean-hangul3f" 55 "korean-hangul3f"
56 "UTF-8" 56 "UTF-8"
57 'hangul-input-method-activate 57 #'hangul-input-method-activate
58 "한3f" 58 "한3f"
59 "Hangul 3-Bulsik final Input" 59 "Hangul 3-Bulsik final Input"
60 'hangul3-input-method 60 'hangul3-input-method
@@ -63,7 +63,7 @@
63(register-input-method 63(register-input-method
64 "korean-hangul390" 64 "korean-hangul390"
65 "UTF-8" 65 "UTF-8"
66 'hangul-input-method-activate 66 #'hangul-input-method-activate
67 "한390" 67 "한390"
68 "Hangul 3-Bulsik 390 Input" 68 "Hangul 3-Bulsik 390 Input"
69 'hangul390-input-method 69 'hangul390-input-method
@@ -72,7 +72,7 @@
72(register-input-method 72(register-input-method
73 "korean-hangul3" 73 "korean-hangul3"
74 "UTF-8" 74 "UTF-8"
75 'hangul-input-method-activate 75 #'hangul-input-method-activate
76 "한390" 76 "한390"
77 "Hangul 3-Bulsik 390 Input" 77 "Hangul 3-Bulsik 390 Input"
78 'hangul390-input-method 78 'hangul390-input-method
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index ad3b690dfa6..2494040457b 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -588,7 +588,7 @@ Here's an example:
588\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\") 588\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
589 (A . \"default A\"))) 589 (A . \"default A\")))
590 (auth-source-creation-prompts 590 (auth-source-creation-prompts
591 \\='((password . \"Enter IMAP password for %h:%p: \")))) 591 \\='((secret . \"Enter IMAP password for %h:%p: \"))))
592 (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1 592 (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
593 :P \"pppp\" :Q \"qqqq\" 593 :P \"pppp\" :Q \"qqqq\"
594 :create \\='(A B Q))) 594 :create \\='(A B Q)))
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 1b2d68939ad..57258f9c833 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -355,10 +355,9 @@ the list of old buffers.")
355(add-hook 'after-set-visited-file-name-hook 355(add-hook 'after-set-visited-file-name-hook
356 #'auto-revert-set-visited-file-name) 356 #'auto-revert-set-visited-file-name)
357 357
358(defvar auto-revert--buffers-by-watch-descriptor 358(defvar auto-revert--buffer-by-watch-descriptor nil
359 (make-hash-table :test 'equal) 359 "An association list mapping notification descriptors to buffers.
360 "A hash table mapping notification descriptors to lists of buffers. 360The buffer uses that descriptor for auto-revert notifications.
361The buffers use that descriptor for auto-revert notifications.
362The key is equal to `auto-revert-notify-watch-descriptor' in each 361The key is equal to `auto-revert-notify-watch-descriptor' in each
363buffer.") 362buffer.")
364 363
@@ -630,16 +629,12 @@ will use an up-to-date value of `auto-revert-interval'."
630 629
631(defun auto-revert-notify-rm-watch () 630(defun auto-revert-notify-rm-watch ()
632 "Disable file notification for current buffer's associated file." 631 "Disable file notification for current buffer's associated file."
633 (let ((desc auto-revert-notify-watch-descriptor) 632 (when-let ((desc auto-revert-notify-watch-descriptor))
634 (table auto-revert--buffers-by-watch-descriptor)) 633 (setq auto-revert--buffer-by-watch-descriptor
635 (when desc 634 (assoc-delete-all desc auto-revert--buffer-by-watch-descriptor))
636 (let ((buffers (delq (current-buffer) (gethash desc table)))) 635 (ignore-errors
637 (if buffers 636 (file-notify-rm-watch desc))
638 (puthash desc buffers table) 637 (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))
639 (remhash desc table)))
640 (ignore-errors
641 (file-notify-rm-watch desc))
642 (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t)))
643 (setq auto-revert-notify-watch-descriptor nil 638 (setq auto-revert-notify-watch-descriptor nil
644 auto-revert-notify-modified-p nil)) 639 auto-revert-notify-modified-p nil))
645 640
@@ -660,13 +655,10 @@ will use an up-to-date value of `auto-revert-interval'."
660 (if buffer-file-name '(change attribute-change) '(change)) 655 (if buffer-file-name '(change attribute-change) '(change))
661 'auto-revert-notify-handler)))) 656 'auto-revert-notify-handler))))
662 (when auto-revert-notify-watch-descriptor 657 (when auto-revert-notify-watch-descriptor
663 (setq auto-revert-notify-modified-p t) 658 (setq auto-revert-notify-modified-p t
664 (puthash 659 auto-revert--buffer-by-watch-descriptor
665 auto-revert-notify-watch-descriptor 660 (cons (cons auto-revert-notify-watch-descriptor (current-buffer))
666 (cons (current-buffer) 661 auto-revert--buffer-by-watch-descriptor))
667 (gethash auto-revert-notify-watch-descriptor
668 auto-revert--buffers-by-watch-descriptor))
669 auto-revert--buffers-by-watch-descriptor)
670 (add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t)))) 662 (add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t))))
671 663
672;; If we have file notifications, we want to update the auto-revert buffers 664;; If we have file notifications, we want to update the auto-revert buffers
@@ -696,8 +688,8 @@ system.")
696 (action (nth 1 event)) 688 (action (nth 1 event))
697 (file (nth 2 event)) 689 (file (nth 2 event))
698 (file1 (nth 3 event)) ;; Target of `renamed'. 690 (file1 (nth 3 event)) ;; Target of `renamed'.
699 (buffers (gethash descriptor 691 (buffer (alist-get descriptor auto-revert--buffer-by-watch-descriptor
700 auto-revert--buffers-by-watch-descriptor))) 692 nil nil #'equal)))
701 ;; Check, that event is meant for us. 693 ;; Check, that event is meant for us.
702 (cl-assert descriptor) 694 (cl-assert descriptor)
703 ;; Since we watch a directory, a file name must be returned. 695 ;; Since we watch a directory, a file name must be returned.
@@ -706,9 +698,9 @@ system.")
706 (when auto-revert-debug 698 (when auto-revert-debug
707 (message "auto-revert-notify-handler %S" event)) 699 (message "auto-revert-notify-handler %S" event))
708 700
709 (if (eq action 'stopped) 701 (when (buffer-live-p buffer)
710 ;; File notification has stopped. Continue with polling. 702 (if (eq action 'stopped)
711 (cl-dolist (buffer buffers) 703 ;; File notification has stopped. Continue with polling.
712 (with-current-buffer buffer 704 (with-current-buffer buffer
713 (when (or 705 (when (or
714 ;; A buffer associated with a file. 706 ;; A buffer associated with a file.
@@ -721,38 +713,35 @@ system.")
721 (auto-revert-notify-rm-watch) 713 (auto-revert-notify-rm-watch)
722 ;; Restart the timer if it wasn't running. 714 ;; Restart the timer if it wasn't running.
723 (unless auto-revert-timer 715 (unless auto-revert-timer
724 (auto-revert-set-timer))))) 716 (auto-revert-set-timer))))
725 717
726 ;; Loop over all buffers, in order to find the intended one. 718 (with-current-buffer buffer
727 (cl-dolist (buffer buffers) 719 (when (or
728 (when (buffer-live-p buffer) 720 ;; A buffer associated with a file.
729 (with-current-buffer buffer 721 (and (stringp buffer-file-name)
730 (when (or 722 (or
731 ;; A buffer associated with a file. 723 (and (memq
732 (and (stringp buffer-file-name) 724 action '(attribute-changed changed created))
733 (or 725 (string-equal
734 (and (memq 726 (file-name-nondirectory file)
735 action '(attribute-changed changed created)) 727 (file-name-nondirectory buffer-file-name)))
736 (string-equal 728 (and (eq action 'renamed)
737 (file-name-nondirectory file) 729 (string-equal
738 (file-name-nondirectory buffer-file-name))) 730 (file-name-nondirectory file1)
739 (and (eq action 'renamed) 731 (file-name-nondirectory buffer-file-name)))))
740 (string-equal 732 ;; A buffer w/o a file, like dired.
741 (file-name-nondirectory file1) 733 (and (null buffer-file-name)
742 (file-name-nondirectory buffer-file-name))))) 734 (memq action '(created renamed deleted))))
743 ;; A buffer w/o a file, like dired. 735 ;; Mark buffer modified.
744 (and (null buffer-file-name) 736 (setq auto-revert-notify-modified-p t)
745 (memq action '(created renamed deleted)))) 737
746 ;; Mark buffer modified. 738 ;; Revert the buffer now if we're not locked out.
747 (setq auto-revert-notify-modified-p t) 739 (unless auto-revert--lockout-timer
748 740 (auto-revert-handler)
749 ;; Revert the buffer now if we're not locked out. 741 (setq auto-revert--lockout-timer
750 (unless auto-revert--lockout-timer 742 (run-with-timer
751 (auto-revert-handler) 743 auto-revert--lockout-interval nil
752 (setq auto-revert--lockout-timer 744 #'auto-revert--end-lockout buffer))))))))))
753 (run-with-timer
754 auto-revert--lockout-interval nil
755 #'auto-revert--end-lockout buffer)))))))))))
756 745
757(defun auto-revert--end-lockout (buffer) 746(defun auto-revert--end-lockout (buffer)
758 "End the lockout period after a notification. 747 "End the lockout period after a notification.
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 4785fb7fba2..423d1e64126 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."
1136 (if penbl "linespoints" "lines") 1136 (if penbl "linespoints" "lines")
1137 (if penbl "points" "dots")))) 1137 (if penbl "points" "dots"))))
1138 (if (and pstyle (> pstyle 0)) 1138 (if (and pstyle (> pstyle 0))
1139 (insert " " 1139 (insert " ls "
1140 (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1") 1140 (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
1141 " " (int-to-string pstyle)) 1141 " ps " (int-to-string pstyle))
1142 (if (and lstyle (> lstyle 0)) 1142 (if (and lstyle (> lstyle 0))
1143 (insert " " (int-to-string lstyle))))))) 1143 (insert " ls " (int-to-string lstyle)))))))
1144 (calc-graph-view-commands)) 1144 (calc-graph-view-commands))
1145 1145
1146(defun calc-graph-zero-x (flag) 1146(defun calc-graph-zero-x (flag)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index c765e4be45d..ec864d54d69 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1179,7 +1179,7 @@ archive to which you want to compress, and CMD is the
1179corresponding command. 1179corresponding command.
1180 1180
1181Within CMD, %i denotes the input file(s), and %o denotes the 1181Within CMD, %i denotes the input file(s), and %o denotes the
1182output file. %i path(s) are relative, while %o is absolute.") 1182output file. %i path(s) are relative, while %o is absolute.")
1183 1183
1184;;;###autoload 1184;;;###autoload
1185(defun dired-do-compress-to () 1185(defun dired-do-compress-to ()
diff --git a/lisp/dired.el b/lisp/dired.el
index 3f119363314..fe6ac1e2591 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3532,18 +3532,21 @@ confirmation. To disable the confirmation, see
3532 (when (and (featurep 'dired-x) dired-clean-up-buffers-too) 3532 (when (and (featurep 'dired-x) dired-clean-up-buffers-too)
3533 (let ((buf (get-file-buffer fn))) 3533 (let ((buf (get-file-buffer fn)))
3534 (and buf 3534 (and buf
3535 (and dired-clean-confirm-killing-deleted-buffers 3535 (or (and dired-clean-confirm-killing-deleted-buffers
3536 (funcall #'y-or-n-p 3536 (funcall #'y-or-n-p
3537 (format "Kill buffer of %s, too? " 3537 (format "Kill buffer of %s, too? "
3538 (file-name-nondirectory fn)))) 3538 (file-name-nondirectory fn))))
3539 (not dired-clean-confirm-killing-deleted-buffers))
3539 (kill-buffer buf))) 3540 (kill-buffer buf)))
3540 (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) 3541 (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
3541 (and buf-list 3542 (and buf-list
3542 (and dired-clean-confirm-killing-deleted-buffers 3543 (or (and dired-clean-confirm-killing-deleted-buffers
3543 (y-or-n-p (format (ngettext "Kill Dired buffer of %s, too? " 3544 (y-or-n-p (format
3544 "Kill Dired buffers of %s, too? " 3545 (ngettext "Kill Dired buffer of %s, too? "
3545 (length buf-list)) 3546 "Kill Dired buffers of %s, too? "
3546 (file-name-nondirectory fn)))) 3547 (length buf-list))
3548 (file-name-nondirectory fn))))
3549 (not dired-clean-confirm-killing-deleted-buffers))
3547 (dolist (buf buf-list) 3550 (dolist (buf buf-list)
3548 (kill-buffer buf)))))) 3551 (kill-buffer buf))))))
3549 3552
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 5f432b80bc2..0d9ba57d663 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,4 +1,4 @@
1;;; bindat.el --- binary data structure packing and unpacking. 1;;; bindat.el --- binary data structure packing and unpacking. -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2002-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
4 4
@@ -198,7 +198,7 @@
198 198
199(defun bindat--unpack-u8 () 199(defun bindat--unpack-u8 ()
200 (prog1 200 (prog1
201 (aref bindat-raw bindat-idx) 201 (aref bindat-raw bindat-idx)
202 (setq bindat-idx (1+ bindat-idx)))) 202 (setq bindat-idx (1+ bindat-idx))))
203 203
204(defun bindat--unpack-u16 () 204(defun bindat--unpack-u16 ()
@@ -276,6 +276,8 @@
276 (t nil))) 276 (t nil)))
277 277
278(defun bindat--unpack-group (spec) 278(defun bindat--unpack-group (spec)
279 (with-suppressed-warnings ((lexical last))
280 (defvar last))
279 (let (struct last) 281 (let (struct last)
280 (while spec 282 (while spec
281 (let* ((item (car spec)) 283 (let* ((item (car spec))
@@ -287,11 +289,11 @@
287 data) 289 data)
288 (setq spec (cdr spec)) 290 (setq spec (cdr spec))
289 (if (and (consp field) (eq (car field) 'eval)) 291 (if (and (consp field) (eq (car field) 'eval))
290 (setq field (eval (car (cdr field))))) 292 (setq field (eval (car (cdr field)) t)))
291 (if (and type (consp type) (eq (car type) 'eval)) 293 (if (and type (consp type) (eq (car type) 'eval))
292 (setq type (eval (car (cdr type))))) 294 (setq type (eval (car (cdr type)) t)))
293 (if (and len (consp len) (eq (car len) 'eval)) 295 (if (and len (consp len) (eq (car len) 'eval))
294 (setq len (eval (car (cdr len))))) 296 (setq len (eval (car (cdr len)) t)))
295 (if (memq field '(eval fill align struct union)) 297 (if (memq field '(eval fill align struct union))
296 (setq tail 2 298 (setq tail 2
297 len type 299 len type
@@ -304,48 +306,51 @@
304 (cond 306 (cond
305 ((eq type 'eval) 307 ((eq type 'eval)
306 (if field 308 (if field
307 (setq data (eval len)) 309 (setq data (eval len t))
308 (eval len))) 310 (eval len t)))
309 ((eq type 'fill) 311 ((eq type 'fill)
310 (setq bindat-idx (+ bindat-idx len))) 312 (setq bindat-idx (+ bindat-idx len)))
311 ((eq type 'align) 313 ((eq type 'align)
312 (while (/= (% bindat-idx len) 0) 314 (while (/= (% bindat-idx len) 0)
313 (setq bindat-idx (1+ bindat-idx)))) 315 (setq bindat-idx (1+ bindat-idx))))
314 ((eq type 'struct) 316 ((eq type 'struct)
315 (setq data (bindat--unpack-group (eval len)))) 317 (setq data (bindat--unpack-group (eval len t))))
316 ((eq type 'repeat) 318 ((eq type 'repeat)
317 (let ((index 0) (count len)) 319 (let ((index 0) (count len))
318 (while (< index count) 320 (while (< index count)
319 (setq data (cons (bindat--unpack-group (nthcdr tail item)) data)) 321 (push (bindat--unpack-group (nthcdr tail item)) data)
320 (setq index (1+ index))) 322 (setq index (1+ index)))
321 (setq data (nreverse data)))) 323 (setq data (nreverse data))))
322 ((eq type 'union) 324 ((eq type 'union)
325 (with-suppressed-warnings ((lexical tag))
326 (defvar tag))
323 (let ((tag len) (cases (nthcdr tail item)) case cc) 327 (let ((tag len) (cases (nthcdr tail item)) case cc)
324 (while cases 328 (while cases
325 (setq case (car cases) 329 (setq case (car cases)
326 cases (cdr cases) 330 cases (cdr cases)
327 cc (car case)) 331 cc (car case))
328 (if (or (equal cc tag) (equal cc t) 332 (if (or (equal cc tag) (equal cc t)
329 (and (consp cc) (eval cc))) 333 (and (consp cc) (eval cc t)))
330 (setq data (bindat--unpack-group (cdr case)) 334 (setq data (bindat--unpack-group (cdr case))
331 cases nil))))) 335 cases nil)))))
332 (t 336 (t
333 (setq data (bindat--unpack-item type len vectype) 337 (setq data (bindat--unpack-item type len vectype)
334 last data))) 338 last data)))
335 (if data 339 (if data
336 (if field 340 (setq struct (if field
337 (setq struct (cons (cons field data) struct)) 341 (cons (cons field data) struct)
338 (setq struct (append data struct)))))) 342 (append data struct))))))
339 struct)) 343 struct))
340 344
341(defun bindat-unpack (spec bindat-raw &optional bindat-idx) 345(defun bindat-unpack (spec raw &optional idx)
342 "Return structured data according to SPEC for binary data in BINDAT-RAW. 346 "Return structured data according to SPEC for binary data in RAW.
343BINDAT-RAW is a unibyte string or vector. 347RAW is a unibyte string or vector.
344Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW." 348Optional third arg IDX specifies the starting offset in RAW."
345 (when (multibyte-string-p bindat-raw) 349 (when (multibyte-string-p raw)
346 (error "String is multibyte")) 350 (error "String is multibyte"))
347 (unless bindat-idx (setq bindat-idx 0)) 351 (let ((bindat-idx (or idx 0))
348 (bindat--unpack-group spec)) 352 (bindat-raw raw))
353 (bindat--unpack-group spec)))
349 354
350(defun bindat-get-field (struct &rest field) 355(defun bindat-get-field (struct &rest field)
351 "In structured data STRUCT, return value of field named FIELD. 356 "In structured data STRUCT, return value of field named FIELD.
@@ -373,6 +378,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
373 (ip . 4))) 378 (ip . 4)))
374 379
375(defun bindat--length-group (struct spec) 380(defun bindat--length-group (struct spec)
381 (with-suppressed-warnings ((lexical last))
382 (defvar last))
376 (let (last) 383 (let (last)
377 (while spec 384 (while spec
378 (let* ((item (car spec)) 385 (let* ((item (car spec))
@@ -383,32 +390,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
383 (tail 3)) 390 (tail 3))
384 (setq spec (cdr spec)) 391 (setq spec (cdr spec))
385 (if (and (consp field) (eq (car field) 'eval)) 392 (if (and (consp field) (eq (car field) 'eval))
386 (setq field (eval (car (cdr field))))) 393 (setq field (eval (car (cdr field)) t)))
387 (if (and type (consp type) (eq (car type) 'eval)) 394 (if (and type (consp type) (eq (car type) 'eval))
388 (setq type (eval (car (cdr type))))) 395 (setq type (eval (car (cdr type)) t)))
389 (if (and len (consp len) (eq (car len) 'eval)) 396 (if (and len (consp len) (eq (car len) 'eval))
390 (setq len (eval (car (cdr len))))) 397 (setq len (eval (car (cdr len)) t)))
391 (if (memq field '(eval fill align struct union)) 398 (if (memq field '(eval fill align struct union))
392 (setq tail 2 399 (setq tail 2
393 len type 400 len type
394 type field 401 type field
395 field nil)) 402 field nil))
396 (if (and (consp len) (not (eq type 'eval))) 403 (if (and (consp len) (not (eq type 'eval)))
397 (setq len (apply 'bindat-get-field struct len))) 404 (setq len (apply #'bindat-get-field struct len)))
398 (if (not len) 405 (if (not len)
399 (setq len 1)) 406 (setq len 1))
400 (while (eq type 'vec) 407 (while (eq type 'vec)
401 (let ((vlen 1)) 408 (if (consp vectype)
402 (if (consp vectype) 409 (setq len (* len (nth 1 vectype))
403 (setq len (* len (nth 1 vectype)) 410 type (nth 2 vectype))
404 type (nth 2 vectype)) 411 (setq type (or vectype 'u8)
405 (setq type (or vectype 'u8) 412 vectype nil)))
406 vectype nil))))
407 (cond 413 (cond
408 ((eq type 'eval) 414 ((eq type 'eval)
409 (if field 415 (if field
410 (setq struct (cons (cons field (eval len)) struct)) 416 (setq struct (cons (cons field (eval len t)) struct))
411 (eval len))) 417 (eval len t)))
412 ((eq type 'fill) 418 ((eq type 'fill)
413 (setq bindat-idx (+ bindat-idx len))) 419 (setq bindat-idx (+ bindat-idx len)))
414 ((eq type 'align) 420 ((eq type 'align)
@@ -416,7 +422,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
416 (setq bindat-idx (1+ bindat-idx)))) 422 (setq bindat-idx (1+ bindat-idx))))
417 ((eq type 'struct) 423 ((eq type 'struct)
418 (bindat--length-group 424 (bindat--length-group
419 (if field (bindat-get-field struct field) struct) (eval len))) 425 (if field (bindat-get-field struct field) struct) (eval len t)))
420 ((eq type 'repeat) 426 ((eq type 'repeat)
421 (let ((index 0) (count len)) 427 (let ((index 0) (count len))
422 (while (< index count) 428 (while (< index count)
@@ -425,13 +431,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
425 (nthcdr tail item)) 431 (nthcdr tail item))
426 (setq index (1+ index))))) 432 (setq index (1+ index)))))
427 ((eq type 'union) 433 ((eq type 'union)
434 (with-suppressed-warnings ((lexical tag))
435 (defvar tag))
428 (let ((tag len) (cases (nthcdr tail item)) case cc) 436 (let ((tag len) (cases (nthcdr tail item)) case cc)
429 (while cases 437 (while cases
430 (setq case (car cases) 438 (setq case (car cases)
431 cases (cdr cases) 439 cases (cdr cases)
432 cc (car case)) 440 cc (car case))
433 (if (or (equal cc tag) (equal cc t) 441 (if (or (equal cc tag) (equal cc t)
434 (and (consp cc) (eval cc))) 442 (and (consp cc) (eval cc t)))
435 (progn 443 (progn
436 (bindat--length-group struct (cdr case)) 444 (bindat--length-group struct (cdr case))
437 (setq cases nil)))))) 445 (setq cases nil))))))
@@ -536,6 +544,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
536 (setq bindat-idx (+ bindat-idx len))))) 544 (setq bindat-idx (+ bindat-idx len)))))
537 545
538(defun bindat--pack-group (struct spec) 546(defun bindat--pack-group (struct spec)
547 (with-suppressed-warnings ((lexical last))
548 (defvar last))
539 (let (last) 549 (let (last)
540 (while spec 550 (while spec
541 (let* ((item (car spec)) 551 (let* ((item (car spec))
@@ -546,11 +556,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
546 (tail 3)) 556 (tail 3))
547 (setq spec (cdr spec)) 557 (setq spec (cdr spec))
548 (if (and (consp field) (eq (car field) 'eval)) 558 (if (and (consp field) (eq (car field) 'eval))
549 (setq field (eval (car (cdr field))))) 559 (setq field (eval (car (cdr field)) t)))
550 (if (and type (consp type) (eq (car type) 'eval)) 560 (if (and type (consp type) (eq (car type) 'eval))
551 (setq type (eval (car (cdr type))))) 561 (setq type (eval (car (cdr type)) t)))
552 (if (and len (consp len) (eq (car len) 'eval)) 562 (if (and len (consp len) (eq (car len) 'eval))
553 (setq len (eval (car (cdr len))))) 563 (setq len (eval (car (cdr len)) t)))
554 (if (memq field '(eval fill align struct union)) 564 (if (memq field '(eval fill align struct union))
555 (setq tail 2 565 (setq tail 2
556 len type 566 len type
@@ -563,8 +573,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
563 (cond 573 (cond
564 ((eq type 'eval) 574 ((eq type 'eval)
565 (if field 575 (if field
566 (setq struct (cons (cons field (eval len)) struct)) 576 (setq struct (cons (cons field (eval len t)) struct))
567 (eval len))) 577 (eval len t)))
568 ((eq type 'fill) 578 ((eq type 'fill)
569 (setq bindat-idx (+ bindat-idx len))) 579 (setq bindat-idx (+ bindat-idx len)))
570 ((eq type 'align) 580 ((eq type 'align)
@@ -572,7 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
572 (setq bindat-idx (1+ bindat-idx)))) 582 (setq bindat-idx (1+ bindat-idx))))
573 ((eq type 'struct) 583 ((eq type 'struct)
574 (bindat--pack-group 584 (bindat--pack-group
575 (if field (bindat-get-field struct field) struct) (eval len))) 585 (if field (bindat-get-field struct field) struct) (eval len t)))
576 ((eq type 'repeat) 586 ((eq type 'repeat)
577 (let ((index 0) (count len)) 587 (let ((index 0) (count len))
578 (while (< index count) 588 (while (< index count)
@@ -581,13 +591,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
581 (nthcdr tail item)) 591 (nthcdr tail item))
582 (setq index (1+ index))))) 592 (setq index (1+ index)))))
583 ((eq type 'union) 593 ((eq type 'union)
594 (with-suppressed-warnings ((lexical tag))
595 (defvar tag))
584 (let ((tag len) (cases (nthcdr tail item)) case cc) 596 (let ((tag len) (cases (nthcdr tail item)) case cc)
585 (while cases 597 (while cases
586 (setq case (car cases) 598 (setq case (car cases)
587 cases (cdr cases) 599 cases (cdr cases)
588 cc (car case)) 600 cc (car case))
589 (if (or (equal cc tag) (equal cc t) 601 (if (or (equal cc tag) (equal cc t)
590 (and (consp cc) (eval cc))) 602 (and (consp cc) (eval cc t)))
591 (progn 603 (progn
592 (bindat--pack-group struct (cdr case)) 604 (bindat--pack-group struct (cdr case))
593 (setq cases nil)))))) 605 (setq cases nil))))))
@@ -596,19 +608,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
596 (bindat--pack-item last type len vectype) 608 (bindat--pack-item last type len vectype)
597 )))))) 609 ))))))
598 610
599(defun bindat-pack (spec struct &optional bindat-raw bindat-idx) 611(defun bindat-pack (spec struct &optional raw idx)
600 "Return binary data packed according to SPEC for structured data STRUCT. 612 "Return binary data packed according to SPEC for structured data STRUCT.
601Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to 613Optional third arg RAW is a pre-allocated unibyte string or vector to
602pack into. 614pack into.
603Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW." 615Optional fourth arg IDX is the starting offset into RAW."
604 (when (multibyte-string-p bindat-raw) 616 (when (multibyte-string-p raw)
605 (error "Pre-allocated string is multibyte")) 617 (error "Pre-allocated string is multibyte"))
606 (let ((no-return bindat-raw)) 618 (let* ((bindat-idx (or idx 0))
607 (unless bindat-idx (setq bindat-idx 0)) 619 (bindat-raw
608 (unless bindat-raw 620 (or raw
609 (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0))) 621 (make-string (+ bindat-idx (bindat-length spec struct)) 0))))
610 (bindat--pack-group struct spec) 622 (bindat--pack-group struct spec)
611 (if no-return nil bindat-raw))) 623 (if raw nil bindat-raw)))
612 624
613 625
614;; Misc. format conversions 626;; Misc. format conversions
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 76638ec13b1..9722792a5a5 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."
2362 (checkdoc-create-error 2362 (checkdoc-create-error
2363 (format "The footer should be: (provide '%s)\\n;;; %s%s ends here" 2363 (format "The footer should be: (provide '%s)\\n;;; %s%s ends here"
2364 fn fn fe) 2364 fn fn fe)
2365 (1- (point-max)) (point-max))))) 2365 ;; The buffer may be empty.
2366 (max (point-min) (1- (point-max)))
2367 (point-max)))))
2366 err)) 2368 err))
2367 ;; The below checks will not return errors if the user says NO 2369 ;; The below checks will not return errors if the user says NO
2368 2370
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index eb3193c8213..e106815817e 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,4 +1,4 @@
1;;; crm.el --- read multiple strings with completion 1;;; crm.el --- read multiple strings with completion -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 42528429aaf..54528b2fb91 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,4 +1,4 @@
1;;; derived.el --- allow inheritance of major modes 1;;; derived.el --- allow inheritance of major modes -*- lexical-binding: t; -*-
2;; (formerly mode-clone.el) 2;; (formerly mode-clone.el)
3 3
4;; Copyright (C) 1993-1994, 1999, 2001-2021 Free Software Foundation, 4;; 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 edf4d34b649..e65f424cbab 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,4 +1,4 @@
1;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) 1;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software 3;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 93f780eac2f..6db1bbbb224 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,4 +1,4 @@
1;;; generic.el --- defining simple major modes with comment and font-lock 1;;; generic.el --- defining simple major modes with comment and font-lock -*- lexical-binding: t; -*-
2;; 2;;
3;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
4;; 4;;
@@ -245,7 +245,6 @@ Some generic modes are defined in `generic-x.el'."
245 "Set up comment functionality for generic mode." 245 "Set up comment functionality for generic mode."
246 (let ((chars nil) 246 (let ((chars nil)
247 (comstyles) 247 (comstyles)
248 (comstyle "")
249 (comment-start nil)) 248 (comment-start nil))
250 249
251 ;; Go through all the comments. 250 ;; Go through all the comments.
@@ -269,14 +268,16 @@ Some generic modes are defined in `generic-x.el'."
269 ;; Store the relevant info but don't update yet. 268 ;; Store the relevant info but don't update yet.
270 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) 269 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
271 (push (cons c1 (concat (cdr (assoc c1 chars)) 270 (push (cons c1 (concat (cdr (assoc c1 chars))
272 (concat "2" comstyle))) chars))) 271 (concat "2" comstyle)))
272 chars)))
273 (if (= (length end) 1) 273 (if (= (length end) 1)
274 (modify-syntax-entry (aref end 0) 274 (modify-syntax-entry (aref end 0)
275 (concat ">" comstyle) st) 275 (concat ">" comstyle) st)
276 (let ((c0 (aref end 0)) (c1 (aref end 1))) 276 (let ((c0 (aref end 0)) (c1 (aref end 1)))
277 ;; Store the relevant info but don't update yet. 277 ;; Store the relevant info but don't update yet.
278 (push (cons c0 (concat (cdr (assoc c0 chars)) 278 (push (cons c0 (concat (cdr (assoc c0 chars))
279 (concat "3" comstyle))) chars) 279 (concat "3" comstyle)))
280 chars)
280 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) 281 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
281 282
282 ;; Process the chars that were part of a 2-char comment marker 283 ;; 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 737f3ec2f33..a5f21a55924 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,4 +1,4 @@
1;;; helper.el --- utility help package supporting help in electric modes 1;;; helper.el --- utility help package supporting help in electric modes -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -39,20 +39,19 @@
39;; keymap either. 39;; keymap either.
40 40
41 41
42(defvar Helper-help-map nil) 42(defvar Helper-help-map
43(if Helper-help-map 43 (let ((map (make-sparse-keymap)))
44 nil 44 ;(fillarray map 'undefined)
45 (setq Helper-help-map (make-keymap)) 45 (define-key map "m" 'Helper-describe-mode)
46 ;(fillarray Helper-help-map 'undefined) 46 (define-key map "b" 'Helper-describe-bindings)
47 (define-key Helper-help-map "m" 'Helper-describe-mode) 47 (define-key map "c" 'Helper-describe-key-briefly)
48 (define-key Helper-help-map "b" 'Helper-describe-bindings) 48 (define-key map "k" 'Helper-describe-key)
49 (define-key Helper-help-map "c" 'Helper-describe-key-briefly) 49 ;(define-key map "f" 'Helper-describe-function)
50 (define-key Helper-help-map "k" 'Helper-describe-key) 50 ;(define-key map "v" 'Helper-describe-variable)
51 ;(define-key Helper-help-map "f" 'Helper-describe-function) 51 (define-key map "?" 'Helper-help-options)
52 ;(define-key Helper-help-map "v" 'Helper-describe-variable) 52 (define-key map (char-to-string help-char) 'Helper-help-options)
53 (define-key Helper-help-map "?" 'Helper-help-options) 53 (fset 'Helper-help-map map)
54 (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options) 54 map))
55 (fset 'Helper-help-map Helper-help-map))
56 55
57(defun Helper-help-scroller () 56(defun Helper-help-scroller ()
58 (let ((blurb (or (and (boundp 'Helper-return-blurb) 57 (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 8780c5dcd30..3918fa01b2a 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -201,41 +201,53 @@
201 201
202(defun lisp--el-non-funcall-position-p (pos) 202(defun lisp--el-non-funcall-position-p (pos)
203 "Heuristically determine whether POS is an evaluated position." 203 "Heuristically determine whether POS is an evaluated position."
204 (declare (obsolete lisp--el-funcall-position-p "28.1"))
205 (not (lisp--el-funcall-position-p pos)))
206
207(defun lisp--el-funcall-position-p (pos)
208 "Heuristically determine whether POS is an evaluated position."
204 (save-match-data 209 (save-match-data
205 (save-excursion 210 (save-excursion
206 (ignore-errors 211 (ignore-errors
207 (goto-char pos) 212 (goto-char pos)
208 ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is. 213 ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is.
209 (or (and (eql (char-before) ?\') 214 (if (eql (char-before) ?\')
210 (not (eql (char-before (1- (point))) ?#))) 215 (eql (char-before (1- (point))) ?#)
211 (let* ((ppss (syntax-ppss)) 216 (let* ((ppss (syntax-ppss))
212 (paren-posns (nth 9 ppss)) 217 (paren-posns (nth 9 ppss))
213 (parent 218 (parent
214 (when paren-posns 219 (when paren-posns
215 (goto-char (car (last paren-posns))) ;(up-list -1) 220 (goto-char (car (last paren-posns))) ;(up-list -1)
216 (cond 221 (cond
217 ((ignore-errors 222 ((ignore-errors
218 (and (eql (char-after) ?\() 223 (and (eql (char-after) ?\()
219 (when (cdr paren-posns) 224 (when (cdr paren-posns)
220 (goto-char (car (last paren-posns 2))) 225 (goto-char (car (last paren-posns 2)))
221 (looking-at "(\\_<let\\*?\\_>")))) 226 (looking-at "(\\_<let\\*?\\_>"))))
222 (goto-char (match-end 0)) 227 (goto-char (match-end 0))
223 'let) 228 'let)
224 ((looking-at 229 ((looking-at
225 (rx "(" 230 (rx "("
226 (group-n 1 (+ (or (syntax w) (syntax _)))) 231 (group-n 1 (+ (or (syntax w) (syntax _))))
227 symbol-end)) 232 symbol-end))
228 (prog1 (intern-soft (match-string-no-properties 1)) 233 (prog1 (intern-soft (match-string-no-properties 1))
229 (goto-char (match-end 1)))))))) 234 (goto-char (match-end 1))))))))
230 (or (eq parent 'declare) 235 (pcase parent
231 (and (eq parent 'let) 236 ('declare nil)
232 (progn 237 ('let
233 (forward-sexp 1) 238 (forward-sexp 1)
234 (< pos (point)))) 239 (>= pos (point)))
235 (and (eq parent 'condition-case) 240 ('condition-case
236 (progn 241 ;; If (cdr paren-posns), then we're in the BODY
237 (forward-sexp 2) 242 ;; of HANDLERS.
238 (< (point) pos)))))))))) 243 (or (cdr paren-posns)
244 (progn
245 (forward-sexp 1)
246 ;; If we're in the second form, then we're in
247 ;; a funcall position.
248 (< (point) pos (progn (forward-sexp 1)
249 (point))))))
250 (_ t))))))))
239 251
240(defun lisp--el-match-keyword (limit) 252(defun lisp--el-match-keyword (limit)
241 ;; FIXME: Move to elisp-mode.el. 253 ;; FIXME: Move to elisp-mode.el.
@@ -245,11 +257,9 @@
245 (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>")) 257 (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
246 limit t) 258 limit t)
247 (let ((sym (intern-soft (match-string 1)))) 259 (let ((sym (intern-soft (match-string 1))))
248 (when (or (special-form-p sym) 260 (when (and (or (special-form-p sym) (macrop sym))
249 (and (macrop sym) 261 (not (get sym 'no-font-lock-keyword))
250 (not (get sym 'no-font-lock-keyword)) 262 (lisp--el-funcall-position-p (match-beginning 0)))
251 (not (lisp--el-non-funcall-position-p
252 (match-beginning 0)))))
253 (throw 'found t)))))) 263 (throw 'found t))))))
254 264
255(defmacro let-when-compile (bindings &rest body) 265(defmacro let-when-compile (bindings &rest body)
@@ -765,6 +775,7 @@ or to switch back to an existing one."
765 (setq-local find-tag-default-function 'lisp-find-tag-default) 775 (setq-local find-tag-default-function 'lisp-find-tag-default)
766 (setq-local comment-start-skip 776 (setq-local comment-start-skip
767 "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") 777 "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
778 (setq-local comment-end "|#")
768 (setq imenu-case-fold-search t)) 779 (setq imenu-case-fold-search t))
769 780
770(defun lisp-find-tag-default () 781(defun lisp-find-tag-default ()
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index aa49bccc8d0..e842222b7c3 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -241,9 +241,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
241 form)) 241 form))
242 (`(,(and fun `(lambda . ,_)) . ,args) 242 (`(,(and fun `(lambda . ,_)) . ,args)
243 ;; Embedded lambda in function position. 243 ;; Embedded lambda in function position.
244 (macroexp--cons (macroexp--all-forms fun 2) 244 ;; If the byte-optimizer is loaded, try to unfold this,
245 (macroexp--all-forms args) 245 ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
246 form)) 246 ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
247 ;; creation of a closure, thus resulting in much better code.
248 (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda))
249 'macroexp--not-unfolded
250 ;; Don't unfold if byte-opt is not yet loaded.
251 (byte-compile-unfold-lambda form))))
252 (if (or (eq newform 'macroexp--not-unfolded)
253 (eq newform form))
254 ;; Unfolding failed for some reason, avoid infinite recursion.
255 (macroexp--cons (macroexp--all-forms fun 2)
256 (macroexp--all-forms args)
257 form)
258 (macroexp--expand-all newform))))
259
247 ;; The following few cases are for normal function calls that 260 ;; The following few cases are for normal function calls that
248 ;; are known to funcall one of their arguments. The byte 261 ;; are known to funcall one of their arguments. The byte
249 ;; compiler has traditionally handled these functions specially 262 ;; compiler has traditionally handled these functions specially
@@ -257,17 +270,21 @@ Assumes the caller has bound `macroexpand-all-environment'."
257 (macroexp--warn-and-return 270 (macroexp--warn-and-return
258 (format "%s quoted with ' rather than with #'" 271 (format "%s quoted with ' rather than with #'"
259 (list 'lambda (nth 1 f) '...)) 272 (list 'lambda (nth 1 f) '...))
260 (macroexp--expand-all `(,fun ,f . ,args)))) 273 (macroexp--expand-all `(,fun #',f . ,args))))
261 ;; Second arg is a function: 274 ;; Second arg is a function:
262 (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args) 275 (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
263 (macroexp--warn-and-return 276 (macroexp--warn-and-return
264 (format "%s quoted with ' rather than with #'" 277 (format "%s quoted with ' rather than with #'"
265 (list 'lambda (nth 1 f) '...)) 278 (list 'lambda (nth 1 f) '...))
266 (macroexp--expand-all `(,fun ,arg1 ,f . ,args)))) 279 (macroexp--expand-all `(,fun ,arg1 #',f . ,args))))
267 (`(funcall #',(and f (pred symbolp)) . ,args) 280 (`(funcall ,exp . ,args)
268 ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' 281 (let ((eexp (macroexp--expand-all exp))
269 ;; has a compiler-macro. 282 (eargs (macroexp--all-forms args)))
270 (macroexp--expand-all `(,f . ,args))) 283 ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
284 ;; has a compiler-macro, or to unfold it.
285 (pcase eexp
286 (`#',f (macroexp--expand-all `(,f . ,eargs)))
287 (_ `(funcall ,eexp . ,eargs)))))
271 (`(,func . ,_) 288 (`(,func . ,_)
272 ;; Macro expand compiler macros. This cannot be delayed to 289 ;; Macro expand compiler macros. This cannot be delayed to
273 ;; byte-optimize-form because the output of the compiler-macro can 290 ;; byte-optimize-form because the output of the compiler-macro can
@@ -360,12 +377,12 @@ Never returns an empty list."
360 (t 377 (t
361 `(cond (,test ,@(macroexp-unprogn then)) 378 `(cond (,test ,@(macroexp-unprogn then))
362 (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else))) 379 (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
363 (t ,@(nthcdr 3 else)))))) 380 ,@(let ((def (nthcdr 3 else))) (if def `((t ,@def))))))))
364 ((eq (car-safe else) 'cond) 381 ((eq (car-safe else) 'cond)
365 `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else))) 382 `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
366 ;; Invert the test if that lets us reduce the depth of the tree. 383 ;; Invert the test if that lets us reduce the depth of the tree.
367 ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then)) 384 ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
368 (t `(if ,test ,then ,@(macroexp-unprogn else))))) 385 (t `(if ,test ,then ,@(if else (macroexp-unprogn else))))))
369 386
370(defmacro macroexp-let2 (test sym exp &rest body) 387(defmacro macroexp-let2 (test sym exp &rest body)
371 "Evaluate BODY with SYM bound to an expression for EXP's value. 388 "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 8a0853ce445..b723643ffb9 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,4 +1,4 @@
1;;; package-x.el --- Package extras 1;;; package-x.el --- Package extras -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index bfd577c5d14..cf129c453ec 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -683,11 +683,6 @@ A and B can be one of:
683 ;; and catch at least the easy cases such as (bug#14773). 683 ;; and catch at least the easy cases such as (bug#14773).
684 (not (macroexp--fgrep (mapcar #'car vars) (cadr upat))))) 684 (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
685 '(:pcase--succeed . :pcase--fail)) 685 '(:pcase--succeed . :pcase--fail))
686 ;; In case UPAT is of the form (pred (not PRED))
687 ((and (eq 'pred (car upat)) (eq 'not (car-safe (cadr upat))))
688 (let* ((test (cadr (cadr upat)))
689 (res (pcase--split-pred vars `(pred ,test) pat)))
690 (cons (cdr res) (car res))))
691 ;; In case PAT is of the form (pred (not PRED)) 686 ;; In case PAT is of the form (pred (not PRED))
692 ((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat)))) 687 ((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
693 (let* ((test (cadr (cadr pat))) 688 (let* ((test (cadr (cadr pat)))
@@ -696,19 +691,34 @@ A and B can be one of:
696 ((eq x :pcase--fail) :pcase--succeed))))) 691 ((eq x :pcase--fail) :pcase--succeed)))))
697 (cons (funcall reverse (car res)) 692 (cons (funcall reverse (car res))
698 (funcall reverse (cdr res))))) 693 (funcall reverse (cdr res)))))
699 ((and (eq 'pred (car upat)) 694 ;; All the rest below presumes UPAT is of the form (pred ...).
700 (let ((otherpred 695 ((not (eq 'pred (car upat))) nil)
701 (cond ((eq 'pred (car-safe pat)) (cadr pat)) 696 ;; In case UPAT is of the form (pred (not PRED))
702 ((not (eq 'quote (car-safe pat))) nil) 697 ((eq 'not (car-safe (cadr upat)))
703 ((consp (cadr pat)) #'consp) 698 (let* ((test (cadr (cadr upat)))
704 ((stringp (cadr pat)) #'stringp) 699 (res (pcase--split-pred vars `(pred ,test) pat)))
705 ((vectorp (cadr pat)) #'vectorp) 700 (cons (cdr res) (car res))))
706 ((byte-code-function-p (cadr pat)) 701 ((let ((otherpred
707 #'byte-code-function-p)))) 702 (cond ((eq 'pred (car-safe pat)) (cadr pat))
708 (pcase--mutually-exclusive-p (cadr upat) otherpred))) 703 ((not (eq 'quote (car-safe pat))) nil)
704 ((consp (cadr pat)) #'consp)
705 ((stringp (cadr pat)) #'stringp)
706 ((vectorp (cadr pat)) #'vectorp)
707 ((byte-code-function-p (cadr pat))
708 #'byte-code-function-p))))
709 (pcase--mutually-exclusive-p (cadr upat) otherpred))
709 '(:pcase--fail . nil)) 710 '(:pcase--fail . nil))
710 ((and (eq 'pred (car upat)) 711 ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
711 (eq 'quote (car-safe pat)) 712 ;; try and preserve the info we get from that memq test.
713 ((and (eq 'pcase--flip (car-safe (cadr upat)))
714 (memq (cadr (cadr upat)) '(memq member memql))
715 (eq 'quote (car-safe (nth 2 (cadr upat))))
716 (eq 'quote (car-safe pat)))
717 (let ((set (cadr (nth 2 (cadr upat)))))
718 (if (member (cadr pat) set)
719 '(nil . :pcase--fail)
720 '(:pcase--fail . nil))))
721 ((and (eq 'quote (car-safe pat))
712 (symbolp (cadr upat)) 722 (symbolp (cadr upat))
713 (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat))) 723 (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
714 (get (cadr upat) 'side-effect-free) 724 (get (cadr upat) 'side-effect-free)
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 38b202fa101..527af1ddf24 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,4 +1,4 @@
1;;; regi.el --- REGular expression Interpreting engine 1;;; regi.el --- REGular expression Interpreting engine -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -153,7 +153,7 @@ useful information:
153 ;; set up the narrowed region 153 ;; set up the narrowed region
154 (and start 154 (and start
155 end 155 end
156 (let* ((tstart start) 156 (let* (;; (tstart start)
157 (start (min start end)) 157 (start (min start end))
158 (end (max start end))) 158 (end (max start end)))
159 (narrow-to-region 159 (narrow-to-region
@@ -206,30 +206,33 @@ useful information:
206 ;; if the line matched, package up the argument list and 206 ;; if the line matched, package up the argument list and
207 ;; funcall the FUNC 207 ;; funcall the FUNC
208 (if match-p 208 (if match-p
209 (let* ((curline (buffer-substring 209 (with-suppressed-warnings
210 (regi-pos 'bol) 210 ((lexical curframe curentry curline))
211 (regi-pos 'eol))) 211 (defvar curframe) (defvar curentry) (defvar curline)
212 (curframe current-frame) 212 (let* ((curline (buffer-substring
213 (curentry entry) 213 (regi-pos 'bol)
214 (result (eval func)) 214 (regi-pos 'eol)))
215 (step (or (cdr (assq 'step result)) 1)) 215 (curframe current-frame)
216 ) 216 (curentry entry)
217 ;; changing frame on the fly? 217 (result (eval func))
218 (if (assq 'frame result) 218 (step (or (cdr (assq 'step result)) 1))
219 (setq working-frame (cdr (assq 'frame result)))) 219 )
220 220 ;; changing frame on the fly?
221 ;; continue processing current frame? 221 (if (assq 'frame result)
222 (if (memq 'continue result) 222 (setq working-frame (cdr (assq 'frame result))))
223 (setq current-frame (cdr current-frame)) 223
224 (forward-line step) 224 ;; continue processing current frame?
225 (setq current-frame working-frame)) 225 (if (memq 'continue result)
226 226 (setq current-frame (cdr current-frame))
227 ;; abort current frame? 227 (forward-line step)
228 (if (memq 'abort result) 228 (setq current-frame working-frame))
229 (progn 229
230 (setq donep t) 230 ;; abort current frame?
231 (throw 'regi-throw-top t))) 231 (if (memq 'abort result)
232 ) ; end-let 232 (progn
233 (setq donep t)
234 (throw 'regi-throw-top t)))
235 )) ; end-let
233 236
234 ;; else if no match occurred, then process the next 237 ;; else if no match occurred, then process the next
235 ;; frame-entry on the current line 238 ;; frame-entry on the current line
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 168e5e46f37..c1d05941239 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,4 +1,4 @@
1;;; shadow.el --- locate Emacs Lisp file shadowings 1;;; shadow.el --- locate Emacs Lisp file shadowings -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -58,8 +58,7 @@
58(defcustom load-path-shadows-compare-text nil 58(defcustom load-path-shadows-compare-text nil
59 "If non-nil, then shadowing files are reported only if their text differs. 59 "If non-nil, then shadowing files are reported only if their text differs.
60This is slower, but filters out some innocuous shadowing." 60This is slower, but filters out some innocuous shadowing."
61 :type 'boolean 61 :type 'boolean)
62 :group 'lisp-shadow)
63 62
64(defun load-path-shadows-find (&optional path) 63(defun load-path-shadows-find (&optional path)
65 "Return a list of Emacs Lisp files that create shadows. 64 "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."
78 dir-case-insensitive ; `file-name-case-insensitive-p' of dir. 77 dir-case-insensitive ; `file-name-case-insensitive-p' of dir.
79 curr-files ; This dir's Emacs Lisp files. 78 curr-files ; This dir's Emacs Lisp files.
80 orig-dir ; Where the file was first seen. 79 orig-dir ; Where the file was first seen.
81 files-seen-this-dir ; Files seen so far in this dir. 80 files-seen-this-dir) ; Files seen so far in this dir.
82 file) ; The current file.
83 (dolist (pp (or path load-path)) 81 (dolist (pp (or path load-path))
84 (setq dir (directory-file-name (file-truename (or pp ".")))) 82 (setq dir (directory-file-name (file-truename (or pp "."))))
85 (if (member dir true-names) 83 (if (member dir true-names)
@@ -109,7 +107,7 @@ See the documentation for `list-load-path-shadows' for further information."
109 107
110 (dolist (file curr-files) 108 (dolist (file curr-files)
111 109
112 (if (string-match "\\.gz$" file) 110 (if (string-match "\\.gz\\'" file)
113 (setq file (substring file 0 -3))) 111 (setq file (substring file 0 -3)))
114 (setq file (substring 112 (setq file (substring
115 file 0 (if (string= (substring file -1) "c") -4 -3))) 113 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."
125 ;; XXX.elc (or vice-versa) when they are in the same directory. 123 ;; XXX.elc (or vice-versa) when they are in the same directory.
126 (setq files-seen-this-dir (cons file files-seen-this-dir)) 124 (setq files-seen-this-dir (cons file files-seen-this-dir))
127 125
128 (if (setq orig-dir (assoc file files 126 (if (setq orig-dir
129 (when dir-case-insensitive 127 (assoc file files
130 (lambda (f1 f2) (eq (compare-strings f1 nil nil f2 nil nil t) t))))) 128 (when dir-case-insensitive
129 (lambda (f1 f2)
130 (eq (compare-strings f1 nil nil
131 f2 nil nil t)
132 t)))))
131 ;; This file was seen before, we have a shadowing. 133 ;; This file was seen before, we have a shadowing.
132 ;; Report it unless the files are identical. 134 ;; Report it unless the files are identical.
133 (let ((base1 (concat (cdr orig-dir) "/" (car orig-dir))) 135 (let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))
@@ -142,7 +144,7 @@ See the documentation for `list-load-path-shadows' for further information."
142 (append shadows (list base1 base2))))) 144 (append shadows (list base1 base2)))))
143 145
144 ;; Not seen before, add it to the list of seen files. 146 ;; Not seen before, add it to the list of seen files.
145 (setq files (cons (cons file dir) files))))))) 147 (push (cons file dir) files))))))
146 ;; Return the list of shadowings. 148 ;; Return the list of shadowings.
147 shadows)) 149 shadows))
148 150
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 7de9d547ce4..fb9cd8f47df 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,4 +1,4 @@
1;;;; testcover-ses.el -- Example use of `testcover' to test "SES" 1;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2002-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
4 4
@@ -19,21 +19,14 @@
19;; You should have received a copy of the GNU General Public License 19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
21 21
22(require 'testcover) 22;;; Commentary:
23 23
24(defvar ses-initial-global-parameters) 24;; FIXME: Convert to ERT and move to `test/'?
25(defvar ses-mode-map)
26 25
27(declare-function ses-set-curcell "ses") 26;;; Code:
28(declare-function ses-update-cells "ses")
29(declare-function ses-load "ses")
30(declare-function ses-vector-delete "ses")
31(declare-function ses-create-header-string "ses")
32(declare-function ses-read-cell "ses")
33(declare-function ses-read-symbol "ses")
34(declare-function ses-command-hook "ses")
35(declare-function ses-jump "ses")
36 27
28(require 'testcover)
29(require 'ses)
37 30
38;;;Here are some macros that exercise SES. Set `pause' to t if you want the 31;;;Here are some macros that exercise SES. Set `pause' to t if you want the
39;;;macros to pause after each step. 32;;;macros to pause after each step.
@@ -652,6 +645,7 @@ spreadsheet files with invalid formatting."
652 (testcover-start "ses.el" t)) 645 (testcover-start "ses.el" t))
653 (require 'unsafep)) ;In case user has safe-functions = t! 646 (require 'unsafep)) ;In case user has safe-functions = t!
654 647
648(defvar ses--curcell-overlay)
655 649
656;;;######################################################################### 650;;;#########################################################################
657(defun ses-exercise () 651(defun ses-exercise ()
@@ -674,8 +668,8 @@ spreadsheet files with invalid formatting."
674 (ses-load)) 668 (ses-load))
675 ;;ses-vector-delete is always called from buffer-undo-list with the same 669 ;;ses-vector-delete is always called from buffer-undo-list with the same
676 ;;symbol as argument. We'll give it a different one here. 670 ;;symbol as argument. We'll give it a different one here.
677 (let ((x [1 2 3])) 671 (dlet ((tcover-ses--x [1 2 3]))
678 (ses-vector-delete 'x 0 0)) 672 (ses-vector-delete 'tcover-ses--x 0 0))
679 ;;ses-create-header-string behaves differently in a non-window environment 673 ;;ses-create-header-string behaves differently in a non-window environment
680 ;;but we always test under windows. 674 ;;but we always test under windows.
681 (let ((window-system (not window-system))) 675 (let ((window-system (not window-system)))
@@ -704,7 +698,7 @@ spreadsheet files with invalid formatting."
704 (ses-mode))))) 698 (ses-mode)))))
705 ;;Test error-handling in command hook, outside a macro. 699 ;;Test error-handling in command hook, outside a macro.
706 ;;This will ring the bell. 700 ;;This will ring the bell.
707 (let (curcell-overlay) 701 (let (ses--curcell-overlay)
708 (ses-command-hook)) 702 (ses-command-hook))
709 ;;Due to use of run-with-timer, ses-command-hook sometimes gets called 703 ;;Due to use of run-with-timer, ses-command-hook sometimes gets called
710 ;;after we switch to another buffer. 704 ;;after we switch to another buffer.
@@ -720,4 +714,4 @@ spreadsheet files with invalid formatting."
720 ;;Could do this here: (testcover-end "ses.el") 714 ;;Could do this here: (testcover-end "ses.el")
721 (message "Done")) 715 (message "Done"))
722 716
723;; testcover-ses.el ends here. 717;;; testcover-ses.el ends here.
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index f46d9c77eae..d52a6c796db 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,4 +1,4 @@
1;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate 1;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2002-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
4 4
@@ -129,15 +129,16 @@ in the parse.")
129 (put x 'safe-function t)) 129 (put x 'safe-function t))
130 130
131;;;###autoload 131;;;###autoload
132(defun unsafep (form &optional unsafep-vars) 132(defun unsafep (form &optional vars)
133 "Return nil if evaluating FORM couldn't possibly do any harm. 133 "Return nil if evaluating FORM couldn't possibly do any harm.
134Otherwise result is a reason why FORM is unsafe. 134Otherwise result is a reason why FORM is unsafe.
135UNSAFEP-VARS is a list of symbols with local bindings." 135VARS is a list of symbols with local bindings like `unsafep-vars'."
136 (catch 'unsafep 136 (catch 'unsafep
137 (if (or (eq safe-functions t) ;User turned off safety-checking 137 (if (or (eq safe-functions t) ;User turned off safety-checking
138 (atom form)) ;Atoms are never unsafe 138 (atom form)) ;Atoms are never unsafe
139 (throw 'unsafep nil)) 139 (throw 'unsafep nil))
140 (let* ((fun (car form)) 140 (let* ((unsafep-vars vars)
141 (fun (car form))
141 (reason (unsafep-function fun)) 142 (reason (unsafep-function fun))
142 arg) 143 arg)
143 (cond 144 (cond
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index 9c1d8599101..13f5c039a7f 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,4 +1,4 @@
1;;; ezimage --- Generalized Image management 1;;; ezimage.el --- Generalized Image management -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1999-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/faces.el b/lisp/faces.el
index d654b1f0e2a..90f11bbe3bb 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2683,11 +2683,20 @@ the same as `window-divider' face."
2683 2683
2684(defface internal-border 2684(defface internal-border
2685 '((t nil)) 2685 '((t nil))
2686 "Basic face for the internal border." 2686 "Basic face for the internal border.
2687For the internal border of child frames see `child-frame-border'."
2687 :version "26.1" 2688 :version "26.1"
2688 :group 'frames 2689 :group 'frames
2689 :group 'basic-faces) 2690 :group 'basic-faces)
2690 2691
2692(defface child-frame-border
2693 '((t nil))
2694 "Basic face for the internal border of child frames.
2695For the internal border of non-child frames see `internal-border'."
2696 :version "28.1"
2697 :group 'frames
2698 :group 'basic-faces)
2699
2691(defface minibuffer-prompt 2700(defface minibuffer-prompt
2692 '((((background dark)) :foreground "cyan") 2701 '((((background dark)) :foreground "cyan")
2693 ;; Don't use blue because many users of the MS-DOS port customize 2702 ;; Don't use blue because many users of the MS-DOS port customize
diff --git a/lisp/files.el b/lisp/files.el
index e9be7c7e75c..5adbb43c7fb 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4073,7 +4073,7 @@ Return the new variables list."
4073 ;; integer values for subdir, where N means 4073 ;; integer values for subdir, where N means
4074 ;; variables apply to this directory and N levels 4074 ;; variables apply to this directory and N levels
4075 ;; below it (0 == nil). 4075 ;; below it (0 == nil).
4076 (equal root default-directory)) 4076 (equal root (expand-file-name default-directory)))
4077 (setq variables (dir-locals-collect-mode-variables 4077 (setq variables (dir-locals-collect-mode-variables
4078 alist variables)))))))) 4078 alist variables))))))))
4079 (error 4079 (error
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el
index 5866b308551..bb2e97d8662 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -1,4 +1,4 @@
1;;; find-cmd.el --- Build a valid find(1) command with sexps 1;;; find-cmd.el --- Build a valid find(1) command with sexps -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2008-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
4 4
@@ -28,7 +28,7 @@
28;; (find-cmd '(prune (name ".svn" ".git" ".CVS")) 28;; (find-cmd '(prune (name ".svn" ".git" ".CVS"))
29;; '(and (or (name "*.pl" "*.pm" "*.t") 29;; '(and (or (name "*.pl" "*.pm" "*.t")
30;; (mtime "+1")) 30;; (mtime "+1"))
31;; (fstype "nfs" "ufs")))) 31;; (fstype "nfs" "ufs")))
32 32
33;; will become (un-wrapped): 33;; will become (un-wrapped):
34 34
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index 656edf2eb09..adb52d7253a 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -1,4 +1,4 @@
1;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control 1;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1990-1991, 1994, 2001-2021 Free Software Foundation, 3;; Copyright (C) 1990-1991, 1994, 2001-2021 Free Software Foundation,
4;; Inc. 4;; Inc.
@@ -64,12 +64,11 @@ With arg, enable flow control mode if arg is positive, otherwise disable."
64 (progn 64 (progn
65 ;; Turn flow control off, and stop exchanging chars. 65 ;; Turn flow control off, and stop exchanging chars.
66 (set-input-mode t nil (nth 2 (current-input-mode))) 66 (set-input-mode t nil (nth 2 (current-input-mode)))
67 (if keyboard-translate-table 67 (when keyboard-translate-table
68 (progn 68 (aset keyboard-translate-table flow-control-c-s-replacement nil)
69 (aset keyboard-translate-table flow-control-c-s-replacement nil) 69 (aset keyboard-translate-table ?\^s nil)
70 (aset keyboard-translate-table ?\^s nil) 70 (aset keyboard-translate-table flow-control-c-q-replacement nil)
71 (aset keyboard-translate-table flow-control-c-q-replacement nil) 71 (aset keyboard-translate-table ?\^q nil)))
72 (aset keyboard-translate-table ?\^q nil))))
73 ;; Turn flow control on. 72 ;; Turn flow control on.
74 ;; Tell emacs to pass C-s and C-q to OS. 73 ;; Tell emacs to pass C-s and C-q to OS.
75 (set-input-mode nil t (nth 2 (current-input-mode))) 74 (set-input-mode nil t (nth 2 (current-input-mode)))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index f3ea22a4a30..4c6e1189003 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1,4 +1,4 @@
1;;; generic-x.el --- A collection of generic modes 1;;; generic-x.el --- A collection of generic modes -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -121,14 +121,12 @@
121 "If non-nil, add a hook to enter `default-generic-mode' automatically. 121 "If non-nil, add a hook to enter `default-generic-mode' automatically.
122This is done if the first few lines of a file in fundamental mode 122This is done if the first few lines of a file in fundamental mode
123start with a hash comment character." 123start with a hash comment character."
124 :group 'generic-x
125 :type 'boolean) 124 :type 'boolean)
126 125
127(defcustom generic-lines-to-scan 3 126(defcustom generic-lines-to-scan 3
128 "Number of lines that `generic-mode-find-file-hook' looks at. 127 "Number of lines that `generic-mode-find-file-hook' looks at.
129Relevant when deciding whether to enter Default-Generic mode automatically. 128Relevant when deciding whether to enter Default-Generic mode automatically.
130This variable should be set to a small positive number." 129This variable should be set to a small positive number."
131 :group 'generic-x
132 :type 'integer) 130 :type 'integer)
133 131
134(defcustom generic-find-file-regexp "^#" 132(defcustom generic-find-file-regexp "^#"
@@ -137,7 +135,6 @@ Files in fundamental mode whose first few lines contain a match
137for this regexp, should be put into Default-Generic mode instead. 135for this regexp, should be put into Default-Generic mode instead.
138The number of lines tested for the matches is specified by the 136The number of lines tested for the matches is specified by the
139value of the variable `generic-lines-to-scan', which see." 137value of the variable `generic-lines-to-scan', which see."
140 :group 'generic-x
141 :type 'regexp) 138 :type 'regexp)
142 139
143(defcustom generic-ignore-files-regexp "[Tt][Aa][Gg][Ss]\\'" 140(defcustom generic-ignore-files-regexp "[Tt][Aa][Gg][Ss]\\'"
@@ -146,7 +143,6 @@ Files whose names match this regular expression should not be put
146into Default-Generic mode, even if they have lines which match 143into Default-Generic mode, even if they have lines which match
147the regexp in `generic-find-file-regexp'. If the value is nil, 144the regexp in `generic-find-file-regexp'. If the value is nil,
148`generic-mode-find-file-hook' does not check the file names." 145`generic-mode-find-file-hook' does not check the file names."
149 :group 'generic-x
150 :type '(choice (const :tag "Don't check file names" nil) regexp)) 146 :type '(choice (const :tag "Don't check file names" nil) regexp))
151 147
152;; This generic mode is always defined 148;; This generic mode is always defined
@@ -249,7 +245,6 @@ This hook will be installed if the variable
249Each entry in the list should be a symbol. If you set this variable 245Each entry in the list should be a symbol. If you set this variable
250directly, without using customize, you must reload generic-x to put 246directly, without using customize, you must reload generic-x to put
251your changes into effect." 247your changes into effect."
252 :group 'generic-x
253 :type (let (list) 248 :type (let (list)
254 (dolist (mode 249 (dolist (mode
255 (sort (append generic-default-modes 250 (sort (append generic-default-modes
@@ -365,7 +360,8 @@ your changes into effect."
365(define-generic-mode hosts-generic-mode 360(define-generic-mode hosts-generic-mode
366 '(?#) 361 '(?#)
367 '("localhost") 362 '("localhost")
368 '(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face)) 363 '(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face)
364 ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
369 '("[hH][oO][sS][tT][sS]\\'") 365 '("[hH][oO][sS][tT][sS]\\'")
370 nil 366 nil
371 "Generic mode for HOSTS files.")) 367 "Generic mode for HOSTS files."))
@@ -415,7 +411,8 @@ like an INI file. You can add this hook to `find-file-hook'."
415 (goto-char (point-min)) 411 (goto-char (point-min))
416 (and (looking-at "^\\s-*\\[.*\\]") 412 (and (looking-at "^\\s-*\\[.*\\]")
417 (ini-generic-mode))))) 413 (ini-generic-mode)))))
418(defalias 'generic-mode-ini-file-find-file-hook 'ini-generic-mode-find-file-hook)) 414(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
415 'ini-generic-mode-find-file-hook "28.1"))
419 416
420;;; Windows REG files 417;;; Windows REG files
421;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! 418;;; 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'."
1296 1293
1297;; here manually instead 1294;; here manually instead
1298(defun generic-rul-mode-setup-function () 1295(defun generic-rul-mode-setup-function ()
1299 (make-local-variable 'parse-sexp-ignore-comments)
1300 (make-local-variable 'comment-start)
1301 (make-local-variable 'comment-start-skip) 1296 (make-local-variable 'comment-start-skip)
1302 (make-local-variable 'comment-end)
1303 (setq imenu-generic-expression 1297 (setq imenu-generic-expression
1304 '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)) 1298 '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)))
1305 parse-sexp-ignore-comments t 1299 (setq-local parse-sexp-ignore-comments t
1306 comment-end "*/" 1300 comment-end "*/"
1307 comment-start "/*" 1301 comment-start "/*"
1308;;; comment-end "" 1302;;; comment-end ""
1309;;; comment-start "//" 1303;;; comment-start "//"
1310;;; comment-start-skip "" 1304;;; comment-start-skip ""
1311 ) 1305 )
1312 ;; (set-syntax-table rul-generic-mode-syntax-table) 1306 ;; (set-syntax-table rul-generic-mode-syntax-table)
1313 (setq-local font-lock-syntax-table rul-generic-mode-syntax-table)) 1307 (setq-local font-lock-syntax-table rul-generic-mode-syntax-table))
1314 1308
@@ -1458,7 +1452,7 @@ like an INI file. You can add this hook to `find-file-hook'."
1458 ":" 1452 ":"
1459 ;; Password, UID and GID 1453 ;; Password, UID and GID
1460 (mapconcat 1454 (mapconcat
1461 'identity 1455 #'identity
1462 (make-list 3 "\\([^:]+\\)") 1456 (make-list 3 "\\([^:]+\\)")
1463 ":") 1457 ":")
1464 ":" 1458 ":"
@@ -1490,41 +1484,104 @@ like an INI file. You can add this hook to `find-file-hook'."
1490(define-generic-mode etc-fstab-generic-mode 1484(define-generic-mode etc-fstab-generic-mode
1491 '(?#) 1485 '(?#)
1492 '("adfs" 1486 '("adfs"
1487 "ados"
1493 "affs" 1488 "affs"
1489 "anon_inodefs"
1490 "atfs"
1491 "audiofs"
1494 "autofs" 1492 "autofs"
1493 "bdev"
1494 "befs"
1495 "bfs"
1496 "binfmt_misc"
1497 "btrfs"
1498 "cd9660"
1499 "cfs"
1500 "cgroup"
1501 "cifs"
1495 "coda" 1502 "coda"
1496 "coherent" 1503 "coherent"
1504 "configfs"
1505 "cpuset"
1497 "cramfs" 1506 "cramfs"
1507 "devfs"
1498 "devpts" 1508 "devpts"
1509 "devtmpfs"
1510 "e2compr"
1499 "efs" 1511 "efs"
1500 "ext2" 1512 "ext2"
1513 "ext2fs"
1501 "ext3" 1514 "ext3"
1502 "ext4" 1515 "ext4"
1516 "fdesc"
1517 "ffs"
1518 "filecore"
1519 "fuse"
1520 "fuseblk"
1521 "fusectl"
1503 "hfs" 1522 "hfs"
1504 "hpfs" 1523 "hpfs"
1524 "hugetlbfs"
1505 "iso9660" 1525 "iso9660"
1526 "jffs"
1527 "jffs2"
1506 "jfs" 1528 "jfs"
1529 "kernfs"
1530 "lfs"
1531 "linprocfs"
1532 "mfs"
1507 "minix" 1533 "minix"
1534 "mqueue"
1508 "msdos" 1535 "msdos"
1509 "ncpfs" 1536 "ncpfs"
1510 "nfs" 1537 "nfs"
1538 "nfsd"
1539 "nilfs2"
1540 "none"
1511 "ntfs" 1541 "ntfs"
1542 "null"
1543 "nwfs"
1544 "overlay"
1545 "ovlfs"
1546 "pipefs"
1547 "portal"
1512 "proc" 1548 "proc"
1549 "procfs"
1550 "pstore"
1551 "ptyfs"
1513 "qnx4" 1552 "qnx4"
1553 "ramfs"
1514 "reiserfs" 1554 "reiserfs"
1515 "romfs" 1555 "romfs"
1556 "securityfs"
1557 "shm"
1516 "smbfs" 1558 "smbfs"
1517 "cifs" 1559 "sockfs"
1518 "usbdevfs" 1560 "squashfs"
1519 "sysv" 1561 "sshfs"
1562 "std"
1563 "subfs"
1520 "sysfs" 1564 "sysfs"
1565 "sysv"
1566 "tcfs"
1521 "tmpfs" 1567 "tmpfs"
1522 "udf" 1568 "udf"
1523 "ufs" 1569 "ufs"
1570 "umap"
1524 "umsdos" 1571 "umsdos"
1572 "union"
1573 "usbdevfs"
1574 "usbfs"
1575 "userfs"
1525 "vfat" 1576 "vfat"
1577 "vs3fs"
1578 "vxfs"
1579 "wrapfs"
1580 "wvfs"
1581 "xenfs"
1526 "xenix" 1582 "xenix"
1527 "xfs" 1583 "xfs"
1584 "zisofs"
1528 "swap" 1585 "swap"
1529 "auto" 1586 "auto"
1530 "ignore") 1587 "ignore")
@@ -1575,8 +1632,7 @@ like an INI file. You can add this hook to `find-file-hook'."
1575 (((class color) (min-colors 88)) (:background "red1")) 1632 (((class color) (min-colors 88)) (:background "red1"))
1576 (((class color)) (:background "red")) 1633 (((class color)) (:background "red"))
1577 (t (:weight bold))) 1634 (t (:weight bold)))
1578 "Font Lock mode face used to highlight TABs." 1635 "Font Lock mode face used to highlight TABs.")
1579 :group 'generic-x)
1580 1636
1581(defface show-tabs-space 1637(defface show-tabs-space
1582 '((((class grayscale) (background light)) (:background "DimGray" :weight bold)) 1638 '((((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'."
1584 (((class color) (min-colors 88)) (:background "yellow1")) 1640 (((class color) (min-colors 88)) (:background "yellow1"))
1585 (((class color)) (:background "yellow")) 1641 (((class color)) (:background "yellow"))
1586 (t (:weight bold))) 1642 (t (:weight bold)))
1587 "Font Lock mode face used to highlight spaces." 1643 "Font Lock mode face used to highlight spaces.")
1588 :group 'generic-x)
1589 1644
1590(define-generic-mode show-tabs-generic-mode 1645(define-generic-mode show-tabs-generic-mode
1591 nil ;; no comment char 1646 nil ;; no comment char
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 686623029ed..56640ea8302 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."
1789 . gnus-agent-enable-expiration) 1789 . gnus-agent-enable-expiration)
1790 (agent-predicate . gnus-agent-predicate))))))) 1790 (agent-predicate . gnus-agent-predicate)))))))
1791 1791
1792;; FIXME: This looks an awful lot like `gnus-agent-retrieve-headers'.
1793(defun gnus-agent-fetch-headers (group) 1792(defun gnus-agent-fetch-headers (group)
1794 "Fetch interesting headers into the agent. The group's overview 1793 "Fetch interesting headers into the agent. The group's overview
1795file will be updated to include the headers while a list of available 1794file will be updated to include the headers while a list of available
@@ -1811,9 +1810,10 @@ article numbers will be returned."
1811 (cdr active)))) 1810 (cdr active))))
1812 (gnus-uncompress-range (gnus-active group))) 1811 (gnus-uncompress-range (gnus-active group)))
1813 (gnus-list-of-unread-articles group))) 1812 (gnus-list-of-unread-articles group)))
1813 (gnus-decode-encoded-word-function 'identity)
1814 (gnus-decode-encoded-address-function 'identity)
1814 (file (gnus-agent-article-name ".overview" group)) 1815 (file (gnus-agent-article-name ".overview" group))
1815 (file-name-coding-system nnmail-pathname-coding-system) 1816 (file-name-coding-system nnmail-pathname-coding-system))
1816 headers fetched-headers)
1817 1817
1818 (unless fetch-all 1818 (unless fetch-all
1819 ;; Add articles with marks to the list of article headers we want to 1819 ;; Add articles with marks to the list of article headers we want to
@@ -1824,7 +1824,7 @@ article numbers will be returned."
1824 (dolist (arts (gnus-info-marks (gnus-get-info group))) 1824 (dolist (arts (gnus-info-marks (gnus-get-info group)))
1825 (unless (memq (car arts) '(seen recent killed cache)) 1825 (unless (memq (car arts) '(seen recent killed cache))
1826 (setq articles (gnus-range-add articles (cdr arts))))) 1826 (setq articles (gnus-range-add articles (cdr arts)))))
1827 (setq articles (sort (gnus-uncompress-range articles) '<))) 1827 (setq articles (sort (gnus-uncompress-sequence articles) '<)))
1828 1828
1829 ;; At this point, I have the list of articles to consider for 1829 ;; At this point, I have the list of articles to consider for
1830 ;; fetching. This is the list that I'll return to my caller. Some 1830 ;; fetching. This is the list that I'll return to my caller. Some
@@ -1867,52 +1867,38 @@ article numbers will be returned."
1867 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'" 1867 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
1868 (gnus-compress-sequence articles t))) 1868 (gnus-compress-sequence articles t)))
1869 1869
1870 ;; Parse known headers from FILE. 1870 (with-current-buffer nntp-server-buffer
1871 (if (file-exists-p file) 1871 (if articles
1872 (with-current-buffer gnus-agent-overview-buffer 1872 (progn
1873 (erase-buffer) 1873 (gnus-message 8 "Fetching headers for %s..." group)
1874 (let ((nnheader-file-coding-system 1874
1875 gnus-agent-file-coding-system)) 1875 ;; Fetch them.
1876 (nnheader-insert-nov-file file (car articles)) 1876 (gnus-make-directory (nnheader-translate-file-chars
1877 (with-current-buffer nntp-server-buffer 1877 (file-name-directory file) t))
1878 (erase-buffer) 1878
1879 (insert-buffer-substring gnus-agent-overview-buffer) 1879 (unless (eq 'nov (gnus-retrieve-headers articles group))
1880 (setq headers 1880 (nnvirtual-convert-headers))
1881 (gnus-get-newsgroup-headers-xover 1881 (gnus-agent-check-overview-buffer)
1882 articles nil (buffer-local-value 1882 ;; Move these headers to the overview buffer so that
1883 'gnus-newsgroup-dependencies 1883 ;; gnus-agent-braid-nov can merge them with the contents
1884 gnus-summary-buffer) 1884 ;; of FILE.
1885 gnus-newsgroup-name))))) 1885 (copy-to-buffer
1886 (gnus-make-directory (nnheader-translate-file-chars 1886 gnus-agent-overview-buffer (point-min) (point-max))
1887 (file-name-directory file) t))) 1887 ;; NOTE: Call g-a-brand-nov even when the file does not
1888 1888 ;; exist. As a minimum, it will validate the article
1889 ;; Fetch our new headers. 1889 ;; numbers already in the buffer.
1890 (gnus-message 8 "Fetching headers for %s..." group) 1890 (gnus-agent-braid-nov articles file)
1891 (if articles 1891 (let ((coding-system-for-write
1892 (setq fetched-headers (gnus-fetch-headers articles))) 1892 gnus-agent-file-coding-system))
1893 1893 (gnus-agent-check-overview-buffer)
1894 ;; Merge two sets of headers. 1894 (write-region (point-min) (point-max) file nil 'silent))
1895 (setq headers 1895 (gnus-agent-update-view-total-fetched-for group t)
1896 (if (and headers fetched-headers) 1896 (gnus-agent-save-alist group articles nil)
1897 (delete-dups 1897 articles)
1898 (sort (append headers (copy-sequence fetched-headers)) 1898 (ignore-errors
1899 (lambda (l r) 1899 (erase-buffer)
1900 (< (mail-header-number l) 1900 (nnheader-insert-file-contents file)))))
1901 (mail-header-number r))))) 1901 articles))
1902 (or headers fetched-headers)))
1903
1904 ;; Save the new set of headers to FILE.
1905 (let ((coding-system-for-write
1906 gnus-agent-file-coding-system))
1907 (with-current-buffer gnus-agent-overview-buffer
1908 (goto-char (point-max))
1909 (mapc #'nnheader-insert-nov fetched-headers)
1910 (sort-numeric-fields 1 (point-min) (point-max))
1911 (gnus-agent-check-overview-buffer)
1912 (write-region (point-min) (point-max) file nil 'silent))
1913 (gnus-agent-update-view-total-fetched-for group t)
1914 (gnus-agent-save-alist group articles nil)))
1915 headers))
1916 1902
1917(defsubst gnus-agent-read-article-number () 1903(defsubst gnus-agent-read-article-number ()
1918 "Read the article number at point. 1904 "Read the article number at point.
@@ -1938,6 +1924,96 @@ Return nil when a valid article number can not be read."
1938 (set-buffer nntp-server-buffer) 1924 (set-buffer nntp-server-buffer)
1939 (insert-buffer-substring gnus-agent-overview-buffer b e)))) 1925 (insert-buffer-substring gnus-agent-overview-buffer b e))))
1940 1926
1927(defun gnus-agent-braid-nov (articles file)
1928 "Merge agent overview data with given file.
1929Takes unvalidated headers for ARTICLES from
1930`gnus-agent-overview-buffer' and validated headers from the given
1931FILE and places the combined valid headers into
1932`nntp-server-buffer'. This function can be used, when file
1933doesn't exist, to valid the overview buffer."
1934 (let (start last)
1935 (set-buffer gnus-agent-overview-buffer)
1936 (goto-char (point-min))
1937 (set-buffer nntp-server-buffer)
1938 (erase-buffer)
1939 (when (file-exists-p file)
1940 (nnheader-insert-file-contents file))
1941 (goto-char (point-max))
1942 (forward-line -1)
1943
1944 (unless (or (= (point-min) (point-max))
1945 (< (setq last (read (current-buffer))) (car articles)))
1946 ;; Old and new overlap -- We do it the hard way.
1947 (when (nnheader-find-nov-line (car articles))
1948 ;; Replacing existing NOV entry
1949 (delete-region (point) (progn (forward-line 1) (point))))
1950 (gnus-agent-copy-nov-line (pop articles))
1951
1952 (ignore-errors
1953 (while articles
1954 (while (let ((art (read (current-buffer))))
1955 (cond ((< art (car articles))
1956 (forward-line 1)
1957 t)
1958 ((= art (car articles))
1959 (beginning-of-line)
1960 (delete-region
1961 (point) (progn (forward-line 1) (point)))
1962 nil)
1963 (t
1964 (beginning-of-line)
1965 nil))))
1966
1967 (gnus-agent-copy-nov-line (pop articles)))))
1968
1969 (goto-char (point-max))
1970
1971 ;; Append the remaining lines
1972 (when articles
1973 (when last
1974 (set-buffer gnus-agent-overview-buffer)
1975 (setq start (point))
1976 (set-buffer nntp-server-buffer))
1977
1978 (let ((p (point)))
1979 (insert-buffer-substring gnus-agent-overview-buffer start)
1980 (goto-char p))
1981
1982 (setq last (or last -134217728))
1983 (while (catch 'problems
1984 (let (sort art)
1985 (while (not (eobp))
1986 (setq art (gnus-agent-read-article-number))
1987 (cond ((not art)
1988 ;; Bad art num - delete this line
1989 (beginning-of-line)
1990 (delete-region (point) (progn (forward-line 1) (point))))
1991 ((< art last)
1992 ;; Art num out of order - enable sort
1993 (setq sort t)
1994 (forward-line 1))
1995 ((= art last)
1996 ;; Bad repeat of art number - delete this line
1997 (beginning-of-line)
1998 (delete-region (point) (progn (forward-line 1) (point))))
1999 (t
2000 ;; Good art num
2001 (setq last art)
2002 (forward-line 1))))
2003 (when sort
2004 ;; something is seriously wrong as we simply shouldn't see out-of-order data.
2005 ;; First, we'll fix the sort.
2006 (sort-numeric-fields 1 (point-min) (point-max))
2007
2008 ;; but now we have to consider that we may have duplicate rows...
2009 ;; so reset to beginning of file
2010 (goto-char (point-min))
2011 (setq last -134217728)
2012
2013 ;; and throw a code that restarts this scan
2014 (throw 'problems t))
2015 nil))))))
2016
1941;; Keeps the compiler from warning about the free variable in 2017;; Keeps the compiler from warning about the free variable in
1942;; gnus-agent-read-agentview. 2018;; gnus-agent-read-agentview.
1943(defvar gnus-agent-read-agentview) 2019(defvar gnus-agent-read-agentview)
@@ -2310,9 +2386,10 @@ modified) original contents, they are first saved to their own file."
2310 (gnus-orphan-score gnus-orphan-score) 2386 (gnus-orphan-score gnus-orphan-score)
2311 ;; Maybe some other gnus-summary local variables should also 2387 ;; Maybe some other gnus-summary local variables should also
2312 ;; be put here. 2388 ;; be put here.
2313 fetched-headers 2389
2314 gnus-headers 2390 gnus-headers
2315 gnus-score 2391 gnus-score
2392 articles
2316 predicate info marks 2393 predicate info marks
2317 ) 2394 )
2318 (unless (gnus-check-group group) 2395 (unless (gnus-check-group group)
@@ -2333,35 +2410,38 @@ modified) original contents, they are first saved to their own file."
2333 (setq info (gnus-get-info group))))))) 2410 (setq info (gnus-get-info group)))))))
2334 (when arts 2411 (when arts
2335 (setq marked-articles (nconc (gnus-uncompress-range arts) 2412 (setq marked-articles (nconc (gnus-uncompress-range arts)
2336 marked-articles)))))) 2413 marked-articles))
2414 ))))
2337 (setq marked-articles (sort marked-articles '<)) 2415 (setq marked-articles (sort marked-articles '<))
2338 2416
2339 (setq gnus-newsgroup-dependencies 2417 ;; Fetch any new articles from the server
2340 (or gnus-newsgroup-dependencies 2418 (setq articles (gnus-agent-fetch-headers group))
2341 (gnus-make-hashtable)))
2342 2419
2343 ;; Fetch headers for any new articles from the server. 2420 ;; Merge new articles with marked
2344 (setq fetched-headers (gnus-agent-fetch-headers group)) 2421 (setq articles (sort (append marked-articles articles) '<))
2345 2422
2346 (when fetched-headers 2423 (when articles
2424 ;; Parse them and see which articles we want to fetch.
2425 (setq gnus-newsgroup-dependencies
2426 (or gnus-newsgroup-dependencies
2427 (gnus-make-hashtable (length articles))))
2347 (setq gnus-newsgroup-headers 2428 (setq gnus-newsgroup-headers
2348 (or gnus-newsgroup-headers 2429 (or gnus-newsgroup-headers
2349 fetched-headers))) 2430 (gnus-get-newsgroup-headers-xover articles nil nil
2350 (when marked-articles 2431 group)))
2351 ;; `gnus-agent-overview-buffer' may be killed for timeout 2432 ;; `gnus-agent-overview-buffer' may be killed for
2352 ;; reason. If so, recreate it. 2433 ;; timeout reason. If so, recreate it.
2353 (gnus-agent-create-buffer) 2434 (gnus-agent-create-buffer)
2354 2435
2355 (setq predicate 2436 (setq predicate
2356 (gnus-get-predicate 2437 (gnus-get-predicate
2357 (gnus-agent-find-parameter group 'agent-predicate))) 2438 (gnus-agent-find-parameter group 'agent-predicate)))
2358
2359 ;; If the selection predicate requires scoring, score each header.
2360 2439
2440 ;; If the selection predicate requires scoring, score each header
2361 (unless (memq predicate '(gnus-agent-true gnus-agent-false)) 2441 (unless (memq predicate '(gnus-agent-true gnus-agent-false))
2362 (let ((score-param 2442 (let ((score-param
2363 (gnus-agent-find-parameter group 'agent-score-file))) 2443 (gnus-agent-find-parameter group 'agent-score-file)))
2364 ;; Translate score-param into real one. 2444 ;; Translate score-param into real one
2365 (cond 2445 (cond
2366 ((not score-param)) 2446 ((not score-param))
2367 ((eq score-param 'file) 2447 ((eq score-param 'file)
@@ -3581,9 +3661,11 @@ has been fetched."
3581(defun gnus-agent-retrieve-headers (articles group &optional fetch-old) 3661(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
3582 (save-excursion 3662 (save-excursion
3583 (gnus-agent-create-buffer) 3663 (gnus-agent-create-buffer)
3584 (let ((file (gnus-agent-article-name ".overview" group)) 3664 (let ((gnus-decode-encoded-word-function 'identity)
3585 (file-name-coding-system nnmail-pathname-coding-system) 3665 (gnus-decode-encoded-address-function 'identity)
3586 uncached-articles headers fetched-headers) 3666 (file (gnus-agent-article-name ".overview" group))
3667 uncached-articles
3668 (file-name-coding-system nnmail-pathname-coding-system))
3587 (gnus-make-directory (nnheader-translate-file-chars 3669 (gnus-make-directory (nnheader-translate-file-chars
3588 (file-name-directory file) t)) 3670 (file-name-directory file) t))
3589 3671
@@ -3594,63 +3676,122 @@ has been fetched."
3594 1) 3676 1)
3595 (car (last articles)))))) 3677 (car (last articles))))))
3596 3678
3597 ;; See if we've got cached headers for ARTICLES and put them in 3679 ;; Populate temp buffer with known headers
3598 ;; HEADERS. Articles with no cached headers go in
3599 ;; UNCACHED-ARTICLES to be fetched from the server.
3600 (when (file-exists-p file) 3680 (when (file-exists-p file)
3601 (with-current-buffer gnus-agent-overview-buffer 3681 (with-current-buffer gnus-agent-overview-buffer
3602 (erase-buffer) 3682 (erase-buffer)
3603 (let ((nnheader-file-coding-system 3683 (let ((nnheader-file-coding-system
3604 gnus-agent-file-coding-system)) 3684 gnus-agent-file-coding-system))
3605 (nnheader-insert-nov-file file (car articles)) 3685 (nnheader-insert-nov-file file (car articles)))))
3606 (with-current-buffer nntp-server-buffer 3686
3607 (erase-buffer) 3687 (if (setq uncached-articles (gnus-agent-uncached-articles articles group
3608 (insert-buffer-substring gnus-agent-overview-buffer) 3688 t))
3609 (setq headers 3689 (progn
3610 (gnus-get-newsgroup-headers-xover 3690 ;; Populate nntp-server-buffer with uncached headers
3611 articles nil (buffer-local-value 3691 (set-buffer nntp-server-buffer)
3612 'gnus-newsgroup-dependencies 3692 (erase-buffer)
3613 gnus-summary-buffer) 3693 (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
3614 gnus-newsgroup-name)))))) 3694 (gnus-retrieve-headers
3615 3695 uncached-articles group))))
3616 (setq uncached-articles 3696 (nnvirtual-convert-headers))
3617 (gnus-agent-uncached-articles articles group t)) 3697 ((eq 'nntp (car gnus-current-select-method))
3618 3698 ;; The author of gnus-get-newsgroup-headers-xover
3619 (when uncached-articles 3699 ;; reports that the XOVER command is commonly
3620 (let ((gnus-newsgroup-name group) 3700 ;; unreliable. The problem is that recently
3621 gnus-agent) ; Prevent loop. 3701 ;; posted articles may not be entered into the
3622 ;; Fetch additional headers for the uncached articles. 3702 ;; NOV database in time to respond to my XOVER
3623 (setq fetched-headers (gnus-fetch-headers uncached-articles)) 3703 ;; query.
3624 ;; Merge headers we got from the overview file with our 3704 ;;
3625 ;; newly-fetched headers. 3705 ;; I'm going to use his assumption that the NOV
3626 (when fetched-headers 3706 ;; database is updated in order of ascending
3627 (setq headers 3707 ;; article ID. Therefore, a response containing
3628 (delete-dups 3708 ;; article ID N implies that all articles from 1
3629 (sort (append headers (copy-sequence fetched-headers)) 3709 ;; to N-1 are up-to-date. Therefore, missing
3630 (lambda (l r) 3710 ;; articles in that range have expired.
3631 (< (mail-header-number l) 3711
3632 (mail-header-number r)))))) 3712 (set-buffer nntp-server-buffer)
3633 3713 (let* ((fetched-articles (list nil))
3634 ;; Add the new set of known headers to the overview file. 3714 (tail-fetched-articles fetched-articles)
3715 (min (car articles))
3716 (max (car (last articles))))
3717
3718 ;; Get the list of articles that were fetched
3719 (goto-char (point-min))
3720 (let ((pm (point-max))
3721 art)
3722 (while (< (point) pm)
3723 (when (setq art (gnus-agent-read-article-number))
3724 (gnus-agent-append-to-list tail-fetched-articles art))
3725 (forward-line 1)))
3726
3727 ;; Clip this list to the headers that will
3728 ;; actually be returned
3729 (setq fetched-articles (gnus-list-range-intersection
3730 (cdr fetched-articles)
3731 (cons min max)))
3732
3733 ;; Clip the uncached articles list to exclude
3734 ;; IDs after the last FETCHED header. The
3735 ;; excluded IDs may be fetchable using HEAD.
3736 (if (car tail-fetched-articles)
3737 (setq uncached-articles
3738 (gnus-list-range-intersection
3739 uncached-articles
3740 (cons (car uncached-articles)
3741 (car tail-fetched-articles)))))
3742
3743 ;; Create the list of articles that were
3744 ;; "successfully" fetched. Success, in this
3745 ;; case, means that the ID should not be
3746 ;; fetched again. In the case of an expired
3747 ;; article, the header will not be fetched.
3748 (setq uncached-articles
3749 (gnus-sorted-nunion fetched-articles
3750 uncached-articles))
3751 )))
3752
3753 ;; Erase the temp buffer
3754 (set-buffer gnus-agent-overview-buffer)
3755 (erase-buffer)
3756
3757 ;; Copy the nntp-server-buffer to the temp buffer
3758 (set-buffer nntp-server-buffer)
3759 (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
3760
3761 ;; Merge the temp buffer with the known headers (found on
3762 ;; disk in FILE) into the nntp-server-buffer
3763 (when uncached-articles
3764 (gnus-agent-braid-nov uncached-articles file))
3765
3766 ;; Save the new set of known headers to FILE
3767 (set-buffer nntp-server-buffer)
3635 (let ((coding-system-for-write 3768 (let ((coding-system-for-write
3636 gnus-agent-file-coding-system)) 3769 gnus-agent-file-coding-system))
3637 (with-current-buffer gnus-agent-overview-buffer 3770 (gnus-agent-check-overview-buffer)
3638 ;; We stick the new headers in at the end, then 3771 (write-region (point-min) (point-max) file nil 'silent))
3639 ;; re-sort the whole buffer with 3772
3640 ;; `sort-numeric-fields'. If this turns out to be 3773 (gnus-agent-update-view-total-fetched-for group t)
3641 ;; slow, we could consider a loop to add the headers 3774
3642 ;; in sorted order to begin with. 3775 ;; Update the group's article alist to include the newly
3643 (goto-char (point-max)) 3776 ;; fetched articles.
3644 (mapc #'nnheader-insert-nov fetched-headers) 3777 (gnus-agent-load-alist group)
3645 (sort-numeric-fields 1 (point-min) (point-max)) 3778 (gnus-agent-save-alist group uncached-articles nil)
3646 (gnus-agent-check-overview-buffer) 3779 )
3647 (write-region (point-min) (point-max) file nil 'silent) 3780
3648 (gnus-agent-update-view-total-fetched-for group t) 3781 ;; Copy the temp buffer to the nntp-server-buffer
3649 ;; Update the group's article alist to include the 3782 (set-buffer nntp-server-buffer)
3650 ;; newly fetched articles. 3783 (erase-buffer)
3651 (gnus-agent-load-alist group) 3784 (insert-buffer-substring gnus-agent-overview-buffer)))
3652 (gnus-agent-save-alist group uncached-articles nil)))))) 3785
3653 headers))) 3786 (if (and fetch-old
3787 (not (numberp fetch-old)))
3788 t ; Don't remove anything.
3789 (nnheader-nov-delete-outside-range
3790 (car articles)
3791 (car (last articles)))
3792 t)
3793
3794 'nov))
3654 3795
3655(defun gnus-agent-request-article (article group) 3796(defun gnus-agent-request-article (article group)
3656 "Retrieve ARTICLE in GROUP from the agent cache." 3797 "Retrieve ARTICLE in GROUP from the agent cache."
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index ed948a26c0b..fefd02c7bfb 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -357,13 +357,8 @@ that was fetched."
357 (let ((nntp-server-buffer (current-buffer)) 357 (let ((nntp-server-buffer (current-buffer))
358 (nnheader-callback-function 358 (nnheader-callback-function
359 (lambda (_arg) 359 (lambda (_arg)
360 (setq gnus-async-header-prefetched 360 (setq gnus-async-header-prefetched
361 (cons group unread))))) 361 (cons group unread)))))
362 ;; FIXME: If header prefetch is ever put into use, we'll
363 ;; have to handle the possibility that
364 ;; `gnus-retrieve-headers' might return a list of header
365 ;; vectors directly, rather than writing them into the
366 ;; current buffer.
367 (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) 362 (gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
368 363
369(defun gnus-async-retrieve-fetched-headers (articles group) 364(defun gnus-async-retrieve-fetched-headers (articles group)
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 9423d9f2f6b..36657e46219 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -294,47 +294,49 @@ it's not cached."
294(defun gnus-cache-retrieve-headers (articles group &optional fetch-old) 294(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
295 "Retrieve the headers for ARTICLES in GROUP." 295 "Retrieve the headers for ARTICLES in GROUP."
296 (let ((cached 296 (let ((cached
297 (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))) 297 (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
298 (gnus-newsgroup-name group)
299 (gnus-fetch-old-headers fetch-old))
300 (if (not cached) 298 (if (not cached)
301 ;; No cached articles here, so we just retrieve them 299 ;; No cached articles here, so we just retrieve them
302 ;; the normal way. 300 ;; the normal way.
303 (let ((gnus-use-cache nil)) 301 (let ((gnus-use-cache nil))
304 (gnus-retrieve-headers articles group)) 302 (gnus-retrieve-headers articles group fetch-old))
305 (let ((uncached-articles (gnus-sorted-difference articles cached)) 303 (let ((uncached-articles (gnus-sorted-difference articles cached))
306 (cache-file (gnus-cache-file-name group ".overview")) 304 (cache-file (gnus-cache-file-name group ".overview"))
307 (file-name-coding-system nnmail-pathname-coding-system) 305 type
308 headers) 306 (file-name-coding-system nnmail-pathname-coding-system))
309 ;; We first retrieve all the headers that we don't have in 307 ;; We first retrieve all the headers that we don't have in
310 ;; the cache. 308 ;; the cache.
311 (let ((gnus-use-cache nil)) 309 (let ((gnus-use-cache nil))
312 (when uncached-articles 310 (when uncached-articles
313 (setq headers (and articles 311 (setq type (and articles
314 (gnus-fetch-headers uncached-articles))))) 312 (gnus-retrieve-headers
313 uncached-articles group fetch-old)))))
315 (gnus-cache-save-buffers) 314 (gnus-cache-save-buffers)
316 ;; Then we include the cached headers. 315 ;; Then we insert the cached headers.
317 (when (file-exists-p cache-file) 316 (save-excursion
318 (setq headers 317 (cond
319 (delete-dups 318 ((not (file-exists-p cache-file))
320 (sort 319 ;; There are no cached headers.
321 (append headers 320 type)
322 (let ((coding-system-for-read 321 ((null type)
323 gnus-cache-overview-coding-system)) 322 ;; There were no uncached headers (or retrieval was
324 (with-current-buffer nntp-server-buffer 323 ;; unsuccessful), so we use the cached headers exclusively.
325 (erase-buffer) 324 (set-buffer nntp-server-buffer)
326 (insert-file-contents cache-file) 325 (erase-buffer)
327 (gnus-get-newsgroup-headers-xover 326 (let ((coding-system-for-read
328 (gnus-sorted-difference 327 gnus-cache-overview-coding-system))
329 cached uncached-articles) 328 (insert-file-contents cache-file))
330 nil (buffer-local-value 329 'nov)
331 'gnus-newsgroup-dependencies 330 ((eq type 'nov)
332 gnus-summary-buffer) 331 ;; We have both cached and uncached NOV headers, so we
333 group)))) 332 ;; braid them.
334 (lambda (l r) 333 (gnus-cache-braid-nov group cached)
335 (< (mail-header-number l) 334 type)
336 (mail-header-number r))))))) 335 (t
337 headers)))) 336 ;; We braid HEADs.
337 (gnus-cache-braid-heads group (gnus-sorted-intersection
338 cached articles))
339 type)))))))
338 340
339(defun gnus-cache-enter-article (&optional n) 341(defun gnus-cache-enter-article (&optional n)
340 "Enter the next N articles into the cache. 342 "Enter the next N articles into the cache.
@@ -527,6 +529,70 @@ Returns the list of articles removed."
527 (setq gnus-cache-active-altered t))) 529 (setq gnus-cache-active-altered t)))
528 articles))) 530 articles)))
529 531
532(defun gnus-cache-braid-nov (group cached &optional file)
533 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
534 beg end)
535 (gnus-cache-save-buffers)
536 (with-current-buffer cache-buf
537 (erase-buffer)
538 (let ((coding-system-for-read gnus-cache-overview-coding-system)
539 (file-name-coding-system nnmail-pathname-coding-system))
540 (insert-file-contents
541 (or file (gnus-cache-file-name group ".overview"))))
542 (goto-char (point-min))
543 (insert "\n")
544 (goto-char (point-min)))
545 (set-buffer nntp-server-buffer)
546 (goto-char (point-min))
547 (while cached
548 (while (and (not (eobp))
549 (< (read (current-buffer)) (car cached)))
550 (forward-line 1))
551 (beginning-of-line)
552 (set-buffer cache-buf)
553 (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
554 nil t)
555 (setq beg (point-at-bol)
556 end (progn (end-of-line) (point)))
557 (setq beg nil))
558 (set-buffer nntp-server-buffer)
559 (when beg
560 (insert-buffer-substring cache-buf beg end)
561 (insert "\n"))
562 (setq cached (cdr cached)))
563 (kill-buffer cache-buf)))
564
565(defun gnus-cache-braid-heads (group cached)
566 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
567 (with-current-buffer cache-buf
568 (erase-buffer))
569 (set-buffer nntp-server-buffer)
570 (goto-char (point-min))
571 (dolist (entry cached)
572 (while (and (not (eobp))
573 (looking-at "2.. +\\([0-9]+\\) ")
574 (< (progn (goto-char (match-beginning 1))
575 (read (current-buffer)))
576 entry))
577 (search-forward "\n.\n" nil 'move))
578 (beginning-of-line)
579 (set-buffer cache-buf)
580 (erase-buffer)
581 (let ((coding-system-for-read gnus-cache-coding-system)
582 (file-name-coding-system nnmail-pathname-coding-system))
583 (insert-file-contents (gnus-cache-file-name group entry)))
584 (goto-char (point-min))
585 (insert "220 ")
586 (princ (pop cached) (current-buffer))
587 (insert " Article retrieved.\n")
588 (search-forward "\n\n" nil 'move)
589 (delete-region (point) (point-max))
590 (forward-char -1)
591 (insert ".")
592 (set-buffer nntp-server-buffer)
593 (insert-buffer-substring cache-buf))
594 (kill-buffer cache-buf)))
595
530;;;###autoload 596;;;###autoload
531(defun gnus-jog-cache () 597(defun gnus-jog-cache ()
532 "Go through all groups and put the articles into the cache. 598 "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 00b85f546c2..f7c71f43ce8 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -30,8 +30,6 @@
30 30
31(require 'parse-time) 31(require 'parse-time)
32(require 'nnimap) 32(require 'nnimap)
33(declare-function gnus-fetch-headers "gnus-sum")
34(defvar gnus-alter-header-function)
35 33
36(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' 34(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
37(autoload 'epg-make-context "epg") 35(autoload 'epg-make-context "epg")
@@ -393,6 +391,8 @@ When FULL is t, upload everything, not just a difference from the last full."
393 (gnus-group-refresh-group group)) 391 (gnus-group-refresh-group group))
394 (gnus-error 2 "Failed to upload Gnus Cloud data to %s" group))))) 392 (gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
395 393
394(defvar gnus-alter-header-function)
395
396(defun gnus-cloud-add-timestamps (elems) 396(defun gnus-cloud-add-timestamps (elems)
397 (dolist (elem elems) 397 (dolist (elem elems)
398 (let* ((file-name (plist-get elem :file-name)) 398 (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."
407 (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) 407 (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
408 (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) 408 (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
409 (active (gnus-active group)) 409 (active (gnus-active group))
410 (gnus-newsgroup-name group) 410 headers head)
411 (headers (gnus-fetch-headers (gnus-uncompress-range active)))) 411 (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
412 (when gnus-alter-header-function 412 (with-current-buffer nntp-server-buffer
413 (mapc gnus-alter-header-function headers)) 413 (goto-char (point-min))
414 (while (setq head (nnheader-parse-head))
415 (when gnus-alter-header-function
416 (funcall gnus-alter-header-function head))
417 (push head headers))))
414 (sort (nreverse headers) 418 (sort (nreverse headers)
415 (lambda (h1 h2) 419 (lambda (h1 h2)
416 (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) 420 (> (gnus-cloud-chunk-sequence (mail-header-subject h1))
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 1e0e2071018..9811e8b440f 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."
835 keymap ,gnus-mime-button-map 835 keymap ,gnus-mime-button-map
836 face ,gnus-article-button-face 836 face ,gnus-article-button-face
837 follow-link t 837 follow-link t
838 category t
838 button t 839 button t
839 gnus-data ,data)))) 840 gnus-data ,data))))
840 841
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 5bd58b690af..b0f9ed4c6f0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5658,21 +5658,10 @@ or a straight list of headers."
5658 (setf (mail-header-subject header) subject)))))) 5658 (setf (mail-header-subject header) subject))))))
5659 5659
5660(defun gnus-fetch-headers (articles &optional limit force-new dependencies) 5660(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
5661 "Fetch headers of ARTICLES. 5661 "Fetch headers of ARTICLES."
5662This calls the `gnus-retrieve-headers' function of the current
5663group's backend server. The server can do one of two things:
5664
56651. Write the headers for ARTICLES into the
5666 `nntp-server-buffer' (the current buffer) in a parseable format, or
56672. Return the headers directly as a list of vectors.
5668
5669In the first case, `gnus-retrieve-headers' returns a symbol
5670value, either `nov' or `headers'. This value determines which
5671parsing function is used to read the headers. It is also stored
5672into the variable `gnus-headers-retrieved-by', which is consulted
5673later when possibly building full threads."
5674 (gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name) 5662 (gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
5675 (let ((res (setq gnus-headers-retrieved-by 5663 (prog1
5664 (pcase (setq gnus-headers-retrieved-by
5676 (gnus-retrieve-headers 5665 (gnus-retrieve-headers
5677 articles gnus-newsgroup-name 5666 articles gnus-newsgroup-name
5678 (or limit 5667 (or limit
@@ -5682,34 +5671,22 @@ later when possibly building full threads."
5682 (not (eq gnus-fetch-old-headers 'some)) 5671 (not (eq gnus-fetch-old-headers 'some))
5683 (not (numberp gnus-fetch-old-headers))) 5672 (not (numberp gnus-fetch-old-headers)))
5684 (> (length articles) 1)) 5673 (> (length articles) 1))
5685 gnus-fetch-old-headers)))))) 5674 gnus-fetch-old-headers))))
5686 (prog1 5675 ('nov
5687 (pcase res 5676 (gnus-get-newsgroup-headers-xover
5688 ('nov 5677 articles force-new dependencies gnus-newsgroup-name t))
5689 (gnus-get-newsgroup-headers-xover 5678 ('headers
5690 articles force-new dependencies gnus-newsgroup-name t)) 5679 (gnus-get-newsgroup-headers dependencies force-new))
5691 ;; For now, assume that any backend returning its own 5680 ((pred listp)
5692 ;; headers takes some effort to do so, so return `headers'. 5681 (let ((dependencies
5693 ((pred listp) 5682 (or dependencies
5694 (setq gnus-headers-retrieved-by 'headers) 5683 (with-current-buffer gnus-summary-buffer
5695 (let ((dependencies 5684 gnus-newsgroup-dependencies))))
5696 (or dependencies 5685 (delq nil (mapcar #'(lambda (header)
5697 (buffer-local-value 5686 (gnus-dependencies-add-header
5698 'gnus-newsgroup-dependencies gnus-summary-buffer)))) 5687 header dependencies force-new))
5699 (when (functionp gnus-alter-header-function) 5688 gnus-headers-retrieved-by)))))
5700 (mapc gnus-alter-header-function res)) 5689 (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
5701 (mapc (lambda (header)
5702 ;; The agent or the cache may have already
5703 ;; registered this header in the dependency
5704 ;; table.
5705 (unless (gethash (mail-header-id header) dependencies)
5706 (gnus-dependencies-add-header
5707 header dependencies force-new)))
5708 res)
5709 res))
5710 (_ (gnus-get-newsgroup-headers dependencies force-new)))
5711 (gnus-message 7 "Fetching headers for %s...done"
5712 gnus-newsgroup-name))))
5713 5690
5714(defun gnus-select-newsgroup (group &optional read-all select-articles) 5691(defun gnus-select-newsgroup (group &optional read-all select-articles)
5715 "Select newsgroup GROUP. 5692 "Select newsgroup GROUP.
@@ -6466,10 +6443,6 @@ The resulting hash table is returned, or nil if no Xrefs were found."
6466 (unless (gnus-ephemeral-group-p group) 6443 (unless (gnus-ephemeral-group-p group)
6467 (gnus-group-update-group group t)))))) 6444 (gnus-group-update-group group t))))))
6468 6445
6469;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and
6470;; extract the necessary bits for the direct-header-return case. Also
6471;; look at this and see how similar it is to
6472;; `nnheader-parse-naked-head'.
6473(defun gnus-get-newsgroup-headers (&optional dependencies force-new) 6446(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
6474 (let ((dependencies 6447 (let ((dependencies
6475 (or dependencies 6448 (or dependencies
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 4241f30ba9d..91ab878b22f 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,
2388such as a mark that says whether an article is stored in the cache 2388such as a mark that says whether an article is stored in the cache
2389\(which doesn't make sense in a standalone back end).") 2389\(which doesn't make sense in a standalone back end).")
2390 2390
2391(defvar gnus-headers-retrieved-by nil 2391(defvar gnus-headers-retrieved-by nil)
2392 "Holds the return value of `gnus-retrieve-headers'.
2393This is either the symbol `nov' or the symbol `headers'. This
2394value is checked during the summary creation process, when
2395building threads. A value of `nov' indicates that header
2396retrieval is relatively cheap and threading is encouraged to
2397include more old articles. A value of `headers' indicates that
2398retrieval is expensive and should be minimized.")
2399(defvar gnus-article-reply nil) 2392(defvar gnus-article-reply nil)
2400(defvar gnus-override-method nil) 2393(defvar gnus-override-method nil)
2401(defvar gnus-opened-servers nil) 2394(defvar gnus-opened-servers nil)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index ba2934351d6..1e2feda6365 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.")
101 (erase-buffer) 101 (erase-buffer)
102 (if (stringp (car articles)) 102 (if (stringp (car articles))
103 'headers 103 'headers
104 (let ((carticles (nnvirtual-partition-sequence articles)) 104 (let ((vbuf (nnheader-set-temp-buffer
105 (gnus-get-buffer-create " *virtual headers*")))
106 (carticles (nnvirtual-partition-sequence articles))
105 (sysname (system-name)) 107 (sysname (system-name))
106 cgroup headers all-headers article prefix) 108 cgroup carticle article result prefix)
107 (pcase-dolist (`(,cgroup . ,articles) carticles) 109 (while carticles
110 (setq cgroup (caar carticles))
111 (setq articles (cdar carticles))
112 (pop carticles)
108 (when (and articles 113 (when (and articles
109 (gnus-check-server 114 (gnus-check-server
110 (gnus-find-method-for-group cgroup) t) 115 (gnus-find-method-for-group cgroup) t)
@@ -114,37 +119,69 @@ It is computed from the marks of individual component groups.")
114 ;; This is probably evil if people have set 119 ;; This is probably evil if people have set
115 ;; gnus-use-cache to nil themselves, but I 120 ;; gnus-use-cache to nil themselves, but I
116 ;; have no way of finding the true value of it. 121 ;; have no way of finding the true value of it.
117 (let ((gnus-use-cache t) 122 (let ((gnus-use-cache t))
118 (gnus-newsgroup-name cgroup) 123 (setq result (gnus-retrieve-headers
119 (gnus-fetch-old-headers nil)) 124 articles cgroup nil))))
120 (setq headers (gnus-fetch-headers articles)))) 125 (set-buffer nntp-server-buffer)
121 (erase-buffer) 126 ;; If we got HEAD headers, we convert them into NOV
122 ;; Remove all header article numbers from `articles'. 127 ;; headers. This is slow, inefficient and, come to think
123 ;; If there's anything left, those are expired or 128 ;; of it, downright evil. So sue me. I couldn't be
124 ;; canceled articles, so we update the component group 129 ;; bothered to write a header parse routine that could
125 ;; below. 130 ;; parse a mixed HEAD/NOV buffer.
126 (dolist (h headers) 131 (when (eq result 'headers)
127 (setq articles (delq (mail-header-number h) articles) 132 (nnvirtual-convert-headers))
128 article (nnvirtual-reverse-map-article 133 (goto-char (point-min))
129 cgroup (mail-header-number h))) 134 (while (not (eobp))
130 ;; Update all the header numbers according to their 135 (delete-region (point)
131 ;; reverse mapping, and drop any with no such mapping. 136 (progn
132 (when article 137 (setq carticle (read nntp-server-buffer))
133 ;; Do this first, before we re-set the header's 138 (point)))
134 ;; article number. 139
135 (nnvirtual-update-xref-header 140 ;; We remove this article from the articles list, if
136 h cgroup prefix sysname) 141 ;; anything is left in the articles list after going through
137 (setf (mail-header-number h) article) 142 ;; the entire buffer, then those articles have been
138 (push h all-headers))) 143 ;; expired or canceled, so we appropriately update the
139 ;; Anything left in articles is expired or canceled. 144 ;; component group below. They should be coming up
140 ;; Could be smart and not tell it about articles already 145 ;; generally in order, so this shouldn't be slow.
141 ;; known? 146 (setq articles (delq carticle articles))
142 (when articles 147
143 (gnus-group-make-articles-read cgroup articles)))) 148 (setq article (nnvirtual-reverse-map-article cgroup carticle))
144 149 (if (null article)
145 (sort all-headers (lambda (h1 h2) 150 ;; This line has no reverse mapping, that means it
146 (< (mail-header-number h1) 151 ;; was an extra article reference returned by nntp.
147 (mail-header-number h2))))))))) 152 (progn
153 (beginning-of-line)
154 (delete-region (point) (progn (forward-line 1) (point))))
155 ;; Otherwise insert the virtual article number,
156 ;; and clean up the xrefs.
157 (princ article nntp-server-buffer)
158 (nnvirtual-update-xref-header cgroup carticle
159 prefix sysname)
160 (forward-line 1))
161 )
162
163 (set-buffer vbuf)
164 (goto-char (point-max))
165 (insert-buffer-substring nntp-server-buffer))
166 ;; Anything left in articles is expired or canceled.
167 ;; Could be smart and not tell it about articles already known?
168 (when articles
169 (gnus-group-make-articles-read cgroup articles))
170 )
171
172 ;; The headers are ready for reading, so they are inserted into
173 ;; the nntp-server-buffer, which is where Gnus expects to find
174 ;; them.
175 (prog1
176 (with-current-buffer nntp-server-buffer
177 (erase-buffer)
178 (insert-buffer-substring vbuf)
179 ;; FIX FIX FIX, we should be able to sort faster than
180 ;; this if needed, since each cgroup is sorted, we just
181 ;; need to merge
182 (sort-numeric-fields 1 (point-min) (point-max))
183 'nov)
184 (kill-buffer vbuf)))))))
148 185
149 186
150(defvoo nnvirtual-last-accessed-component-group nil) 187(defvoo nnvirtual-last-accessed-component-group nil)
@@ -335,18 +372,61 @@ It is computed from the marks of individual component groups.")
335 372
336;;; Internal functions. 373;;; Internal functions.
337 374
338(defun nnvirtual-update-xref-header (header group prefix sysname) 375(defun nnvirtual-convert-headers ()
339 "Add xref to component GROUP to HEADER. 376 "Convert HEAD headers into NOV headers."
340Also add a server PREFIX any existing xref lines." 377 (with-current-buffer nntp-server-buffer
341 (let ((bits (split-string (mail-header-xref header) 378 (let* ((dependencies (make-hash-table :test #'equal))
342 nil t "[[:blank:]]")) 379 (headers (gnus-get-newsgroup-headers dependencies)))
343 (art-no (mail-header-number header))) 380 (erase-buffer)
344 (setf (mail-header-xref header) 381 (mapc 'nnheader-insert-nov headers))))
345 (concat 382
346 (format "%s %s:%d " sysname group art-no) 383
347 (mapconcat (lambda (bit) 384(defun nnvirtual-update-xref-header (group article prefix sysname)
348 (concat prefix bit)) 385 "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
349 bits " "))))) 386 ;; Move to beginning of Xref field, creating a slot if needed.
387 (beginning-of-line)
388 (looking-at
389 "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
390 (goto-char (match-end 0))
391 (unless (search-forward "\t" (point-at-eol) 'move)
392 (insert "\t"))
393
394 ;; Remove any spaces at the beginning of the Xref field.
395 (while (eq (char-after (1- (point))) ? )
396 (forward-char -1)
397 (delete-char 1))
398
399 (insert "Xref: " sysname " " group ":")
400 (princ article (current-buffer))
401 (insert " ")
402
403 ;; If there were existing xref lines, clean them up to have the correct
404 ;; component server prefix.
405 (save-restriction
406 (narrow-to-region (point)
407 (or (search-forward "\t" (point-at-eol) t)
408 (point-at-eol)))
409 (goto-char (point-min))
410 (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
411 (replace-match "" t t))
412 (goto-char (point-min))
413 (when (re-search-forward
414 (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
415 nil t)
416 (replace-match "" t t))
417 (unless (eobp)
418 (insert " ")
419 (when (not (string= "" prefix))
420 (while (re-search-forward "[^ ]+:[0-9]+" nil t)
421 (save-excursion
422 (goto-char (match-beginning 0))
423 (insert prefix))))))
424
425 ;; Ensure a trailing \t.
426 (end-of-line)
427 (or (eq (char-after (1- (point))) ?\t)
428 (insert ?\t)))
429
350 430
351(defun nnvirtual-possibly-change-server (server) 431(defun nnvirtual-possibly-change-server (server)
352 (or (not server) 432 (or (not server)
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 4f37834a27f..f6f056a2baf 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -160,16 +160,19 @@ to track whether you're reading a specific mail."
160 (cond 160 (cond
161 ((and 161 ((and
162 result ;there is a result 162 result ;there is a result
163 (let* ((data (mapcar (lambda (record) 163 (let* ((answers (dns-get 'answers result))
164 (data (mapcar (lambda (record)
164 (dns-get 'data (cdr record))) 165 (dns-get 'data (cdr record)))
165 (dns-get 'answers result))) 166 ;; We may get junk data back (or CNAME;
167 ;; ignore).
168 (and (eq (dns-get 'type answers) 'SRV)
169 answers)))
166 (priorities (mapcar (lambda (r) 170 (priorities (mapcar (lambda (r)
167 (dns-get 'priority r)) 171 (dns-get 'priority r))
168 data)) 172 data))
169 (max-priority (if priorities 173 (max-priority (apply #'max 0 priorities))
170 (apply #'max priorities) 174 (sum 0)
171 0)) 175 top)
172 (sum 0) top)
173 ;; Attempt to find all records with the same maximal 176 ;; Attempt to find all records with the same maximal
174 ;; priority, and calculate the sum of their weights. 177 ;; priority, and calculate the sum of their weights.
175 (dolist (ent data) 178 (dolist (ent data)
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index 400421ddb23..b890bde48d1 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -1,4 +1,4 @@
1;;; isearch-x.el --- extended isearch handling commands 1;;; isearch-x.el --- extended isearch handling commands -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -67,7 +67,7 @@
67 67
68;; Exit from recursive edit safely. Set in `after-change-functions' 68;; Exit from recursive edit safely. Set in `after-change-functions'
69;; by isearch-with-keyboard-coding. 69;; by isearch-with-keyboard-coding.
70(defun isearch-exit-recursive-edit (start end length) 70(defun isearch-exit-recursive-edit (_start _end _length)
71 (interactive) 71 (interactive)
72 (throw 'exit nil)) 72 (throw 'exit nil))
73 73
@@ -102,6 +102,7 @@
102 102
103;;;###autoload 103;;;###autoload
104(defun isearch-process-search-multibyte-characters (last-char &optional count) 104(defun isearch-process-search-multibyte-characters (last-char &optional count)
105 (defvar junk-hist)
105 (if (eq this-command 'isearch-printing-char) 106 (if (eq this-command 'isearch-printing-char)
106 (let ((overriding-terminal-local-map nil) 107 (let ((overriding-terminal-local-map nil)
107 (prompt (isearch-message-prefix)) 108 (prompt (isearch-message-prefix))
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index 3f3843e23dd..ead7c8aa619 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -1,4 +1,4 @@
1;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: utf-8 -*- 1;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- lexical-binding: t; -*-
2;; This file was formerly called gm-lingo.el. 2;; This file was formerly called gm-lingo.el.
3 3
4;; Copyright (C) 1993-1998, 2000-2021 Free Software Foundation, Inc. 4;; Copyright (C) 1993-1998, 2000-2021 Free Software Foundation, Inc.
@@ -79,7 +79,7 @@
79 (point-max)))) 79 (point-max))))
80 80
81;;;###autoload 81;;;###autoload
82(defun iso-spanish (from to &optional buffer) 82(defun iso-spanish (from to &optional _buffer)
83 "Translate net conventions for Spanish to ISO 8859-1. 83 "Translate net conventions for Spanish to ISO 8859-1.
84Translate the region between FROM and TO using the table 84Translate the region between FROM and TO using the table
85`iso-spanish-trans-tab'. 85`iso-spanish-trans-tab'.
@@ -121,7 +121,7 @@ and may translate too little.")
121 "Currently active translation table for German.") 121 "Currently active translation table for German.")
122 122
123;;;###autoload 123;;;###autoload
124(defun iso-german (from to &optional buffer) 124(defun iso-german (from to &optional _buffer)
125 "Translate net conventions for German to ISO 8859-1. 125 "Translate net conventions for German to ISO 8859-1.
126Translate the region FROM and TO using the table 126Translate the region FROM and TO using the table
127`iso-german-trans-tab'. 127`iso-german-trans-tab'.
@@ -194,7 +194,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
194 "Translation table for translating ISO 8859-1 characters to TeX sequences.") 194 "Translation table for translating ISO 8859-1 characters to TeX sequences.")
195 195
196;;;###autoload 196;;;###autoload
197(defun iso-iso2tex (from to &optional buffer) 197(defun iso-iso2tex (from to &optional _buffer)
198 "Translate ISO 8859-1 characters to TeX sequences. 198 "Translate ISO 8859-1 characters to TeX sequences.
199Translate the region between FROM and TO using the table 199Translate the region between FROM and TO using the table
200`iso-iso2tex-trans-tab'. 200`iso-iso2tex-trans-tab'.
@@ -387,7 +387,7 @@ This table is not exhaustive (and due to TeX's power can never be).
387It only contains commonly used sequences.") 387It only contains commonly used sequences.")
388 388
389;;;###autoload 389;;;###autoload
390(defun iso-tex2iso (from to &optional buffer) 390(defun iso-tex2iso (from to &optional _buffer)
391 "Translate TeX sequences to ISO 8859-1 characters. 391 "Translate TeX sequences to ISO 8859-1 characters.
392Translate the region between FROM and TO using the table 392Translate the region between FROM and TO using the table
393`iso-tex2iso-trans-tab'. 393`iso-tex2iso-trans-tab'.
@@ -646,7 +646,7 @@ It only contains commonly used sequences.")
646 "Translation table for translating ISO 8859-1 characters to German TeX.") 646 "Translation table for translating ISO 8859-1 characters to German TeX.")
647 647
648;;;###autoload 648;;;###autoload
649(defun iso-gtex2iso (from to &optional buffer) 649(defun iso-gtex2iso (from to &optional _buffer)
650 "Translate German TeX sequences to ISO 8859-1 characters. 650 "Translate German TeX sequences to ISO 8859-1 characters.
651Translate the region between FROM and TO using the table 651Translate the region between FROM and TO using the table
652`iso-gtex2iso-trans-tab'. 652`iso-gtex2iso-trans-tab'.
@@ -655,7 +655,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
655 (iso-translate-conventions from to iso-gtex2iso-trans-tab)) 655 (iso-translate-conventions from to iso-gtex2iso-trans-tab))
656 656
657;;;###autoload 657;;;###autoload
658(defun iso-iso2gtex (from to &optional buffer) 658(defun iso-iso2gtex (from to &optional _buffer)
659 "Translate ISO 8859-1 characters to German TeX sequences. 659 "Translate ISO 8859-1 characters to German TeX sequences.
660Translate the region between FROM and TO using the table 660Translate the region between FROM and TO using the table
661`iso-iso2gtex-trans-tab'. 661`iso-iso2gtex-trans-tab'.
@@ -674,7 +674,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
674 "Translation table for translating ISO 8859-1 characters to Duden sequences.") 674 "Translation table for translating ISO 8859-1 characters to Duden sequences.")
675 675
676;;;###autoload 676;;;###autoload
677(defun iso-iso2duden (from to &optional buffer) 677(defun iso-iso2duden (from to &optional _buffer)
678 "Translate ISO 8859-1 characters to Duden sequences. 678 "Translate ISO 8859-1 characters to Duden sequences.
679Translate the region between FROM and TO using the table 679Translate the region between FROM and TO using the table
680`iso-iso2duden-trans-tab'. 680`iso-iso2duden-trans-tab'.
@@ -812,7 +812,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
812 ("&yuml;" "ÿ"))) 812 ("&yuml;" "ÿ")))
813 813
814;;;###autoload 814;;;###autoload
815(defun iso-iso2sgml (from to &optional buffer) 815(defun iso-iso2sgml (from to &optional _buffer)
816 "Translate ISO 8859-1 characters in the region to SGML entities. 816 "Translate ISO 8859-1 characters in the region to SGML entities.
817Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". 817Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
818Optional arg BUFFER is ignored (for use in `format-alist')." 818Optional arg BUFFER is ignored (for use in `format-alist')."
@@ -820,7 +820,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
820 (iso-translate-conventions from to iso-iso2sgml-trans-tab)) 820 (iso-translate-conventions from to iso-iso2sgml-trans-tab))
821 821
822;;;###autoload 822;;;###autoload
823(defun iso-sgml2iso (from to &optional buffer) 823(defun iso-sgml2iso (from to &optional _buffer)
824 "Translate SGML entities in the region to ISO 8859-1 characters. 824 "Translate SGML entities in the region to ISO 8859-1 characters.
825Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". 825Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
826Optional arg BUFFER is ignored (for use in `format-alist')." 826Optional arg BUFFER is ignored (for use in `format-alist')."
@@ -828,13 +828,13 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
828 (iso-translate-conventions from to iso-sgml2iso-trans-tab)) 828 (iso-translate-conventions from to iso-sgml2iso-trans-tab))
829 829
830;;;###autoload 830;;;###autoload
831(defun iso-cvt-read-only (&rest ignore) 831(defun iso-cvt-read-only (&rest _ignore)
832 "Warn that format is read-only." 832 "Warn that format is read-only."
833 (interactive) 833 (interactive)
834 (error "This format is read-only; specify another format for writing")) 834 (error "This format is read-only; specify another format for writing"))
835 835
836;;;###autoload 836;;;###autoload
837(defun iso-cvt-write-only (&rest ignore) 837(defun iso-cvt-write-only (&rest _ignore)
838 "Warn that format is write-only." 838 "Warn that format is write-only."
839 (interactive) 839 (interactive)
840 (error "This format is write-only")) 840 (error "This format is write-only"))
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index b80590491c1..3be7849df19 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -1,4 +1,4 @@
1;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp 1;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4 4
@@ -96,7 +96,7 @@
96 ("ã‚‚ã" "ç›®") 96 ("ã‚‚ã" "ç›®")
97 ("ゆã" "行"))) 97 ("ゆã" "行")))
98 98
99(defun skkdic-convert-postfix (skkbuf buf) 99(defun skkdic-convert-postfix (_skkbuf buf)
100 (byte-compile-info "Processing POSTFIX entries" t) 100 (byte-compile-info "Processing POSTFIX entries" t)
101 (goto-char (point-min)) 101 (goto-char (point-min))
102 (with-current-buffer buf 102 (with-current-buffer buf
@@ -150,7 +150,7 @@
150 150
151(defconst skkdic-prefix-list '(skkdic-prefix-list)) 151(defconst skkdic-prefix-list '(skkdic-prefix-list))
152 152
153(defun skkdic-convert-prefix (skkbuf buf) 153(defun skkdic-convert-prefix (_skkbuf buf)
154 (byte-compile-info "Processing PREFIX entries" t) 154 (byte-compile-info "Processing PREFIX entries" t)
155 (goto-char (point-min)) 155 (goto-char (point-min))
156 (with-current-buffer buf 156 (with-current-buffer buf
@@ -209,7 +209,7 @@
209 (substring str from idx) 209 (substring str from idx)
210 skkdic-word-list))) 210 skkdic-word-list)))
211 (if (or (and (consp kana2-list) 211 (if (or (and (consp kana2-list)
212 (let ((kana-len (length kana)) 212 (let (;; (kana-len (length kana))
213 kana2) 213 kana2)
214 (catch 'skkdic-tag 214 (catch 'skkdic-tag
215 (while kana2-list 215 (while kana2-list
@@ -342,7 +342,8 @@ The name of generated file is specified by the variable `ja-dic-filename'."
342 (with-current-buffer buf 342 (with-current-buffer buf
343 (erase-buffer) 343 (erase-buffer)
344 (buffer-disable-undo) 344 (buffer-disable-undo)
345 (insert ";;; ja-dic.el --- dictionary for Japanese input method\n" 345 (insert ";;; ja-dic.el --- dictionary for Japanese input method"
346 " -*- lexical-binding:t -*-\n"
346 ";;\tGenerated by the command `skkdic-convert'\n" 347 ";;\tGenerated by the command `skkdic-convert'\n"
347 ";;\tOriginal SKK dictionary file: " 348 ";;\tOriginal SKK dictionary file: "
348 (file-relative-name (expand-file-name filename) dirname) 349 (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 498fb23f707..cc636986f99 100644
--- a/lisp/international/ja-dic-utl.el
+++ b/lisp/international/ja-dic-utl.el
@@ -1,4 +1,4 @@
1;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L) 1;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L) -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 4;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index cd740acc6ac..05179a98ac2 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -1,4 +1,4 @@
1;;; kinsoku.el --- `Kinsoku' processing funcs 1;;; kinsoku.el --- `Kinsoku' processing funcs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 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 290f4fa0cf1..87f73897bf6 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -1,4 +1,4 @@
1;;; kkc.el --- Kana Kanji converter 1;;; kkc.el --- Kana Kanji converter -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 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 e2ee3fb37e3..ff7cddcb26e 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -1,4 +1,4 @@
1;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: utf-8 -*- 1;;; latexenc.el --- guess correct coding system in LaTeX files -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2005-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
4 4
@@ -109,6 +109,8 @@ Return nil if no matching input encoding can be found."
109(defvar latexenc-dont-use-tex-guess-main-file-flag nil 109(defvar latexenc-dont-use-tex-guess-main-file-flag nil
110 "Non-nil means don't use tex-guessmain-file to find the coding system.") 110 "Non-nil means don't use tex-guessmain-file to find the coding system.")
111 111
112(defvar tex-start-of-header)
113
112;;;###autoload 114;;;###autoload
113(defun latexenc-find-file-coding-system (arg-list) 115(defun latexenc-find-file-coding-system (arg-list)
114 "Determine the coding system of a LaTeX file if it uses \"inputenc.sty\". 116 "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 bda2c51ab9d..4b6ef9833e5 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -1,4 +1,4 @@
1;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: utf-8;-*- 1;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
4 4
@@ -86,8 +86,8 @@ use either \\[customize] or the function `latin1-display'."
86 :group 'latin1-display 86 :group 'latin1-display
87 :type 'boolean 87 :type 'boolean
88 :require 'latin1-disp 88 :require 'latin1-disp
89 :initialize 'custom-initialize-default 89 :initialize #'custom-initialize-default
90 :set (lambda (symbol value) 90 :set (lambda (_symbol value)
91 (if value 91 (if value
92 (apply #'latin1-display latin1-display-sets) 92 (apply #'latin1-display latin1-display-sets)
93 (latin1-display)))) 93 (latin1-display))))
@@ -186,7 +186,7 @@ character set."
186 'arabic-iso8859-6 186 'arabic-iso8859-6
187 (car (remq 'ascii (get-language-info language 187 (car (remq 'ascii (get-language-info language
188 'charset)))))) 188 'charset))))))
189 (map-charset-chars #'(lambda (range arg) 189 (map-charset-chars #'(lambda (range _arg)
190 (standard-display-default (car range) (cdr range))) 190 (standard-display-default (car range) (cdr range)))
191 charset)) 191 charset))
192 (sit-for 0)) 192 (sit-for 0))
@@ -201,11 +201,10 @@ character set: `latin-2', `hebrew' etc."
201 (char (and info (decode-char (car (remq 'ascii info)) ?\ )))) 201 (char (and info (decode-char (car (remq 'ascii info)) ?\ ))))
202 (and char (char-displayable-p char)))) 202 (and char (char-displayable-p char))))
203 203
204(defun latin1-display-setup (set &optional force) 204(defun latin1-display-setup (set &optional _force)
205 "Set up Latin-1 display for characters in the given SET. 205 "Set up Latin-1 display for characters in the given SET.
206SET must be a member of `latin1-display-sets'. Normally, check 206SET must be a member of `latin1-display-sets'. Normally, check
207whether a font for SET is available and don't set the display if it 207whether a font for SET is available and don't set the display if it is."
208is. If FORCE is non-nil, set up the display regardless."
209 (cond 208 (cond
210 ((eq set 'latin-2) 209 ((eq set 'latin-2)
211 (latin1-display-identities set) 210 (latin1-display-identities set)
@@ -735,7 +734,7 @@ is. If FORCE is non-nil, set up the display regardless."
735 (sit-for 0)) 734 (sit-for 0))
736 735
737;;;###autoload 736;;;###autoload
738(defcustom latin1-display-ucs-per-lynx nil 737(defcustom latin1-display-ucs-per-lynx nil ;FIXME: Isn't this a minor mode?
739 "Set up Latin-1/ASCII display for Unicode characters. 738 "Set up Latin-1/ASCII display for Unicode characters.
740This uses the transliterations of the Lynx browser. The display isn't 739This uses the transliterations of the Lynx browser. The display isn't
741changed if the display can render Unicode characters. 740changed if the display can render Unicode characters.
@@ -745,8 +744,8 @@ use either \\[customize] or the function `latin1-display'."
745 :group 'latin1-display 744 :group 'latin1-display
746 :type 'boolean 745 :type 'boolean
747 :require 'latin1-disp 746 :require 'latin1-disp
748 :initialize 'custom-initialize-default 747 :initialize #'custom-initialize-default
749 :set (lambda (symbol value) 748 :set (lambda (_symbol value)
750 (if value 749 (if value
751 (latin1-display-ucs-per-lynx 1) 750 (latin1-display-ucs-per-lynx 1)
752 (latin1-display-ucs-per-lynx -1)))) 751 (latin1-display-ucs-per-lynx -1))))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 347e6782590..8202c3ee27a 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.
1279Emacs loads this file at startup time.") 1279Emacs loads this file at startup time.")
1280 1280
1281(defconst leim-list-header (format-message 1281(defconst leim-list-header (format-message
1282";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*- 1282";;; %s --- list of LEIM (Library of Emacs Input Method) -*- lexical-binding:t -*-
1283;; 1283;;
1284;; This file is automatically generated. 1284;; This file is automatically generated.
1285;; 1285;;
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index d6222685251..d97d090cd08 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,4 +1,4 @@
1;;; mule-diag.el --- show diagnosis of multilingual environment (Mule) 1;;; mule-diag.el --- show diagnosis of multilingual environment (Mule) -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -86,8 +86,7 @@ but still shows the full information."
86 (indent-to 48) 86 (indent-to 48)
87 (insert "| +--CHARS\n") 87 (insert "| +--CHARS\n")
88 (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t" 88 (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
89 ("D CH FINAL-BYTE" . iso-spec))) 89 ("D CH FINAL-BYTE" . iso-spec))))
90 pos)
91 (while columns 90 (while columns
92 (if (stringp (car columns)) 91 (if (stringp (car columns))
93 (insert (car columns)) 92 (insert (car columns))
@@ -117,8 +116,8 @@ but still shows the full information."
117SORT-KEY should be `name' or `iso-spec' (default `name')." 116SORT-KEY should be `name' or `iso-spec' (default `name')."
118 (or sort-key 117 (or sort-key
119 (setq sort-key 'name)) 118 (setq sort-key 'name))
120 (let ((tail charset-list) 119 (let (;; (tail charset-list)
121 charset-info-list supplementary-list charset sort-func) 120 charset-info-list supplementary-list sort-func)
122 (dolist (charset charset-list) 121 (dolist (charset charset-list)
123 ;; Generate a list that contains all information to display. 122 ;; Generate a list that contains all information to display.
124 (let ((elt (list charset 123 (let ((elt (list charset
@@ -273,9 +272,9 @@ meanings of these arguments."
273 (setq tab-width 4) 272 (setq tab-width 4)
274 (set-buffer-multibyte t) 273 (set-buffer-multibyte t)
275 (let ((dim (charset-dimension charset)) 274 (let ((dim (charset-dimension charset))
276 (chars (charset-chars charset)) 275 ;; (chars (charset-chars charset))
277 ;; (plane (charset-iso-graphic-plane charset)) 276 ;; (plane (charset-iso-graphic-plane charset))
278 (plane 1) 277 ;; (plane 1)
279 (range (plist-get (charset-plist charset) :code-space)) 278 (range (plist-get (charset-plist charset) :code-space))
280 min max min2 max2) 279 min max min2 max2)
281 (if (> dim 2) 280 (if (> dim 2)
@@ -415,7 +414,8 @@ or provided just for backward compatibility." nil)))
415 (print-coding-system-briefly coding-system 'doc-string) 414 (print-coding-system-briefly coding-system 'doc-string)
416 (let ((type (coding-system-type coding-system)) 415 (let ((type (coding-system-type coding-system))
417 ;; Fixme: use this 416 ;; Fixme: use this
418 (extra-spec (coding-system-plist coding-system))) 417 ;; (extra-spec (coding-system-plist coding-system))
418 )
419 (princ "Type: ") 419 (princ "Type: ")
420 (princ type) 420 (princ type)
421 (cond ((eq type 'undecided) 421 (cond ((eq type 'undecided)
@@ -858,6 +858,8 @@ The IGNORED argument is ignored."
858 (with-output-to-temp-buffer "*Help*" 858 (with-output-to-temp-buffer "*Help*"
859 (describe-font-internal font-info))))) 859 (describe-font-internal font-info)))))
860 860
861(defvar mule--print-opened)
862
861(defun print-fontset-element (val) 863(defun print-fontset-element (val)
862 ;; VAL has this format: 864 ;; VAL has this format:
863 ;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...) 865 ;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
@@ -915,7 +917,7 @@ The IGNORED argument is ignored."
915 (or adstyle "*") registry))))) 917 (or adstyle "*") registry)))))
916 918
917 ;; Insert opened font names (if any). 919 ;; Insert opened font names (if any).
918 (if (and (boundp 'print-opened) (symbol-value 'print-opened)) 920 (if (bound-and-true-p mule--print-opened)
919 (dolist (opened (cdr elt)) 921 (dolist (opened (cdr elt))
920 (insert "\n\t[" opened "]"))))))) 922 (insert "\n\t[" opened "]")))))))
921 923
@@ -943,8 +945,9 @@ the current buffer."
943 " and [" (propertize "OPENED" 'face 'underline) "])") 945 " and [" (propertize "OPENED" 'face 'underline) "])")
944 (let* ((info (fontset-info fontset)) 946 (let* ((info (fontset-info fontset))
945 (default-info (char-table-extra-slot info 0)) 947 (default-info (char-table-extra-slot info 0))
948 (mule--print-opened print-opened)
946 start1 end1 start2 end2) 949 start1 end1 start2 end2)
947 (describe-vector info 'print-fontset-element) 950 (describe-vector info #'print-fontset-element)
948 (when (char-table-range info nil) 951 (when (char-table-range info nil)
949 ;; The default of FONTSET is described. 952 ;; The default of FONTSET is described.
950 (setq start1 (re-search-backward "^default")) 953 (setq start1 (re-search-backward "^default"))
@@ -956,7 +959,7 @@ the current buffer."
956 (when default-info 959 (when default-info
957 (insert "\n ---<fallback to the default fontset>---") 960 (insert "\n ---<fallback to the default fontset>---")
958 (put-text-property (line-beginning-position) (point) 'face 'highlight) 961 (put-text-property (line-beginning-position) (point) 'face 'highlight)
959 (describe-vector default-info 'print-fontset-element) 962 (describe-vector default-info #'print-fontset-element)
960 (when (char-table-range default-info nil) 963 (when (char-table-range default-info nil)
961 ;; The default of the default fontset is described. 964 ;; The default of the default fontset is described.
962 (setq end2 (re-search-backward "^default")) 965 (setq end2 (re-search-backward "^default"))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 79e446875da..e049832d58b 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -1,4 +1,4 @@
1;;; ogonek.el --- change the encoding of Polish diacritics 1;;; ogonek.el --- change the encoding of Polish diacritics -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f2ac44a8a60..0901115cffe 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1,4 +1,4 @@
1;;; quail.el --- provides simple input method for multilingual text 1;;; quail.el --- provides simple input method for multilingual text -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -1046,7 +1046,7 @@ the following annotation types are supported.
1046 (quail-install-decode-map ',decode-map)))))) 1046 (quail-install-decode-map ',decode-map))))))
1047 1047
1048;;;###autoload 1048;;;###autoload
1049(defun quail-install-map (map &optional name) 1049(defun quail-install-map (map &optional _name)
1050 "Install the Quail map MAP in the current Quail package. 1050 "Install the Quail map MAP in the current Quail package.
1051 1051
1052Optional 2nd arg NAME, if non-nil, is a name of Quail package for 1052Optional 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'."
1060 (setcar (cdr (cdr quail-current-package)) map)) 1060 (setcar (cdr (cdr quail-current-package)) map))
1061 1061
1062;;;###autoload 1062;;;###autoload
1063(defun quail-install-decode-map (decode-map &optional name) 1063(defun quail-install-decode-map (decode-map &optional _name)
1064 "Install the Quail decode map DECODE-MAP in the current Quail package. 1064 "Install the Quail decode map DECODE-MAP in the current Quail package.
1065 1065
1066Optional 2nd arg NAME, if non-nil, is a name of Quail package for 1066Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@@ -1390,7 +1390,7 @@ Return the input string."
1390 (let* ((echo-keystrokes 0) 1390 (let* ((echo-keystrokes 0)
1391 (help-char nil) 1391 (help-char nil)
1392 (overriding-terminal-local-map (quail-translation-keymap)) 1392 (overriding-terminal-local-map (quail-translation-keymap))
1393 (generated-events nil) ;FIXME: What is this? 1393 ;; (generated-events nil) ;FIXME: What is this?
1394 (input-method-function nil) 1394 (input-method-function nil)
1395 (modified-p (buffer-modified-p)) 1395 (modified-p (buffer-modified-p))
1396 last-command-event last-command this-command inhibit-record) 1396 last-command-event last-command this-command inhibit-record)
@@ -1455,7 +1455,7 @@ Return the input string."
1455 (let* ((echo-keystrokes 0) 1455 (let* ((echo-keystrokes 0)
1456 (help-char nil) 1456 (help-char nil)
1457 (overriding-terminal-local-map (quail-conversion-keymap)) 1457 (overriding-terminal-local-map (quail-conversion-keymap))
1458 (generated-events nil) ;FIXME: What is this? 1458 ;; (generated-events nil) ;FIXME: What is this?
1459 (input-method-function nil) 1459 (input-method-function nil)
1460 (modified-p (buffer-modified-p)) 1460 (modified-p (buffer-modified-p))
1461 last-command-event last-command this-command inhibit-record) 1461 last-command-event last-command this-command inhibit-record)
@@ -2452,7 +2452,7 @@ should be made by `quail-build-decode-map' (which see)."
2452 (insert-char ?- single-trans-width) 2452 (insert-char ?- single-trans-width)
2453 (forward-line 1) 2453 (forward-line 1)
2454 ;; Insert the key-tran pairs. 2454 ;; Insert the key-tran pairs.
2455 (dotimes (row rows) 2455 (dotimes (_ rows)
2456 (let ((elt (pop single-list))) 2456 (let ((elt (pop single-list)))
2457 (when elt 2457 (when elt
2458 (move-to-column col) 2458 (move-to-column col)
@@ -2625,12 +2625,14 @@ KEY BINDINGS FOR CONVERSION
2625 (run-hooks 'temp-buffer-show-hook))))) 2625 (run-hooks 'temp-buffer-show-hook)))))
2626 2626
2627(defun quail-help-insert-keymap-description (keymap &optional header) 2627(defun quail-help-insert-keymap-description (keymap &optional header)
2628 (defvar the-keymap)
2628 (let ((pos1 (point)) 2629 (let ((pos1 (point))
2630 (the-keymap keymap)
2629 pos2) 2631 pos2)
2630 (if header 2632 (if header
2631 (insert header)) 2633 (insert header))
2632 (save-excursion 2634 (save-excursion
2633 (insert (substitute-command-keys "\\{keymap}"))) 2635 (insert (substitute-command-keys "\\{the-keymap}")))
2634 ;; Skip headers "key bindings", etc. 2636 ;; Skip headers "key bindings", etc.
2635 (forward-line 3) 2637 (forward-line 3)
2636 (setq pos2 (point)) 2638 (setq pos2 (point))
@@ -3011,7 +3013,7 @@ of each directory."
3011 3013
3012 ;; At first, clean up the file. 3014 ;; At first, clean up the file.
3013 (with-current-buffer list-buf 3015 (with-current-buffer list-buf
3014 (goto-char 1) 3016 (goto-char (point-min))
3015 3017
3016 ;; Insert the correct header. 3018 ;; Insert the correct header.
3017 (if (looking-at (regexp-quote leim-list-header)) 3019 (if (looking-at (regexp-quote leim-list-header))
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 16cac07c773..55390df315f 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -1,4 +1,4 @@
1;;; robin.el --- yet another input method (smaller than quail) 1;;; robin.el --- yet another input method (smaller than quail) -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 3;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4;; National Institute of Advanced Industrial Science and Technology (AIST) 4;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 58c81bfd1f3..64d66443760 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,4 +1,4 @@
1;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*- 1;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding: utf-8-emacs; lexical-binding:t -*-
2 2
3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -83,9 +83,9 @@
83;; how to select a translation from a list of candidates. 83;; how to select a translation from a list of candidates.
84 84
85(defvar quail-cxterm-package-ext-info 85(defvar quail-cxterm-package-ext-info
86 '(("chinese-4corner" "$(0(?-F(B") 86 '(("chinese-4corner" "四角")
87 ("chinese-array30" "$(0#R#O(B") 87 ("chinese-array30" "3ï¼")
88 ("chinese-ccdospy" "$AKuF4(B" 88 ("chinese-ccdospy" "缩拼"
89 "Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312'). 89 "Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
90 90
91Pinyin is the standard Roman transliteration method for Chinese. 91Pinyin is the standard Roman transliteration method for Chinese.
@@ -94,10 +94,10 @@ method `chinese-py'.
94 94
95This input method works almost the same way as `chinese-py'. The 95This input method works almost the same way as `chinese-py'. The
96difference is that you type a single key for these Pinyin spelling. 96difference is that you type a single key for these Pinyin spelling.
97 Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B) 97 Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü)
98 keyseq: a f g h i j k l s u y v 98 keyseq: a f g h i j k l s u y v
99For example: 99For example:
100 Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B $ASq(B $AH+(B 100 Chinese: 啊 果 中 文 光 玉 全
101 Pinyin: a guo zhong wen guang yu quan 101 Pinyin: a guo zhong wen guang yu quan
102 Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6 102 Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6
103 103
@@ -106,14 +106,14 @@ For example:
106For double-width GB2312 characters corresponding to ASCII, use the 106For double-width GB2312 characters corresponding to ASCII, use the
107input method `chinese-qj'.") 107input method `chinese-qj'.")
108 108
109 ("chinese-ecdict" "$(05CKH(B" 109 ("chinese-ecdict" "英漢"
110"In this input method, you enter a Chinese (Big5) character or word 110"In this input method, you enter a Chinese (Big5) character or word
111by typing the corresponding English word. For example, if you type 111by typing the corresponding English word. For example, if you type
112\"computer\", \"$(0IZH+(B\" is input. 112\"computer\", \"電腦\" is input.
113 113
114\\<quail-translation-docstring>") 114\\<quail-translation-docstring>")
115 115
116 ("chinese-etzy" "$(06/0D(B" 116 ("chinese-etzy" "倚注"
117"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1', 117"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
118`chinese-big5-2'). 118`chinese-big5-2').
119 119
@@ -122,20 +122,20 @@ compose one Chinese character.
122 122
123In this input method, you enter a Chinese character by first typing 123In this input method, you enter a Chinese character by first typing
124keys corresponding to Zhuyin symbols (see the above table) followed by 124keys corresponding to Zhuyin symbols (see the above table) followed by
125SPC, 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, 125SPC, 1, 2, 3, or 4 specifying a tone (SPC:é™°å¹³, 1:輕è², 2:陽平, 3: 上è²,
1264:$(0(+Vy(B). 1264:去è²).
127 127
128\\<quail-translation-docstring>") 128\\<quail-translation-docstring>")
129 129
130 ("chinese-punct-b5" "$(0O:(BB" 130 ("chinese-punct-b5" "標B"
131 "Input method for Chinese punctuation and symbols of Big5 131 "Input method for Chinese punctuation and symbols of Big5
132\(`chinese-big5-1' and `chinese-big5-2').") 132\(`chinese-big5-1' and `chinese-big5-2').")
133 133
134 ("chinese-punct" "$A1j(BG" 134 ("chinese-punct" "æ ‡G"
135 "Input method for Chinese punctuation and symbols of GB2312 135 "Input method for Chinese punctuation and symbols of GB2312
136\(`chinese-gb2312').") 136\(`chinese-gb2312').")
137 137
138 ("chinese-py-b5" "$(03<(BB" 138 ("chinese-py-b5" "拼B"
139 "Pinyin base input method for Chinese Big5 characters 139 "Pinyin base input method for Chinese Big5 characters
140\(`chinese-big5-1', `chinese-big5-2'). 140\(`chinese-big5-1', `chinese-big5-2').
141 141
@@ -153,28 +153,28 @@ method `chinese-qj-b5'.
153The input method `chinese-py' and `chinese-tonepy' are also Pinyin 153The input method `chinese-py' and `chinese-tonepy' are also Pinyin
154based, but for the character set GB2312 (`chinese-gb2312').") 154based, but for the character set GB2312 (`chinese-gb2312').")
155 155
156 ("chinese-qj-b5" "$(0)A(BB") 156 ("chinese-qj-b5" "å…¨B")
157 157
158 ("chinese-qj" "$AH+(BG") 158 ("chinese-qj" "å…¨G")
159 159
160 ("chinese-sw" "$AJWN2(B" 160 ("chinese-sw" "首尾"
161"Radical base input method for Chinese charset GB2312 (`chinese-gb2312'). 161"Radical base input method for Chinese charset GB2312 (`chinese-gb2312').
162 162
163In this input method, you enter a Chinese character by typing two 163In this input method, you enter a Chinese character by typing two
164keys. The first key corresponds to the first ($AJW(B) radical, the second 164keys. The first key corresponds to the first (首) radical, the second
165key corresponds to the last ($AN2(B) radical. The correspondence of keys 165key corresponds to the last (å°¾) radical. The correspondence of keys
166and radicals is as below: 166and radicals is as below:
167 167
168 first radical: 168 first radical:
169 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 169 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
170 $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 170 心 冖 å°¸ 丶 ç« å£ æ‰Œ æ°µ è®  艹 亻 木 礻 饣 月 纟 石 王 å…« 丿 æ—¥ è¾¶ 犭 竹 一 人
171 last radical: 171 last radical:
172 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 172 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
173 $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 173 åˆ å±± 土 刀 é˜ å£ è¡£ ç–‹ 大 ä¸ åŽ¶ ç¬ å æ­¹ 冂 é—¨ 今 丨 女 ä¹™ å›— å° åŽ‚ 虫 弋 åœ
174 174
175\\<quail-translation-docstring>") 175\\<quail-translation-docstring>")
176 176
177 ("chinese-tonepy" "$A5wF4(B" 177 ("chinese-tonepy" "调拼"
178 "Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312'). 178 "Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
179 179
180Pinyin is the standard roman transliteration method for Chinese. 180Pinyin is the standard roman transliteration method for Chinese.
@@ -183,18 +183,18 @@ method `chinese-py'.
183 183
184This input method works almost the same way as `chinese-py'. The 184This input method works almost the same way as `chinese-py'. The
185difference is that you must type 1..5 after each Pinyin spelling to 185difference is that you must type 1..5 after each Pinyin spelling to
186specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B, 5:$AGaIy(B). 186specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声).
187 187
188\\<quail-translation-docstring> 188\\<quail-translation-docstring>
189 189
190For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is 190For instance, to input ä½ , you type \"n i 3 3\", the first \"n i\" is
191a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects 191a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects
192the third character from the candidate list. 192the third character from the candidate list.
193 193
194For double-width GB2312 characters corresponding to ASCII, use the 194For double-width GB2312 characters corresponding to ASCII, use the
195input method `chinese-qj'.") 195input method `chinese-qj'.")
196 196
197 ("chinese-zozy" "$(0I\0D(B" 197 ("chinese-zozy" "零注"
198"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1', 198"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
199`chinese-big5-2'). 199`chinese-big5-2').
200 200
@@ -203,8 +203,8 @@ compose a Chinese character.
203 203
204In this input method, you enter a Chinese character by first typing 204In this input method, you enter a Chinese character by first typing
205keys corresponding to Zhuyin symbols (see the above table) followed by 205keys corresponding to Zhuyin symbols (see the above table) followed by
206SPC, 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, 206SPC, 6, 3, 4, or 7 specifying a tone (SPC:é™°å¹³, 6:陽平, 3:上è², 4:去è²,
2077:$(0M=Vy(B). 2077:輕è²).
208 208
209\\<quail-translation-docstring>"))) 209\\<quail-translation-docstring>")))
210 210
@@ -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
269 (tit-moveleft ",<") 269 (tit-moveleft ",<")
270 (tit-keyprompt nil)) 270 (tit-keyprompt nil))
271 271
272 (princ (format ";;; %s -*- lexical-binding:t -*-\n"
273 (file-name-nondirectory filename)))
272 (princ ";; Quail package `") 274 (princ ";; Quail package `")
273 (princ package) 275 (princ package)
274 (princ "\n") 276 (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
354 (princ (nth 2 (assoc tit-encode tit-encode-list))) 356 (princ (nth 2 (assoc tit-encode tit-encode-list)))
355 (princ "\" \"") 357 (princ "\" \"")
356 (princ (or title 358 (princ (or title
357 (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt) 359 (if (string-match "[:∷:ã€]+\\([^:∷:】]+\\)" tit-prompt)
358 (substring tit-prompt (match-beginning 1) (match-end 1)) 360 (substring tit-prompt (match-beginning 1) (match-end 1))
359 tit-prompt))) 361 tit-prompt)))
360 (princ "\"\n")) 362 (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
375 ;; Arg DOCSTRING 377 ;; Arg DOCSTRING
376 (let ((doc (concat tit-prompt "\n")) 378 (let ((doc (concat tit-prompt "\n"))
377 (comments (if tit-comments 379 (comments (if tit-comments
378 (mapconcat 'identity (nreverse tit-comments) "\n"))) 380 (mapconcat #'identity (nreverse tit-comments) "\n")))
379 (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info)))) 381 (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info))))
380 (if comments 382 (if comments
381 (setq doc (concat doc "\n" comments "\n"))) 383 (setq doc (concat doc "\n" comments "\n")))
@@ -580,7 +582,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
580;; ) 582;; )
581 583
582(defvar quail-misc-package-ext-info 584(defvar quail-misc-package-ext-info
583 '(("chinese-b5-tsangchi" "$(06A(BB" 585 '(("chinese-b5-tsangchi" "倉B"
584 "cangjie-table.b5" big5 "tsang-b5.el" 586 "cangjie-table.b5" big5 "tsang-b5.el"
585 tsang-b5-converter 587 tsang-b5-converter
586 "\ 588 "\
@@ -590,7 +592,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
590;; # unmodified versions is granted without royalty provided 592;; # unmodified versions is granted without royalty provided
591;; # this notice is preserved.") 593;; # this notice is preserved.")
592 594
593 ("chinese-b5-quick" "$(0X|(BB" 595 ("chinese-b5-quick" "ç°¡B"
594 "cangjie-table.b5" big5 "quick-b5.el" 596 "cangjie-table.b5" big5 "quick-b5.el"
595 quick-b5-converter 597 quick-b5-converter
596 "\ 598 "\
@@ -600,7 +602,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
600;; # unmodified versions is granted without royalty provided 602;; # unmodified versions is granted without royalty provided
601;; # this notice is preserved.") 603;; # this notice is preserved.")
602 604
603 ("chinese-cns-tsangchi" "$(GT?(BC" 605 ("chinese-cns-tsangchi" "倉C"
604 "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" 606 "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
605 tsang-cns-converter 607 tsang-cns-converter
606 "\ 608 "\
@@ -610,7 +612,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
610;; # unmodified versions is granted without royalty provided 612;; # unmodified versions is granted without royalty provided
611;; # this notice is preserved.") 613;; # this notice is preserved.")
612 614
613 ("chinese-cns-quick" "$(Gv|(BC" 615 ("chinese-cns-quick" "ç°¡C"
614 "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" 616 "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
615 quick-cns-converter 617 quick-cns-converter
616 "\ 618 "\
@@ -620,7 +622,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
620;; # unmodified versions is granted without royalty provided 622;; # unmodified versions is granted without royalty provided
621;; # this notice is preserved.") 623;; # this notice is preserved.")
622 624
623 ("chinese-py" "$AF4(BG" 625 ("chinese-py" "拼G"
624 "pinyin.map" cn-gb-2312 "PY.el" 626 "pinyin.map" cn-gb-2312 "PY.el"
625 py-converter 627 py-converter
626 "\ 628 "\
@@ -648,7 +650,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
648;; You should have received a copy of the GNU General Public License along with 650;; You should have received a copy of the GNU General Public License along with
649;; CCE. If not, see <https://www.gnu.org/licenses/>.") 651;; CCE. If not, see <https://www.gnu.org/licenses/>.")
650 652
651 ("chinese-ziranma" "$AWTH;(B" 653 ("chinese-ziranma" "自然"
652 "ziranma.cin" cn-gb-2312 "ZIRANMA.el" 654 "ziranma.cin" cn-gb-2312 "ZIRANMA.el"
653 ziranma-converter 655 ziranma-converter
654 "\ 656 "\
@@ -676,7 +678,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
676;; You should have received a copy of the GNU General Public License along with 678;; You should have received a copy of the GNU General Public License along with
677;; CCE. If not, see <https://www.gnu.org/licenses/>.") 679;; CCE. If not, see <https://www.gnu.org/licenses/>.")
678 680
679 ("chinese-ctlau" "$AAuTA(B" 681 ("chinese-ctlau" "刘粤"
680 "CTLau.html" cn-gb-2312 "CTLau.el" 682 "CTLau.html" cn-gb-2312 "CTLau.el"
681 ctlau-gb-converter 683 ctlau-gb-converter
682 "\ 684 "\
@@ -701,7 +703,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
701;; # You should have received a copy of the GNU General Public License 703;; # You should have received a copy of the GNU General Public License
702;; # along with this program. If not, see <https://www.gnu.org/licenses/>.") 704;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
703 705
704 ("chinese-ctlaub" "$(0N,Gn(B" 706 ("chinese-ctlaub" "劉粵"
705 "CTLau-b5.html" big5 "CTLau-b5.el" 707 "CTLau-b5.html" big5 "CTLau-b5.el"
706 ctlau-b5-converter 708 ctlau-b5-converter
707 "\ 709 "\
@@ -731,41 +733,27 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
731;; dictionary in the buffer DICBUF. The input method name of the 733;; dictionary in the buffer DICBUF. The input method name of the
732;; Quail package is NAME, and the title string is TITLE. 734;; Quail package is NAME, and the title string is TITLE.
733 735
734;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise 736;; TSANG-P is non-nil, generate 倉頡 input method. Otherwise
735;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is non-nil, the 737;; generate 簡易 (simple version of 倉頡). If BIG5-P is non-nil, the
736;; input method is for inputting Big5 characters. Otherwise the input 738;; input method is for inputting Big5 characters. Otherwise the input
737;; method is for inputting CNS characters. 739;; method is for inputting CNS characters.
738 740
739(defun tsang-quick-converter (dicbuf tsang-p big5-p) 741(defun tsang-quick-converter (dicbuf tsang-p big5-p)
740 (let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B") 742 (let ((fulltitle (if tsang-p "倉頡" "簡易"))
741 (if big5-p "$(0X|/y(B" "$(Gv|Mx(B")))
742 dic) 743 dic)
743 (goto-char (point-max)) 744 (goto-char (point-max))
744 (if big5-p 745 (insert (format "\"中文輸入ã€%s】%s
745 (insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5
746 746
747 $(0KHM$(B%s$(0TT&,WoOu(B 747 漢語%s輸入éµç›¤
748 748
749 [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] 749 [Q 手] [W ç”°] [E æ°´] [R å£] [T 廿] [Y åœ] [U å±±] [I 戈] [O 人] [P 心]
750 750
751 [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] 751 [A æ—¥] [S å°¸] [D 木] [F ç«] [G 土] [H 竹] [J å] [L 中]
752 752
753 [Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N $(0&_(B] [M $(0&"(B] 753 [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
754 754
755\\\\<quail-translation-docstring>\"\n" 755\\\\<quail-translation-docstring>\"\n"
756 fulltitle fulltitle)) 756 fulltitle (if big5-p "BIG5" "CNS") fulltitle))
757 (insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS
758
759 $(GiGk#(B%s$(GrSD+uomu(B
760
761 [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]
762
763 [A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H $(GHL(B] [J $(GD2(B] [L $(GDc(B]
764
765 [Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N $(GD^(B] [M $(GD!(B]
766
767\\\\<quail-translation-docstring>\"\n"
768 fulltitle fulltitle)))
769 (insert " '((\".\" . quail-next-translation-block) 757 (insert " '((\".\" . quail-next-translation-block)
770 (\",\" . quail-prev-translation-block)) 758 (\",\" . quail-prev-translation-block))
771 nil nil)\n\n") 759 nil nil)\n\n")
@@ -798,35 +786,35 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
798 (setq dic (sort dic (lambda (x y) (string< (car x ) (car y))))) 786 (setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
799 (dolist (elt dic) 787 (dolist (elt dic)
800 (insert (format "(%S\t%S)\n" (car elt) (cdr elt)))) 788 (insert (format "(%S\t%S)\n" (car elt) (cdr elt))))
801 (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B") 789 (let ((punctuation '((";" ";﹔,ã€ï¹ï¹‘" ";﹔,ã€ï¹ï¹‘")
802 (":" "$(0!(!+!3!%!$!&!0!1(B" "$(G!(!+!3!%!$!&!0!1(B") 790 (":" ":︰﹕.。‧﹒·" ":︰﹕.。・﹒·")
803 ("'" "$(0!e!d(B" "$(G!e!d(B") 791 ("'" "’‘" "’‘")
804 ("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B") 792 ("\"" "â€â€œã€ã€žã€ƒ" "â€â€œã€ã€žã€ƒ")
805 ("\\" "$(0"`"b#M(B" "$(G"`"b#M(B") 793 ("\\" "\﹨╲" "\﹨╲")
806 ("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B") 794 ("|" "|︱︳∣" "︱︲ô”€™ï½œ")
807 ("/" "$(0"_"a#L(B" "$(G"_"a#L(B") 795 ("/" "ï¼âˆ•╱" "ï¼âˆ•╱")
808 ("?" "$(0!)!4(B" "$(G!)!4(B") 796 ("?" "?﹖" "?﹖")
809 ("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B") 797 ("<" "〈<﹤︿∠" "〈<﹤︿∠")
810 (">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B") 798 (">" "〉>﹥﹀" "〉>﹦﹀")
811 ("[" "$(0!F!J!b!H!L!V!Z!X!\(B" "$(G!F!J!b!H!L!V!Z!X!\(B") 799 ("[" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ")
812 ("]" "$(0!G!K!c!I!M!W![!Y!](B" "$(G!G!K!c!I!M!W![!Y!](B") 800 ("]" "〕】﹞︺︼ã€ã€ï¹‚﹄" "〕】﹞︺︼ã€ã€ï¹‚﹄")
813 ("{" "$(0!B!`!D(B " "$(G!B!`!D(B ") 801 ("{" "{﹛︷ " "{﹛︷ ")
814 ("}" "$(0!C!a!E(B" "$(G!C!a!E(B") 802 ("}" "ï½ï¹œï¸¸" "ï½ï¹œï¸¸")
815 ("`" "$(0!j!k(B" "$(G!j!k(B") 803 ("`" "‵′" "′‵")
816 ("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B") 804 ("~" "~﹋﹌︴ï¹" "∼﹋﹌ô”€›ô”€œ")
817 ("!" "$(0!*!5(B" "$(G!*!5(B") 805 ("!" "ï¼ï¹—" "ï¼ï¹—")
818 ("@" "$(0"i"n(B" "$(G"i"n(B") 806 ("@" "@﹫" "@﹫")
819 ("#" "$(0!l"-(B" "$(G!l"-(B") 807 ("#" "#﹟" "#﹟")
820 ("$" "$(0"c"l(B" "$(G"c"l(B") 808 ("$" "$﹩" "$﹩")
821 ("%" "$(0"h"m(B" "$(G"h"m(B") 809 ("%" "%﹪" "%﹪")
822 ("&" "$(0!m".(B" "$(G!m".(B") 810 ("&" "&﹠" "&﹠")
823 ("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B") 811 ("*" "*﹡※☆★" "*﹡※☆★")
824 ("(" "$(0!>!^!@(B" "$(G!>!^!@(B") 812 ("(" "(﹙︵" "(﹙︵")
825 (")" "$(0!?!_!A(B" "$(G!?!_!A(B") 813 (")" ")﹚︶" ")﹚︶")
826 ("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B") 814 ("-" "–—¯ ̄ï¼ï¹£" "—–‾ô”¡ï¼ï¹£")
827 ("_" "$(0"%"&(B" "$(G"%"&(B") 815 ("_" "_Ë" "_ô”£")
828 ("=" "$(0"8"C(B" "$(G"8"C(B") 816 ("=" "ï¼ï¹¦" "ï¼ï¹¥")
829 ("+" "$(0"0"?(B" "$(G"0"?(B")))) 817 ("+" "+﹢" "+﹢"))))
830 (dolist (elt punctuation) 818 (dolist (elt punctuation)
831 (insert (format "(%S %S)\n" (concat "z" (car elt)) 819 (insert (format "(%S %S)\n" (concat "z" (car elt))
832 (if big5-p (nth 1 elt) (nth 2 elt)))))) 820 (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\"."
850 838
851(defun py-converter (dicbuf) 839(defun py-converter (dicbuf)
852 (goto-char (point-max)) 840 (goto-char (point-max))
853 (insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B 841 (insert (format "%S\n" "汉字输入∷拼音∷
854 842
855 $AF4Rt7=08(B 843 拼音方案
856 844
857 $AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B 845 å°å†™è‹±æ–‡å­—æ¯ä»£è¡¨ã€Œæ‹¼éŸ³ã€ç¬¦å·ï¼Œ \"u(yu) 则用 u: 表示∶
858 846
859Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312'). 847Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
860 848
@@ -868,14 +856,14 @@ character. The sequence is made by the combination of the initials
868 iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun 856 iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun
869 857
870 (Note: In the correct Pinyin writing, the sequence \"yu\" in the last 858 (Note: In the correct Pinyin writing, the sequence \"yu\" in the last
871 four finals should be written by the character u-umlaut `$A(9(B'.) 859 four finals should be written by the character u-umlaut `ü'.)
872 860
873With this input method, you enter a Chinese character by first 861With this input method, you enter a Chinese character by first
874entering its pinyin spelling. 862entering its pinyin spelling.
875 863
876\\<quail-translation-docstring> 864\\<quail-translation-docstring>
877 865
878For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\" 866For instance, to input ä½ , you type \"n i C-n 3\". The first \"n i\"
879is a Pinyin, \"C-n\" selects the next group of candidates (each group 867is a Pinyin, \"C-n\" selects the next group of candidates (each group
880contains at most 10 characters), \"3\" select the third character in 868contains at most 10 characters), \"3\" select the third character in
881that group. 869that group.
@@ -953,27 +941,27 @@ method `chinese-tonepy' with which you must specify tones by digits
953 (= (length (aref trans i)) 1)) 941 (= (length (aref trans i)) 1))
954 (setq i (1+ i))) 942 (setq i (1+ i)))
955 (if (= i len) 943 (if (= i len)
956 (setq trans (mapconcat 'identity trans ""))))) 944 (setq trans (mapconcat #'identity trans "")))))
957 (setq dic (cons (cons key trans) dic))) 945 (setq dic (cons (cons key trans) dic)))
958 table))) 946 table)))
959 (setq dic (sort dic (lambda (x y) (string< (car x) (car y))))) 947 (setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
960 (goto-char (point-max)) 948 (goto-char (point-max))
961 (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B 949 (insert (format "%S\n" "汉字输入∷ã€è‡ªç„¶ã€‘∷
962 950
963 $A<|EL6TUU1m(B: 951 键盘对照表:
964 $A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B 952 â”â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┓
965 $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 953 ┃Q ┃W ┃E ┃R ┃T ┃Y ┃Ush┃Ich┃O ┃P ┃
966 $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 954 ┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃
967 $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 955 ┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃
968 $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B 956 ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”›
969 $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 957 ┃A ┃S ┃D ┃F ┃G ┃H ┃J ┃K ┃L ┃
970 $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 958 ┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃
971 $A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B 959 ┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃
972 $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B 960 ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”┓
973 $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 961 ┃Z ┃X ┃C ┃Vzh┃B ┃N ┃M ┃, ┃. ┃ ï¼ â”ƒ
974 $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 962 ┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃å‰é¡µâ”ƒåŽé¡µâ”ƒç¬¦å·â”ƒ
975 $A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B 963 ┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃
976 $A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B 964 â”—â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”›
977 965
978 966
979Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312'). 967Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312').
@@ -985,34 +973,34 @@ method `chinese-py'.
985Unlike the standard spelling of Pinyin, in this input method all 973Unlike the standard spelling of Pinyin, in this input method all
986initials and finals are assigned to single keys (see the above table). 974initials and finals are assigned to single keys (see the above table).
987For instance, the initial \"ch\" is assigned to the key `i', the final 975For instance, the initial \"ch\" is assigned to the key `i', the final
988\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are 976\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are
989assigned to the keys `q', `w', `e', `r', `t' respectively. 977assigned to the keys `q', `w', `e', `r', `t' respectively.
990 978
991\\<quail-translation-docstring> 979\\<quail-translation-docstring>
992 980
993To input one-letter words, you type 4 keys, the first two for the 981To input one-letter words, you type 4 keys, the first two for the
994Pinyin of the letter, next one for tone, and the last one is always a 982Pinyin of the letter, next one for tone, and the last one is always a
995quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these 983quote ('). For instance, \"vsq'\" input 中. Exceptions are these
996letters. You can input them just by typing a single key. 984letters. You can input them just by typing a single key.
997 985
998 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 986 Character: 按 ä¸ æ¬¡ çš„ 二 å‘ ä¸ª å’Œ 出 åŠ å¯ äº† 没
999 Key: a b c d e f g h i j k l m 987 Key: a b c d e f g h i j k l m
1000 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 988 Character: ä½  欧 片 七 人 三 ä»– 是 ç€ æˆ‘ å° ä¸€ 在
1001 Key: n o p q r s t u v w x y z 989 Key: n o p q r s t u v w x y z
1002 990
1003To input two-letter words, you have two ways. One way is to type 4 991To input two-letter words, you have two ways. One way is to type 4
1004keys, two for the first Pinyin, two for the second Pinyin. For 992keys, two for the first Pinyin, two for the second Pinyin. For
1005instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2 993instance, \"vsgo\" inputs 中国. Another way is to type 3 keys: 2
1006initials of two letters, and quote ('). For instance, \"vg'\" also 994initials of two letters, and quote ('). For instance, \"vg'\" also
1007inputs $AVP9z(B. 995inputs 中国.
1008 996
1009To input three-letter words, you type 4 keys: initials of three 997To input three-letter words, you type 4 keys: initials of three
1010letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B 998letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北
1011$A>)Q<(B (the last `2' is to select one of the candidates). 999京鸭 (the last `2' is to select one of the candidates).
1012 1000
1013To input words of more than three letters, you type 4 keys, initials 1001To input words of more than three letters, you type 4 keys, initials
1014of the first three letters and the last letter. For instance, 1002of the first three letters and the last letter. For instance,
1015\"bjdt\" inputs $A11>)5gJSL((B. 1003\"bjdt\" inputs 北京电视å°.
1016 1004
1017To input symbols and punctuation, type `/' followed by one of `a' to 1005To input symbols and punctuation, type `/' followed by one of `a' to
1018`z', then select one of the candidates.")) 1006`z', then select one of the candidates."))
@@ -1059,7 +1047,7 @@ To input symbols and punctuation, type `/' followed by one of `a' to
1059 ;; which the file is converted have no Big5 equivalent. Go 1047 ;; which the file is converted have no Big5 equivalent. Go
1060 ;; through and delete them. 1048 ;; through and delete them.
1061 (goto-char pos) 1049 (goto-char pos)
1062 (while (search-forward "$(0!{(B" nil t) 1050 (while (search-forward "â–¡" nil t)
1063 (delete-char -1)) 1051 (delete-char -1))
1064 ;; Uppercase keys in dictionary need to be downcased. Backslashes 1052 ;; Uppercase keys in dictionary need to be downcased. Backslashes
1065 ;; at the beginning of keys need to be turned into double 1053 ;; 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
1083 1071
1084(defun ctlau-gb-converter (dicbuf) 1072(defun ctlau-gb-converter (dicbuf)
1085 (ctlau-converter dicbuf 1073 (ctlau-converter dicbuf
1086"$A::WVJdHk!KAuN}OiJ=TARt!K(B 1074"汉字输入∷刘锡祥å¼ç²¤éŸ³âˆ·
1087 1075
1088 $AAuN}OiJ=TASoW"Rt7=08(B 1076 刘锡祥å¼ç²¤è¯­æ³¨éŸ³æ–¹æ¡ˆ
1089 Sidney Lau's Cantonese transcription scheme as described in his book 1077 Sidney Lau's Cantonese transcription scheme as described in his book
1090 \"Elementary Cantonese\", The Government Printer, Hong Kong, 1972. 1078 \"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
1091 This file was prepared by Fung Fung Lee ($A@n7c7e(B). 1079 This file was prepared by Fung Fung Lee (æŽæž«å³°).
1092 Originally converted from CTCPS3.tit 1080 Originally converted from CTCPS3.tit
1093 Last modified: June 2, 1993. 1081 Last modified: June 2, 1993.
1094 1082
1095 Some infrequent GB characters are accessed by typing \\, followed by 1083 Some infrequent GB characters are accessed by typing \\, followed by
1096 the Cantonese romanization of the respective radical ($A2?JW(B).")) 1084 the Cantonese romanization of the respective radical (部首)."))
1097 1085
1098(defun ctlau-b5-converter (dicbuf) 1086(defun ctlau-b5-converter (dicbuf)
1099 (ctlau-converter dicbuf 1087 (ctlau-converter dicbuf
1100"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B 1088"漢字輸入:劉錫祥å¼ç²µéŸ³ï¼š
1101 1089
1102 $(0N,Tg>A*#GnM$0D5x'J7{(B 1090 劉錫祥å¼ç²µèªžæ³¨éŸ³æ–¹æ¡ˆ
1103 Sidney Lau's Cantonese transcription scheme as described in his book 1091 Sidney Lau's Cantonese transcription scheme as described in his book
1104 \"Elementary Cantonese\", The Government Printer, Hong Kong, 1972. 1092 \"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
1105 This file was prepared by Fung Fung Lee ($(0,XFS76(B). 1093 This file was prepared by Fung Fung Lee (æŽæ¥“å³°).
1106 Originally converted from CTCPS3.tit 1094 Originally converted from CTCPS3.tit
1107 Last modified: June 2, 1993. 1095 Last modified: June 2, 1993.
1108 1096
1109 Some infrequent characters are accessed by typing \\, followed by 1097 Some infrequent characters are accessed by typing \\, followed by
1110 the Cantonese romanization of the respective radical ($(0?f5}(B).")) 1098 the Cantonese romanization of the respective radical (部首)."))
1111 1099
1112(declare-function dos-8+3-filename "dos-fns.el" (filename)) 1100(declare-function dos-8+3-filename "dos-fns.el" (filename))
1113 1101
@@ -1147,6 +1135,8 @@ the generated Quail package is saved."
1147 ;; Explicitly set eol format to `unix'. 1135 ;; Explicitly set eol format to `unix'.
1148 (setq coding-system-for-write 'utf-8-unix) 1136 (setq coding-system-for-write 'utf-8-unix)
1149 (with-temp-file (expand-file-name quailfile dirname) 1137 (with-temp-file (expand-file-name quailfile dirname)
1138 (insert (format ";;; %s -*- lexical-binding:t -*-\n"
1139 (file-name-nondirectory quailfile)))
1150 (insert (format-message ";; Quail package `%s'\n" name)) 1140 (insert (format-message ";; Quail package `%s'\n" name))
1151 (insert (format-message 1141 (insert (format-message
1152 ";; Generated by the command `miscdic-convert'\n")) 1142 ";; Generated by the command `miscdic-convert'\n"))
@@ -1212,8 +1202,10 @@ The library is named pinyin.el, and contains the constant
1212 (dst-file (cadr command-line-args-left)) 1202 (dst-file (cadr command-line-args-left))
1213 (coding-system-for-write 'utf-8-unix)) 1203 (coding-system-for-write 'utf-8-unix))
1214 (with-temp-file dst-file 1204 (with-temp-file dst-file
1215 (insert ";; This file is automatically generated from pinyin.map,\ 1205 (insert ";;; " (file-name-nondirectory dst-file)
1216 by the\n;; function pinyin-convert.\n\n") 1206 " -*- lexical-binding:t -*-
1207;; This file is automatically generated from pinyin.map, by the
1208;; function pinyin-convert.\n\n")
1217 (insert "(defconst pinyin-character-map\n'(") 1209 (insert "(defconst pinyin-character-map\n'(")
1218 (let ((pos (point))) 1210 (let ((pos (point)))
1219 (insert-file-contents src-file) 1211 (insert-file-contents src-file)
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index e941abb463e..dece184ffef 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -1,4 +1,4 @@
1;;; utf-7.el --- utf-7 coding system 1;;; utf-7.el --- utf-7 coding system -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2003-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/isearch.el b/lisp/isearch.el
index a86678572c4..a1e3fe2c3f0 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -513,7 +513,7 @@ This is like `describe-bindings', but displays only Isearch keys."
513 (call-interactively command))) 513 (call-interactively command)))
514 514
515(defvar isearch-menu-bar-commands 515(defvar isearch-menu-bar-commands
516 '(isearch-tmm-menubar menu-bar-open mouse-minor-mode-menu) 516 '(isearch-tmm-menubar tmm-menubar menu-bar-open mouse-minor-mode-menu)
517 "List of commands that can open a menu during Isearch.") 517 "List of commands that can open a menu during Isearch.")
518 518
519(defvar isearch-menu-bar-yank-map 519(defvar isearch-menu-bar-yank-map
@@ -787,7 +787,6 @@ This is like `describe-bindings', but displays only Isearch keys."
787 787
788 (define-key map [menu-bar search-menu] 788 (define-key map [menu-bar search-menu]
789 (list 'menu-item "Isearch" isearch-menu-bar-map)) 789 (list 'menu-item "Isearch" isearch-menu-bar-map))
790 (define-key map [remap tmm-menubar] 'isearch-tmm-menubar)
791 790
792 map) 791 map)
793 "Keymap for `isearch-mode'.") 792 "Keymap for `isearch-mode'.")
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index bb8dacf4f48..303f38a59b6 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -172,6 +172,7 @@ macro to be executed before appending to it."
172 (define-key map "\C-k" 'kmacro-end-or-call-macro-repeat) 172 (define-key map "\C-k" 'kmacro-end-or-call-macro-repeat)
173 (define-key map "r" 'apply-macro-to-region-lines) 173 (define-key map "r" 'apply-macro-to-region-lines)
174 (define-key map "q" 'kbd-macro-query) ;; Like C-x q 174 (define-key map "q" 'kbd-macro-query) ;; Like C-x q
175 (define-key map "Q" 'kdb-macro-redisplay)
175 176
176 ;; macro ring 177 ;; macro ring
177 (define-key map "\C-n" 'kmacro-cycle-ring-next) 178 (define-key map "\C-n" 'kmacro-cycle-ring-next)
@@ -1298,6 +1299,16 @@ To customize possible responses, change the \"bindings\" in
1298 (kmacro-push-ring) 1299 (kmacro-push-ring)
1299 (setq last-kbd-macro kmacro-step-edit-new-macro)))) 1300 (setq last-kbd-macro kmacro-step-edit-new-macro))))
1300 1301
1302(defun kdb-macro-redisplay ()
1303 "Force redisplay during kbd macro execution."
1304 (interactive)
1305 (or executing-kbd-macro
1306 defining-kbd-macro
1307 (user-error "Not defining or executing kbd macro"))
1308 (when executing-kbd-macro
1309 (let ((executing-kbd-macro nil))
1310 (redisplay))))
1311
1301(provide 'kmacro) 1312(provide 'kmacro)
1302 1313
1303;;; kmacro.el ends here 1314;;; kmacro.el ends here
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index d689e87d785..373f25ac5ca 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -51,7 +51,7 @@
51 regexp t t)))) 51 regexp t t))))
52 regexp)) 52 regexp))
53 53
54(let ((elt (list (vector burmese-composable-pattern 0 'font-shape-gstring) 54(let ((elt (list (vector burmese-composable-pattern 0 #'font-shape-gstring)
55 (vector "." 0 'font-shape-gstring)))) 55 (vector "." 0 #'font-shape-gstring))))
56 (set-char-table-range composition-function-table '(#x1000 . #x107F) elt) 56 (set-char-table-range composition-function-table '(#x1000 . #x107F) elt)
57 (set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt)) 57 (set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt))
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index 089988da918..3aac986b437 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -23,13 +23,13 @@
23 23
24;;; Commentary: 24;;; Commentary:
25 25
26;; Tai Viet is being included in the Unicode at the range U+AA80..U+AADF. 26;; Cham script is included in the Unicode at the range U+AA00..U+AA5F.
27 27
28;;; Code: 28;;; Code:
29 29
30(set-char-table-range composition-function-table 30(set-char-table-range composition-function-table
31 '(#xAA00 . #xAA5F) 31 '(#xAA00 . #xAA5F)
32 (list (vector "[\xAA00-\xAA5F]+" 0 'font-shape-gstring))) 32 (list (vector "[\xAA00-\xAA5F]+" 0 #'font-shape-gstring)))
33 33
34(set-language-info-alist 34(set-language-info-alist
35 "Cham" '((charset unicode) 35 "Cham" '((charset unicode)
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 4bc2eaa2cdd..105e7a735fd 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -1,4 +1,4 @@
1;;; china-util.el --- utilities for Chinese -*- coding: utf-8 -*- 1;;; china-util.el --- utilities for Chinese -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 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 72ceffdf0d6..04e681d743d 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -1,4 +1,4 @@
1;;; cyril-util.el --- utilities for Cyrillic scripts 1;;; cyril-util.el --- utilities for Cyrillic scripts -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 174b9ecfda2..9b5fdf24d2b 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1,4 +1,4 @@
1;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*- 1;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2002-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2002-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 4;; 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."
832 (set-buffer-modified-p nil))) 832 (set-buffer-modified-p nil)))
833 833
834;;;###autoload 834;;;###autoload
835(defun ethio-tex-to-fidel-buffer nil 835(defun ethio-tex-to-fidel-buffer ()
836 "Convert fidel-tex commands in the current buffer into fidel chars." 836 "Convert fidel-tex commands in the current buffer into fidel chars."
837 (interactive) 837 (interactive)
838 (let ((buffer-read-only nil) 838 (let ((inhibit-read-only t)
839 (p) (ch)) 839 ;; (p) (ch)
840 )
840 841
841 ;; TeX macros to Ethiopic characters 842 ;; TeX macros to Ethiopic characters
842 (robin-convert-region (point-min) (point-max) "ethiopic-tex") 843 (robin-convert-region (point-min) (point-max) "ethiopic-tex")
@@ -1018,7 +1019,7 @@ With ARG, insert that many delimiters."
1018;; 1019;;
1019 1020
1020;;;###autoload 1021;;;###autoload
1021(defun ethio-composition-function (pos to font-object string _direction) 1022(defun ethio-composition-function (pos _to _font-object string _direction)
1022 (setq pos (1- pos)) 1023 (setq pos (1- pos))
1023 (let ((pattern "\\ce\\(áŸ\\|ö ‡Š\\)")) 1024 (let ((pattern "\\ce\\(áŸ\\|ö ‡Š\\)"))
1024 (if string 1025 (if string
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 8573f6177df..209dcd51c90 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -79,8 +79,8 @@
79))) 79)))
80 80
81;; For automatic composition 81;; For automatic composition
82(aset composition-function-table ?ö ‡Š 'ethio-composition-function) 82(aset composition-function-table ?ö ‡Š #'ethio-composition-function)
83(aset composition-function-table ?០'ethio-composition-function) 83(aset composition-function-table ?០#'ethio-composition-function)
84 84
85(provide 'ethiopic) 85(provide 'ethiopic)
86 86
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 313fc63bebd..9e9213536cb 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -1,4 +1,4 @@
1;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*- 1;;; hanja-util.el --- Korean Hanja util module -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2008-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 389565669a9..c55d23f72d6 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -245,9 +245,9 @@ Bidirectional editing is supported.")))
245 (pattern2 (concat base "\u200D" combining))) 245 (pattern2 (concat base "\u200D" combining)))
246 (set-char-table-range 246 (set-char-table-range
247 composition-function-table '(#x591 . #x5C7) 247 composition-function-table '(#x591 . #x5C7)
248 (list (vector pattern2 3 'hebrew-shape-gstring) 248 (list (vector pattern2 3 #'hebrew-shape-gstring)
249 (vector pattern2 2 'hebrew-shape-gstring) 249 (vector pattern2 2 #'hebrew-shape-gstring)
250 (vector pattern1 1 'hebrew-shape-gstring) 250 (vector pattern1 1 #'hebrew-shape-gstring)
251 [nil 0 hebrew-shape-gstring])) 251 [nil 0 hebrew-shape-gstring]))
252 ;; Exclude non-combining characters. 252 ;; Exclude non-combining characters.
253 (set-char-table-range 253 (set-char-table-range
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 4bd1cd76a6d..8d4b2a826e6 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -1,4 +1,4 @@
1;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; -*- 1;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4 4
@@ -40,7 +40,7 @@
40(defun indian-regexp-of-hashtbl-keys (hashtbl) 40(defun indian-regexp-of-hashtbl-keys (hashtbl)
41 "Return the regular expression of hash table keys." 41 "Return the regular expression of hash table keys."
42 (let (keys) 42 (let (keys)
43 (maphash (lambda (key val) (push key keys)) hashtbl) 43 (maphash (lambda (key _val) (push key keys)) hashtbl)
44 (regexp-opt keys))) 44 (regexp-opt keys)))
45 45
46(defvar indian-dev-base-table 46(defvar indian-dev-base-table
@@ -565,7 +565,7 @@
565 (let ((regexp ,(indian-regexp-of-hashtbl-keys 565 (let ((regexp ,(indian-regexp-of-hashtbl-keys
566 (if encode-p (car (eval hashtable)) 566 (if encode-p (car (eval hashtable))
567 (cdr (eval hashtable)))))) 567 (cdr (eval hashtable))))))
568 (narrow-to-region from to) 568 (narrow-to-region ,from ,to)
569 (goto-char (point-min)) 569 (goto-char (point-min))
570 (while (re-search-forward regexp nil t) 570 (while (re-search-forward regexp nil t)
571 (let ((matchstr (gethash (match-string 0) 571 (let ((matchstr (gethash (match-string 0)
@@ -613,7 +613,7 @@
613 613
614;; The followings provide conversion between IS 13194 (ISCII) and UCS. 614;; The followings provide conversion between IS 13194 (ISCII) and UCS.
615 615
616(let 616(dlet
617 ;;Unicode vs IS13194 ;; only Devanagari is supported now. 617 ;;Unicode vs IS13194 ;; only Devanagari is supported now.
618 ((ucs-devanagari-to-is13194-alist 618 ((ucs-devanagari-to-is13194-alist
619 '((?\x0900 . "[U+0900]") 619 '((?\x0900 . "[U+0900]")
@@ -820,11 +820,11 @@ Returns new end position."
820 (save-restriction 820 (save-restriction
821 (narrow-to-region from to) 821 (narrow-to-region from to)
822 (goto-char (point-min)) 822 (goto-char (point-min))
823 (let* ((current-repertory is13194-default-repertory)) 823 ;; (let* ((current-repertory is13194-default-repertory))
824 (while (re-search-forward indian-ucs-to-is13194-regexp nil t) 824 (while (re-search-forward indian-ucs-to-is13194-regexp nil t)
825 (replace-match 825 (replace-match
826 (get-char-code-property (string-to-char (match-string 0)) 826 (get-char-code-property (string-to-char (match-string 0))
827 'iscii)))) 827 'iscii)));; )
828 (point-max)))) 828 (point-max))))
829 829
830(defun indian-iscii-to-ucs-region (from to) 830(defun indian-iscii-to-ucs-region (from to)
@@ -1246,7 +1246,7 @@ Returns new end position."
1246 (interactive "r") 1246 (interactive "r")
1247 (save-excursion 1247 (save-excursion
1248 (save-restriction 1248 (save-restriction
1249 (let ((pos from) 1249 (let (;; (pos from)
1250 (alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0))) 1250 (alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0)))
1251 (narrow-to-region from to) 1251 (narrow-to-region from to)
1252 (decompose-region from to) 1252 (decompose-region from to)
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 5ff57966c12..6f9d2703849 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."))
381 (if slot 381 (if slot
382 (set-char-table-range 382 (set-char-table-range
383 composition-function-table key 383 composition-function-table key
384 (list (vector (cdr slot) 0 'font-shape-gstring)))))) 384 (list (vector (cdr slot) 0 #'font-shape-gstring))))))
385 char-script-table)) 385 char-script-table))
386 386
387(provide 'indian) 387(provide 'indian)
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 9dce17c4967..948bfef9f22 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -1,4 +1,4 @@
1;;; japan-util.el --- utilities for Japanese 1;;; japan-util.el --- utilities for Japanese -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -236,7 +236,7 @@ of which charset is `japanese-jisx0201-kana'."
236 (composition 236 (composition
237 (and (not hankaku) 237 (and (not hankaku)
238 (get-char-code-property kana 'kana-composition))) 238 (get-char-code-property kana 'kana-composition)))
239 next slot) 239 slot) ;; next
240 (if (and composition (setq slot (assq (following-char) composition))) 240 (if (and composition (setq slot (assq (following-char) composition)))
241 (japanese-replace-region (match-beginning 0) (1+ (point)) 241 (japanese-replace-region (match-beginning 0) (1+ (point))
242 (cdr slot)) 242 (cdr slot))
@@ -258,7 +258,7 @@ of which charset is `japanese-jisx0201-kana'."
258 (while (re-search-forward "\\cK\\|\\ck" nil t) 258 (while (re-search-forward "\\cK\\|\\ck" nil t)
259 (let* ((kata (preceding-char)) 259 (let* ((kata (preceding-char))
260 (composition (get-char-code-property kata 'kana-composition)) 260 (composition (get-char-code-property kata 'kana-composition))
261 next slot) 261 slot) ;; next
262 (if (and composition (setq slot (assq (following-char) composition))) 262 (if (and composition (setq slot (assq (following-char) composition)))
263 (japanese-replace-region (match-beginning 0) (1+ (point)) 263 (japanese-replace-region (match-beginning 0) (1+ (point))
264 (get-char-code-property 264 (get-char-code-property
@@ -305,7 +305,7 @@ Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char."
305 (re-search-forward "\\ca\\|\\ck" nil t))) 305 (re-search-forward "\\ca\\|\\ck" nil t)))
306 (let* ((hankaku (preceding-char)) 306 (let* ((hankaku (preceding-char))
307 (composition (get-char-code-property hankaku 'kana-composition)) 307 (composition (get-char-code-property hankaku 'kana-composition))
308 next slot) 308 slot) ;; next
309 (if (and composition (setq slot (assq (following-char) composition))) 309 (if (and composition (setq slot (assq (following-char) composition)))
310 (japanese-replace-region (match-beginning 0) (1+ (point)) 310 (japanese-replace-region (match-beginning 0) (1+ (point))
311 (cdr slot)) 311 (cdr slot))
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index 37173c9fb95..6f08e60d601 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -31,7 +31,7 @@
31 (documentation . t))) 31 (documentation . t)))
32 32
33(let ((val (list (vector "[\x1780-\x17FF\x19E0-\x19FF\x200C\x200D]+" 33(let ((val (list (vector "[\x1780-\x17FF\x19E0-\x19FF\x200C\x200D]+"
34 0 'font-shape-gstring)))) 34 0 #'font-shape-gstring))))
35 (set-char-table-range composition-function-table '(#x1780 . #x17FF) val) 35 (set-char-table-range composition-function-table '(#x1780 . #x17FF) val)
36 (set-char-table-range composition-function-table '(#x19E0 . #x19FF) val)) 36 (set-char-table-range composition-function-table '(#x19E0 . #x19FF) val))
37 37
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index eb7b85bce81..c99ff3c3f2d 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -1,4 +1,4 @@
1;;; korea-util.el --- utilities for Korean 1;;; korea-util.el --- utilities for Korean -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -45,7 +45,7 @@
45 (activate-input-method 45 (activate-input-method
46 (concat "korean-hangul" default-korean-keyboard)))) 46 (concat "korean-hangul" default-korean-keyboard))))
47 47
48(defun quail-hangul-switch-symbol-ksc (&rest ignore) 48(defun quail-hangul-switch-symbol-ksc (&rest _ignore)
49 "Switch to/from Korean symbol package." 49 "Switch to/from Korean symbol package."
50 (interactive "i") 50 (interactive "i")
51 (and current-input-method 51 (and current-input-method
@@ -54,7 +54,7 @@
54 default-korean-keyboard)) 54 default-korean-keyboard))
55 (activate-input-method "korean-symbol")))) 55 (activate-input-method "korean-symbol"))))
56 56
57(defun quail-hangul-switch-hanja (&rest ignore) 57(defun quail-hangul-switch-hanja (&rest _ignore)
58 "Switch to/from Korean hanja package." 58 "Switch to/from Korean hanja package."
59 (interactive "i") 59 (interactive "i")
60 (and current-input-method 60 (and current-input-method
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 22b33a440ef..bdf8240de96 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:
92 (pattern (concat choseong jungseong jongseong))) 92 (pattern (concat choseong jungseong jongseong)))
93 (set-char-table-range composition-function-table 93 (set-char-table-range composition-function-table
94 '(#x1100 . #x115F) 94 '(#x1100 . #x115F)
95 (list (vector pattern 0 'font-shape-gstring))) 95 (list (vector pattern 0 #'font-shape-gstring)))
96 (set-char-table-range composition-function-table 96 (set-char-table-range composition-function-table
97 '(#xA960 . #xA97C) 97 '(#xA960 . #xA97C)
98 (list (vector pattern 0 'font-shape-gstring)))) 98 (list (vector pattern 0 #'font-shape-gstring))))
99 99
100(provide 'korean) 100(provide 'korean)
101 101
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 59c9850b1a1..c8c3fe4f7e6 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -1,4 +1,4 @@
1;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*- 1;;; lao-util.el --- utilities for Lao -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 4;; 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."
498 (compose-gstring-for-graphic gstring direction) 498 (compose-gstring-for-graphic gstring direction)
499 (or (font-shape-gstring gstring direction) 499 (or (font-shape-gstring gstring direction)
500 (let ((glyph-len (lgstring-glyph-len gstring)) 500 (let ((glyph-len (lgstring-glyph-len gstring))
501 (i 0) 501 (i 0)) ;; glyph
502 glyph)
503 (while (and (< i glyph-len) 502 (while (and (< i glyph-len)
504 (setq glyph (lgstring-glyph gstring i))) 503 ;; (setq glyph
504 (lgstring-glyph gstring i)) ;;)
505 (setq i (1+ i))) 505 (setq i (1+ i)))
506 (compose-glyph-string-relative gstring 0 i 0.1))))) 506 (compose-glyph-string-relative gstring 0 i 0.1)))))
507 507
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 5252f1e60ea..c699d57c15a 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -66,7 +66,7 @@
66 (t (string c)))) 66 (t (string c))))
67 (cdr l) "")) 67 (cdr l) ""))
68 ;; Element of composition-function-table. 68 ;; Element of composition-function-table.
69 (elt (list (vector regexp 1 'lao-composition-function) 69 (elt (list (vector regexp 1 #'lao-composition-function)
70 fallback-rule)) 70 fallback-rule))
71 ch) 71 ch)
72 (dotimes (i len) 72 (dotimes (i len)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 0a274f144c2..a2ca678b2be 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -137,9 +137,9 @@ thin (i.e. 1-dot width) space."
137 composition-function-table 137 composition-function-table
138 '(#x600 . #x74F) 138 '(#x600 . #x74F)
139 (list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+" 139 (list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
140 1 'arabic-shape-gstring) 140 1 #'arabic-shape-gstring)
141 (vector "[\u0600-\u074F\u200C\u200D]+" 141 (vector "[\u0600-\u074F\u200C\u200D]+"
142 0 'arabic-shape-gstring))) 142 0 #'arabic-shape-gstring)))
143 143
144;; The Egyptian Hieroglyph Format Controls were introduced in Unicode 144;; The Egyptian Hieroglyph Format Controls were introduced in Unicode
145;; Standard v12.0. Apparently, they are not yet well supported in 145;; Standard v12.0. Apparently, they are not yet well supported in
@@ -186,13 +186,13 @@ thin (i.e. 1-dot width) space."
186 ;; doesn't support these controls, the glyphs are 186 ;; doesn't support these controls, the glyphs are
187 ;; displayed individually, and not as a single 187 ;; displayed individually, and not as a single
188 ;; grapheme cluster. 188 ;; grapheme cluster.
189 1 'font-shape-gstring))) 189 1 #'font-shape-gstring)))
190 ;; Grouping controls 190 ;; Grouping controls
191 (set-char-table-range 191 (set-char-table-range
192 composition-function-table 192 composition-function-table
193 #x13437 193 #x13437
194 (list (vector "\U00013437[\U00013000-\U0001343F]+" 194 (list (vector "\U00013437[\U00013000-\U0001343F]+"
195 0 'egyptian-shape-grouping)))) 195 0 #'egyptian-shape-grouping))))
196 196
197(provide 'misc-lang) 197(provide 'misc-lang)
198 198
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index 90fc41c1c41..99a104ec339 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -43,6 +43,6 @@
43 "[\u0D85-\u0D96][\u0D82-\u0D83]?\\|" 43 "[\u0D85-\u0D96][\u0D82-\u0D83]?\\|"
44 ;; any other singleton characters 44 ;; any other singleton characters
45 "[\u0D80-\u0DFF]") 45 "[\u0D80-\u0DFF]")
46 0 'font-shape-gstring))) 46 0 #'font-shape-gstring)))
47 47
48;; sinhala.el ends here 48;; sinhala.el ends here
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index 17abf136f7f..4549b111a3d 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -30,7 +30,7 @@
30 30
31(set-char-table-range composition-function-table 31(set-char-table-range composition-function-table
32 '(#xAA80 . #xAADF) 32 '(#xAA80 . #xAADF)
33 'tai-viet-composition-function) 33 #'tai-viet-composition-function)
34 34
35(set-language-info-alist 35(set-language-info-alist
36 "TaiViet" '((charset unicode) 36 "TaiViet" '((charset unicode)
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index f9c57e8ca83..e11a05445c7 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,4 +1,4 @@
1;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*- 1;;; thai-util.el --- utilities for Thai -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2000-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -232,10 +232,10 @@ positions (integers or markers) specifying the region."
232 (let ((glyph-len (lgstring-glyph-len gstring)) 232 (let ((glyph-len (lgstring-glyph-len gstring))
233 (last-char (lgstring-char gstring 233 (last-char (lgstring-char gstring
234 (1- (lgstring-char-len gstring)))) 234 (1- (lgstring-char-len gstring))))
235 (i 0) 235 (i 0)) ;; glyph
236 glyph)
237 (while (and (< i glyph-len) 236 (while (and (< i glyph-len)
238 (setq glyph (lgstring-glyph gstring i))) 237 ;; (setq glyph
238 (lgstring-glyph gstring i)) ;; )
239 (setq i (1+ i))) 239 (setq i (1+ i)))
240 (if (= last-char ?ำ) 240 (if (= last-char ?ำ)
241 (setq i (1- i))) 241 (setq i (1- i)))
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index 94c6ab98979..ff1e80298ba 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -1,4 +1,4 @@
1;;; thai-word.el -- find Thai word boundaries 1;;; thai-word.el -- find Thai word boundaries -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4;; National Institute of Advanced Industrial Science and Technology (AIST) 4;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -10973,8 +10973,7 @@ If COUNT is negative, move point backward (- COUNT) words."
10973 ;; special instead of using forward-word. 10973 ;; special instead of using forward-word.
10974 (let ((start (point)) 10974 (let ((start (point))
10975 (limit (match-end 0)) 10975 (limit (match-end 0))
10976 boundaries 10976 boundaries) ;; tail
10977 tail)
10978 ;; If thai-forward-word has been called within a Thai 10977 ;; If thai-forward-word has been called within a Thai
10979 ;; region, we must go back until the Thai region starts 10978 ;; region, we must go back until the Thai region starts
10980 ;; to do the contextual analysis for finding word 10979 ;; to do the contextual analysis for finding word
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index e741af18740..ddf4a0c0fb1 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -1,4 +1,4 @@
1;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*- 1;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -126,42 +126,42 @@ The returned string has no composition information."
126 (setq t-str-list (cons (substring str idx) t-str-list))) 126 (setq t-str-list (cons (substring str idx) t-str-list)))
127 (apply 'concat (nreverse t-str-list)))) 127 (apply 'concat (nreverse t-str-list))))
128 128
129;;; 129;;
130;;; Functions for composing/decomposing Tibetan sequence. 130;;; Functions for composing/decomposing Tibetan sequence.
131;;; 131;;
132;;; A Tibetan syllable is typically structured as follows: 132;; A Tibetan syllable is typically structured as follows:
133;;; 133;;
134;;; [Prefix] C [C+] V [M] [Suffix [Post suffix]] 134;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
135;;; 135;;
136;;; where C's are all vertically stacked, V appears below or above 136;; where C's are all vertically stacked, V appears below or above
137;;; consonant cluster and M is always put above the C[C+]V combination. 137;; consonant cluster and M is always put above the C[C+]V combination.
138;;; (Sanskrit visarga, though it is a vowel modifier, is considered 138;; (Sanskrit visarga, though it is a vowel modifier, is considered
139;;; to be a punctuation.) 139;; to be a punctuation.)
140;;; 140;;
141;;; Here are examples of the words "bsgrubs" and "hfauM" 141;; Here are examples of the words "bsgrubs" and "hfauM"
142;;; 142;;
143;;; བསྒྲུབས ཧཱུཾ 143;; བསྒྲུབས ཧཱུཾ
144;;; 144;;
145;;; M 145;; M
146;;; b s b s h 146;; b s b s h
147;;; g fa 147;; g fa
148;;; r u 148;; r u
149;;; u 149;; u
150;;; 150;;
151;;; Consonants `'' (འ), `w' (à½), `y' (ཡ), `r' (ར) take special 151;; Consonants `'' (འ), `w' (à½), `y' (ཡ), `r' (ར) take special
152;;; forms when they are used as subjoined consonant. Consonant `r' 152;; forms when they are used as subjoined consonant. Consonant `r'
153;;; takes another special form when used as superjoined in such a case 153;; takes another special form when used as superjoined in such a case
154;;; as "rka", while it does not change its form when conjoined with 154;; as "rka", while it does not change its form when conjoined with
155;;; subjoined `'', `w' or `y' as in "rwa", "rya". 155;; subjoined `'', `w' or `y' as in "rwa", "rya".
156 156
157;; Append a proper composition rule and glyph to COMPONENTS to compose 157; Append a proper composition rule and glyph to COMPONENTS to compose
158;; CHAR with a composition that has COMPONENTS. 158; CHAR with a composition that has COMPONENTS.
159 159
160(defun tibetan-add-components (components char) 160(defun tibetan-add-components (components char)
161 (let ((last (last components)) 161 (let ((last (last components))
162 (stack-upper '(tc . bc)) 162 (stack-upper '(tc . bc))
163 (stack-under '(bc . tc)) 163 (stack-under '(bc . tc))
164 rule comp-vowel tmp) 164 rule comp-vowel)
165 ;; Special treatment for 'a chung. 165 ;; Special treatment for 'a chung.
166 ;; If 'a follows a consonant, turn it into the subjoined form. 166 ;; If 'a follows a consonant, turn it into the subjoined form.
167 ;; * Disabled by Tomabechi 2000/06/09 * 167 ;; * Disabled by Tomabechi 2000/06/09 *
@@ -246,7 +246,7 @@ The returned string has no composition information."
246(defun tibetan-compose-region (beg end) 246(defun tibetan-compose-region (beg end)
247 "Compose Tibetan text the region BEG and END." 247 "Compose Tibetan text the region BEG and END."
248 (interactive "r") 248 (interactive "r")
249 (let (str result chars) 249 ;; (let (str result chars)
250 (save-excursion 250 (save-excursion
251 (save-restriction 251 (save-restriction
252 (narrow-to-region beg end) 252 (narrow-to-region beg end)
@@ -272,7 +272,7 @@ The returned string has no composition information."
272 (while (< (point) to) 272 (while (< (point) to)
273 (tibetan-add-components components (following-char)) 273 (tibetan-add-components components (following-char))
274 (forward-char 1)) 274 (forward-char 1))
275 (compose-region from to components))))))) 275 (compose-region from to components)))))) ;; )
276 276
277(defvar tibetan-decompose-precomposition-alist 277(defvar tibetan-decompose-precomposition-alist
278 (mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x))) 278 (mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x)))
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index edd9d765b1e..48c7638948c 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -605,7 +605,7 @@ This also matches some punctuation characters which need conversion.")
605;; For automatic composition. 605;; For automatic composition.
606(set-char-table-range 606(set-char-table-range
607 composition-function-table '(#xF00 . #xFD1) 607 composition-function-table '(#xF00 . #xFD1)
608 (list (vector tibetan-composable-pattern 0 'font-shape-gstring))) 608 (list (vector tibetan-composable-pattern 0 #'font-shape-gstring)))
609 609
610(provide 'tibetan) 610(provide 'tibetan)
611 611
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index 7ce8ee1e500..1a530d350f2 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -1,4 +1,4 @@
1;;; tv-util.el --- support for Tai Viet -*- coding: utf-8 -*- 1;;; tv-util.el --- support for Tai Viet -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2007, 2008, 2009, 2010, 2011 3;; Copyright (C) 2007, 2008, 2009, 2010, 2011
4;; National Institute of Advanced Industrial Science and Technology (AIST) 4;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -128,7 +128,7 @@
128 128
129 129
130;;;###autoload 130;;;###autoload
131(defun tai-viet-composition-function (from to font-object string _direction) 131(defun tai-viet-composition-function (from _to _font-object string _direction)
132 (if string 132 (if string
133 (if (string-match tai-viet-re string from) 133 (if (string-match tai-viet-re string from)
134 (tai-viet-compose-string from (match-end 0) string)) 134 (tai-viet-compose-string from (match-end 0) string))
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index 177b04bc473..bfaf0f3b94a 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -1,4 +1,4 @@
1;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*- 1;;; viet-util.el --- utilities for Vietnamese -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
4;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 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 f7ac83aec5b..264a9b479b3 100644
--- a/lisp/leim/quail/compose.el
+++ b/lisp/leim/quail/compose.el
@@ -1,4 +1,4 @@
1;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8;-*- 1;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8; lexical-binding: t -*-
2 2
3;; Copyright (C) 2020-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/leim/quail/viqr.el b/lisp/leim/quail/viqr.el
index b7591b15e05..d127ff247cf 100644
--- a/lisp/leim/quail/viqr.el
+++ b/lisp/leim/quail/viqr.el
@@ -1,4 +1,4 @@
1;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8;-*- 1;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8; lexical-binding: t -*-
2 2
3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 3;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
4;; 2006, 2007, 2008, 2009, 2010, 2011 4;; 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 29460cc20f5..9f95b62d870 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -2723,6 +2723,12 @@ See also `unrmail-mbox-format'."
2723 :version "24.4" 2723 :version "24.4"
2724 :group 'rmail-files) 2724 :group 'rmail-files)
2725 2725
2726(defcustom rmail-show-message-set-modified nil
2727 "If non-nil, displaying an unseen message marks the Rmail buffer as modified."
2728 :type 'boolean
2729 :group 'rmail
2730 :version "28.1")
2731
2726(defun rmail-show-message-1 (&optional msg) 2732(defun rmail-show-message-1 (&optional msg)
2727 "Show message MSG (default: current message) using `rmail-view-buffer'. 2733 "Show message MSG (default: current message) using `rmail-view-buffer'.
2728Return text to display in the minibuffer if MSG is out of 2734Return text to display in the minibuffer if MSG is out of
@@ -2750,6 +2756,8 @@ The current mail message becomes the message displayed."
2750 ;; Mark the message as seen, but preserve buffer modified flag. 2756 ;; Mark the message as seen, but preserve buffer modified flag.
2751 (let ((modiff (buffer-modified-p))) 2757 (let ((modiff (buffer-modified-p)))
2752 (rmail-set-attribute rmail-unseen-attr-index nil) 2758 (rmail-set-attribute rmail-unseen-attr-index nil)
2759 (and rmail-show-message-set-modified
2760 (setq modiff t))
2753 (unless modiff 2761 (unless modiff
2754 (restore-buffer-modified-p modiff))) 2762 (restore-buffer-modified-p modiff)))
2755 ;; bracket the message in the mail 2763 ;; bracket the message in the mail
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index d29115a9570..7f99ecdcf2c 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -974,8 +974,9 @@ a negative argument means to delete and move forward."
974 (delete-char 1) 974 (delete-char 1)
975 (insert "D")) 975 (insert "D"))
976 ;; Discard cached new summary line. 976 ;; Discard cached new summary line.
977 (with-current-buffer rmail-buffer 977 (when n
978 (aset rmail-summary-vector (1- n) nil)))) 978 (with-current-buffer rmail-buffer
979 (aset rmail-summary-vector (1- n) nil)))))
979 (beginning-of-line)) 980 (beginning-of-line))
980 981
981(defun rmail-summary-update-line (n) 982(defun rmail-summary-update-line (n)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 9f6fd6de224..d2601c35e8d 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
104(defcustom mail-self-blind nil 104(defcustom mail-self-blind nil
105 "Non-nil means insert Bcc to self in messages to be sent. 105 "Non-nil means insert Bcc to self in messages to be sent.
106This is done when the message is initialized, 106This is done when the message is initialized,
107so you can remove or alter the Bcc field to override the default." 107so you can remove or alter the Bcc field to override the default.
108If you are using `message-mode' to compose messages, customize the
109variable `message-default-mail-headers' instead."
108 :type 'boolean) 110 :type 'boolean)
109 111
110;;;###autoload 112;;;###autoload
@@ -172,14 +174,18 @@ This is used by the default mail-sending commands. See also
172(defcustom mail-archive-file-name nil 174(defcustom mail-archive-file-name nil
173 "Name of file to write all outgoing messages in, or nil for none. 175 "Name of file to write all outgoing messages in, or nil for none.
174This is normally an mbox file, but for backwards compatibility may also 176This is normally an mbox file, but for backwards compatibility may also
175be a Babyl file." 177be a Babyl file.
178If you are using `message-mode' to compose messages, customize the
179variable `message-default-mail-headers' instead."
176 :type '(choice file (const nil))) 180 :type '(choice file (const nil)))
177 181
178;;;###autoload 182;;;###autoload
179(defcustom mail-default-reply-to nil 183(defcustom mail-default-reply-to nil
180 "Address to insert as default Reply-To field of outgoing messages. 184 "Address to insert as default Reply-To field of outgoing messages.
181If nil, it will be initialized from the REPLYTO environment variable 185If nil, it will be initialized from the REPLYTO environment variable
182when you first send mail." 186when you first send mail.
187If you are using `message-mode' to compose messages, customize the
188variable `message-default-mail-headers' instead."
183 :type '(choice (const nil) string)) 189 :type '(choice (const nil) string))
184 190
185(defcustom mail-alias-file nil 191(defcustom mail-alias-file nil
@@ -388,7 +394,9 @@ in `message-auto-save-directory'."
388(defcustom mail-default-headers nil 394(defcustom mail-default-headers nil
389 "A string containing header lines, to be inserted in outgoing messages. 395 "A string containing header lines, to be inserted in outgoing messages.
390It can contain newlines, and should end in one. It is inserted 396It can contain newlines, and should end in one. It is inserted
391before you edit the message, so you can edit or delete the lines." 397before you edit the message, so you can edit or delete the lines.
398If you are using `message-mode' to compose messages, customize the
399variable `message-default-mail-headers' instead."
392 :type '(choice (const nil) string)) 400 :type '(choice (const nil) string))
393 401
394(defcustom mail-bury-selects-summary t 402(defcustom mail-bury-selects-summary t
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 9559b125135..fa13dd57d1d 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.")
2547FILE is the full name of the remote file, LSARGS is any args to pass to the 2547FILE is the full name of the remote file, LSARGS is any args to pass to the
2548`ls' command, and PARSE specifies that the output should be parsed and stored 2548`ls' command, and PARSE specifies that the output should be parsed and stored
2549away in the internal cache." 2549away in the internal cache."
2550 (when (string-match "^--dired\\s-+" lsargs) 2550 (while (string-match "^--dired\\s-+" lsargs)
2551 (setq lsargs (replace-match "" nil t lsargs))) 2551 (setq lsargs (replace-match "" nil t lsargs)))
2552 ;; If parse is t, we assume that file is a directory. i.e. we only parse 2552 ;; If parse is t, we assume that file is a directory. i.e. we only parse
2553 ;; full directory listings. 2553 ;; full directory listings.
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 7a7bbef5364..195ddc6bbac 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
2079has been handled by this function." 2079has been handled by this function."
2080 (with-current-buffer (get-buffer-create "*D-Bus Monitor*") 2080 (with-current-buffer (get-buffer-create "*D-Bus Monitor*")
2081 (special-mode) 2081 (special-mode)
2082 (buffer-disable-undo)
2082 ;; Move forward and backward between messages. 2083 ;; Move forward and backward between messages.
2083 (local-set-key [?n] #'forward-paragraph) 2084 (local-set-key [?n] #'forward-paragraph)
2084 (local-set-key [?p] #'backward-paragraph) 2085 (local-set-key [?p] #'backward-paragraph)
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index bc2612d9452..4022a35b391 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,4 +1,4 @@
1;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework 1;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index efc8f82890c..5afc195d4b4 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,4 +1,4 @@
1;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework 1;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index 66582265615..dfb7e713302 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,4 +1,4 @@
1;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework 1;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
4 4
@@ -40,7 +40,7 @@
40 "A list of functions to be called in sequence for the NTLM 40 "A list of functions to be called in sequence for the NTLM
41authentication steps. They are called by `sasl-next-step'.") 41authentication steps. They are called by `sasl-next-step'.")
42 42
43(defun sasl-ntlm-request (client step) 43(defun sasl-ntlm-request (client _step)
44 "SASL step function to generate a NTLM authentication request to the server. 44 "SASL step function to generate a NTLM authentication request to the server.
45Called from `sasl-next-step'. 45Called from `sasl-next-step'.
46CLIENT is a vector [mechanism user service server sasl-client-properties] 46CLIENT is a vector [mechanism user service server sasl-client-properties]
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 7f0431afb60..b7f814f7237 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,4 +1,4 @@
1;;; sasl.el --- SASL client framework 1;;; sasl.el --- SASL client framework -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
4 4
@@ -161,15 +161,8 @@ the current challenge. At the first time STEP should be set to nil."
161 (if function 161 (if function
162 (vector function (funcall function client step))))) 162 (vector function (funcall function client step)))))
163 163
164(defvar sasl-read-passphrase nil) 164(defvar sasl-read-passphrase 'read-passwd)
165(defun sasl-read-passphrase (prompt) 165(defun sasl-read-passphrase (prompt)
166 (if (not sasl-read-passphrase)
167 (if (functionp 'read-passwd)
168 (setq sasl-read-passphrase 'read-passwd)
169 (if (load "passwd" t)
170 (setq sasl-read-passphrase 'read-passwd)
171 (autoload 'ange-ftp-read-passwd "ange-ftp")
172 (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
173 (funcall sasl-read-passphrase prompt)) 166 (funcall sasl-read-passphrase prompt))
174 167
175(defun sasl-unique-id () 168(defun sasl-unique-id ()
@@ -210,7 +203,7 @@ It contain at least 64 bits of entropy."
210(defconst sasl-plain-steps 203(defconst sasl-plain-steps
211 '(sasl-plain-response)) 204 '(sasl-plain-response))
212 205
213(defun sasl-plain-response (client step) 206(defun sasl-plain-response (client _step)
214 (let ((passphrase 207 (let ((passphrase
215 (sasl-read-passphrase 208 (sasl-read-passphrase
216 (format "PLAIN passphrase for %s: " (sasl-client-name client)))) 209 (format "PLAIN passphrase for %s: " (sasl-client-name client))))
@@ -236,12 +229,12 @@ It contain at least 64 bits of entropy."
236 sasl-login-response-1 229 sasl-login-response-1
237 sasl-login-response-2)) 230 sasl-login-response-2))
238 231
239(defun sasl-login-response-1 (client step) 232(defun sasl-login-response-1 (client _step)
240;;; (unless (string-match "^Username:" (sasl-step-data step)) 233;;; (unless (string-match "^Username:" (sasl-step-data step))
241;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) 234;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
242 (sasl-client-name client)) 235 (sasl-client-name client))
243 236
244(defun sasl-login-response-2 (client step) 237(defun sasl-login-response-2 (client _step)
245;;; (unless (string-match "^Password:" (sasl-step-data step)) 238;;; (unless (string-match "^Password:" (sasl-step-data step))
246;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) 239;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
247 (sasl-read-passphrase 240 (sasl-read-passphrase
@@ -257,7 +250,7 @@ It contain at least 64 bits of entropy."
257 '(ignore ;no initial response 250 '(ignore ;no initial response
258 sasl-anonymous-response)) 251 sasl-anonymous-response))
259 252
260(defun sasl-anonymous-response (client step) 253(defun sasl-anonymous-response (client _step)
261 (or (sasl-client-property client 'trace) 254 (or (sasl-client-property client 'trace)
262 (sasl-client-name client))) 255 (sasl-client-name client)))
263 256
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index fbc4e75fae5..7bc1d16122d 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -128,6 +128,9 @@
128 (modify-syntax-entry ?| "." st) 128 (modify-syntax-entry ?| "." st)
129 (modify-syntax-entry ?_ "_" st) 129 (modify-syntax-entry ?_ "_" st)
130 (modify-syntax-entry ?\' "\"" st) 130 (modify-syntax-entry ?\' "\"" st)
131 (modify-syntax-entry ?\{ "(}" st)
132 (modify-syntax-entry ?\} "){" st)
133 (modify-syntax-entry ?\" "\"" st)
131 st) 134 st)
132 "Syntax table in use in sieve-mode buffers.") 135 "Syntax table in use in sieve-mode buffers.")
133 136
@@ -178,12 +181,8 @@
178 'syntax-table (string-to-syntax "|"))))) 181 'syntax-table (string-to-syntax "|")))))
179 182
180;;;###autoload 183;;;###autoload
181(define-derived-mode sieve-mode c-mode "Sieve" 184(define-derived-mode sieve-mode prog-mode "Sieve"
182 "Major mode for editing Sieve code. 185 "Major mode for editing Sieve code.
183This is much like C mode except for the syntax of comments. Its keymap
184inherits from C mode's and it has the same variables for customizing
185indentation. It has its own abbrev table and its own syntax table.
186
187Turning on Sieve mode runs `sieve-mode-hook'." 186Turning on Sieve mode runs `sieve-mode-hook'."
188 (setq-local paragraph-start (concat "$\\|" page-delimiter)) 187 (setq-local paragraph-start (concat "$\\|" page-delimiter))
189 (setq-local paragraph-separate paragraph-start) 188 (setq-local paragraph-separate paragraph-start)
@@ -194,8 +193,17 @@ Turning on Sieve mode runs `sieve-mode-hook'."
194 (setq-local syntax-propertize-function #'sieve-syntax-propertize) 193 (setq-local syntax-propertize-function #'sieve-syntax-propertize)
195 (setq-local font-lock-defaults 194 (setq-local font-lock-defaults
196 '(sieve-font-lock-keywords nil nil ((?_ . "w")))) 195 '(sieve-font-lock-keywords nil nil ((?_ . "w"))))
196 (setq-local indent-line-function #'sieve-mode-indent-function)
197 (easy-menu-add-item nil nil sieve-mode-menu)) 197 (easy-menu-add-item nil nil sieve-mode-menu))
198 198
199(defun sieve-mode-indent-function ()
200 (save-excursion
201 (beginning-of-line)
202 (let ((depth (car (syntax-ppss))))
203 (when (looking-at "[ \t]*}")
204 (setq depth (1- depth)))
205 (indent-line-to (* 2 depth)))))
206
199(provide 'sieve-mode) 207(provide 'sieve-mode)
200 208
201;; sieve-mode.el ends here 209;; sieve-mode.el ends here
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2c4ef2acaef..73dffe1d64f 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."
636 (copy-directory filename newname keep-date t) 636 (copy-directory filename newname keep-date t)
637 637
638 (let ((t1 (tramp-tramp-file-p filename)) 638 (let ((t1 (tramp-tramp-file-p filename))
639 (t2 (tramp-tramp-file-p newname))) 639 (t2 (tramp-tramp-file-p newname))
640 ;; We don't want the target file to be compressed, so we
641 ;; let-bind `jka-compr-inhibit' to t.
642 (jka-compr-inhibit t))
640 (with-parsed-tramp-file-name (if t1 filename newname) nil 643 (with-parsed-tramp-file-name (if t1 filename newname) nil
641 (unless (file-exists-p filename) 644 (unless (file-exists-p filename)
642 (tramp-error 645 (tramp-error
@@ -717,7 +720,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
717 (delete-directory filename 'recursive)) 720 (delete-directory filename 'recursive))
718 721
719 (let ((t1 (tramp-tramp-file-p filename)) 722 (let ((t1 (tramp-tramp-file-p filename))
720 (t2 (tramp-tramp-file-p newname))) 723 (t2 (tramp-tramp-file-p newname))
724 ;; We don't want the target file to be compressed, so we
725 ;; let-bind `jka-compr-inhibit' to t.
726 (jka-compr-inhibit t))
721 (with-parsed-tramp-file-name (if t1 filename newname) nil 727 (with-parsed-tramp-file-name (if t1 filename newname) nil
722 (unless (file-exists-p filename) 728 (unless (file-exists-p filename)
723 (tramp-error 729 (tramp-error
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index ed3d15377c3..2274efdf8b5 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1708,6 +1708,12 @@ ID-FORMAT valid values are `string' and `integer'."
1708 (= (tramp-compat-file-attribute-user-id attributes) 1708 (= (tramp-compat-file-attribute-user-id attributes)
1709 (tramp-get-remote-uid v 'integer)) 1709 (tramp-get-remote-uid v 'integer))
1710 (or (not group) 1710 (or (not group)
1711 ;; On BSD-derived systems files always inherit the
1712 ;; parent directory's group, so skip the group-gid
1713 ;; test.
1714 (string-match-p
1715 "BSD\\|DragonFly\\|Darwin"
1716 (tramp-get-connection-property v "uname" ""))
1711 (= (tramp-compat-file-attribute-group-id attributes) 1717 (= (tramp-compat-file-attribute-group-id attributes)
1712 (tramp-get-remote-gid v 'integer))))))))) 1718 (tramp-get-remote-gid v 'integer)))))))))
1713 1719
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index e5941ae652e..1fa625c3245 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -96,9 +96,6 @@
96 ("DuckDuckGo" . 96 ("DuckDuckGo" .
97 [simple-query "duckduckgo.com" 97 [simple-query "duckduckgo.com"
98 "duckduckgo.com/?q=" ""]) 98 "duckduckgo.com/?q=" ""])
99 ("Google" .
100 [simple-query "www.google.com"
101 "www.google.com/search?q=" ""])
102 ("Google Groups" . 99 ("Google Groups" .
103 [simple-query "groups.google.com" 100 [simple-query "groups.google.com"
104 "groups.google.com/groups?q=" ""]) 101 "groups.google.com/groups?q=" ""])
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 5d0d1053f4b..ea47eec4fda 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."
832 (when (and (stringp str) (string-match "\\S-" str)) 832 (when (and (stringp str) (string-match "\\S-" str))
833 ;; Separate the actual string from any leading/trailing padding 833 ;; Separate the actual string from any leading/trailing padding
834 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str) 834 (string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
835 (let ((s (match-string 1 str)) ;actual string 835 (let ((s (match-string 1 str)) ;actual string
836 (lpad (substring str 0 (match-beginning 1))) ;left padding 836 (lpad (substring str 0 (match-beginning 1))) ;left padding
837 (rpad (concat (substring str (match-end 1)) ;original right padding 837 (rpad (concat
838 (substring comment-padding ;additional right padding 838 (substring str (match-end 1)) ;original right padding
839 (min (- (match-end 0) (match-end 1)) 839 (if (numberp comment-padding)
840 (length comment-padding))))) 840 (make-string (min comment-padding
841 (- (match-end 0) (match-end 1)))
842 ?\s)
843 (substring comment-padding ;additional right padding
844 (min (- (match-end 0) (match-end 1))
845 (length comment-padding))))))
841 ;; We can only duplicate C if the comment-end has multiple chars 846 ;; We can only duplicate C if the comment-end has multiple chars
842 ;; or if comments can be nested, else the comment-end `}' would 847 ;; or if comments can be nested, else the comment-end `}' would
843 ;; be turned into `}}}' where only the first ends the comment 848 ;; 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."
852 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?")) 857 (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
853 lpad "") ;padding is not required 858 lpad "") ;padding is not required
854 (regexp-quote s) 859 (regexp-quote s)
855 (when multi "+") ;the last char of S might be repeated 860 (when multi "+") ;the last char of S might be repeated
856 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?")) 861 (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
857 rpad "")))))) ;padding is not required 862 rpad "")))))) ;padding is not required
858 863
@@ -1221,21 +1226,33 @@ changed with `comment-style'."
1221 ;; FIXME: maybe we should call uncomment depending on ARG. 1226 ;; FIXME: maybe we should call uncomment depending on ARG.
1222 (funcall comment-region-function beg end arg))) 1227 (funcall comment-region-function beg end arg)))
1223 1228
1224(defun comment-region-default-1 (beg end &optional arg) 1229(defun comment-region-default-1 (beg end &optional arg noadjust)
1230 "Comment region between BEG and END.
1231See `comment-region' for ARG. If NOADJUST, do not skip past
1232leading/trailing space when determining the region to comment
1233out."
1225 (let* ((numarg (prefix-numeric-value arg)) 1234 (let* ((numarg (prefix-numeric-value arg))
1226 (style (cdr (assoc comment-style comment-styles))) 1235 (style (cdr (assoc comment-style comment-styles)))
1227 (lines (nth 2 style)) 1236 (lines (nth 2 style))
1228 (block (nth 1 style)) 1237 (block (nth 1 style))
1229 (multi (nth 0 style))) 1238 (multi (nth 0 style)))
1230 1239
1231 ;; We use `chars' instead of `syntax' because `\n' might be 1240 (if noadjust
1232 ;; of end-comment syntax rather than of whitespace syntax. 1241 (when (bolp)
1233 ;; sanitize BEG and END 1242 (setq end (1- end)))
1234 (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) 1243 ;; We use `chars' instead of `syntax' because `\n' might be
1235 (setq beg (max beg (point))) 1244 ;; of end-comment syntax rather than of whitespace syntax.
1236 (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) 1245 ;; sanitize BEG and END
1237 (setq end (min end (point))) 1246 (goto-char beg)
1238 (if (>= beg end) (error "Nothing to comment")) 1247 (skip-chars-forward " \t\n\r")
1248 (beginning-of-line)
1249 (setq beg (max beg (point)))
1250 (goto-char end)
1251 (skip-chars-backward " \t\n\r")
1252 (end-of-line)
1253 (setq end (min end (point)))
1254 (when (>= beg end)
1255 (error "Nothing to comment")))
1239 1256
1240 ;; sanitize LINES 1257 ;; sanitize LINES
1241 (setq lines 1258 (setq lines
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 59465c371eb..a20e95086cb 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,4 +1,4 @@
1;;; rng-util.el --- utility functions for RELAX NG library 1;;; rng-util.el --- utility functions for RELAX NG library -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 0b7d1e454c3..147efed0057 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.")
504 ,@(mapcar (lambda (elem) (list 'const (car elem))) 504 ,@(mapcar (lambda (elem) (list 'const (car elem)))
505 nnir-engines))))) 505 nnir-engines)))))
506 506
507
507(defmacro nnir-add-result (dirnam artno score prefix server artlist) 508(defmacro nnir-add-result (dirnam artno score prefix server artlist)
508 "Construct a result vector and add it to ARTLIST. 509 "Construct a result vector and add it to ARTLIST.
509DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to 510DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index d1db1683bbe..994e30f4f43 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -376,9 +376,9 @@ changes to the current buffer."
376 376
377Shell links can be dangerous: just think about a link 377Shell links can be dangerous: just think about a link
378 378
379 [[shell:rm -rf ~/*][Google Search]] 379 [[shell:rm -rf ~/*][Web Search]]
380 380
381This link would show up in your Org document as \"Google Search\", 381This link would show up in your Org document as \"Web Search\",
382but really it would remove your entire home directory. 382but really it would remove your entire home directory.
383Therefore we advise against setting this variable to nil. 383Therefore we advise against setting this variable to nil.
384Just change it to `y-or-n-p' if you want to confirm with a 384Just 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\"."
401 "Non-nil means ask for confirmation before executing Emacs Lisp links. 401 "Non-nil means ask for confirmation before executing Emacs Lisp links.
402Elisp links can be dangerous: just think about a link 402Elisp links can be dangerous: just think about a link
403 403
404 [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] 404 [[elisp:(shell-command \"rm -rf ~/*\")][Web Search]]
405 405
406This link would show up in your Org document as \"Google Search\", 406This link would show up in your Org document as \"Web Search\",
407but really it would remove your entire home directory. 407but really it would remove your entire home directory.
408Therefore we advise against setting this variable to nil. 408Therefore we advise against setting this variable to nil.
409Just change it to `y-or-n-p' if you want to confirm with a 409Just 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 43aa0a178a9..2d21a44fb48 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1846,7 +1846,7 @@ link types. The types are:
1846bracket The recommended [[link][description]] or [[link]] links with hiding. 1846bracket The recommended [[link][description]] or [[link]] links with hiding.
1847angle Links in angular brackets that may contain whitespace like 1847angle Links in angular brackets that may contain whitespace like
1848 <bbdb:Carsten Dominik>. 1848 <bbdb:Carsten Dominik>.
1849plain Plain links in normal text, no whitespace, like http://google.com. 1849plain Plain links in normal text, no whitespace, like https://gnu.org.
1850radio Text that is matched by a radio target, see manual for details. 1850radio Text that is matched by a radio target, see manual for details.
1851tag Tag settings in a headline (link to tag search). 1851tag Tag settings in a headline (link to tag search).
1852date Time stamps (link to calendar). 1852date Time stamps (link to calendar).
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 7ad3de6fb64..98da26c2e6c 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,8 +1,9 @@
1;;; handwrite.el --- turns your emacs buffer into a handwritten document 1;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
4 4
5;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>) 5;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
6;; Maintainer: emacs-devel@gnu.org
6;; Created: October 21 1996 7;; Created: October 21 1996
7;; Keywords: wp, print, postscript, cursive writing 8;; Keywords: wp, print, postscript, cursive writing
8 9
@@ -22,11 +23,11 @@
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23 24
24;;; Commentary: 25;;; Commentary:
26
27;; The function `handwrite' creates PostScript output containing a
28;; handwritten version of the current buffer.
25;; 29;;
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30;; Other functions that may be useful are:
27;; The function handwrite creates PostScript output containing a
28;; handwritten version of the current buffer..
29;; Other functions that may be useful are
30;; 31;;
31;; handwrite-10pt: sets the font size to 10 and finds corresponding 32;; handwrite-10pt: sets the font size to 10 and finds corresponding
32;; values for the line spacing and the number of lines 33;; values for the line spacing and the number of lines
@@ -54,8 +55,6 @@
54;; unknown characters. 55;; unknown characters.
55;; 56;;
56;; Thanks to anyone who emailed me suggestions! 57;; Thanks to anyone who emailed me suggestions!
57;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58
59 58
60;;; Code: 59;;; Code:
61 60
@@ -64,7 +63,6 @@
64(defvar ps-lpr-command) 63(defvar ps-lpr-command)
65(defvar ps-lpr-switches) 64(defvar ps-lpr-switches)
66 65
67
68;; Variables 66;; Variables
69 67
70(defgroup handwrite nil 68(defgroup handwrite nil
@@ -98,44 +96,43 @@
98 96
99(defcustom handwrite-numlines 60 97(defcustom handwrite-numlines 60
100 "The number of lines on a page of the PostScript output from `handwrite'." 98 "The number of lines on a page of the PostScript output from `handwrite'."
101 :type 'integer 99 :type 'integer)
102 :group 'handwrite) 100
103(defcustom handwrite-fontsize 11 101(defcustom handwrite-fontsize 11
104 "The size of the font for the PostScript output from `handwrite'." 102 "The size of the font for the PostScript output from `handwrite'."
105 :type 'integer 103 :type 'integer)
106 :group 'handwrite) 104
107(defcustom handwrite-linespace 12 105(defcustom handwrite-linespace 12
108 "The spacing for the PostScript output from `handwrite'." 106 "The spacing for the PostScript output from `handwrite'."
109 :type 'integer 107 :type 'integer)
110 :group 'handwrite) 108
111(defcustom handwrite-xstart 30 109(defcustom handwrite-xstart 30
112 "X-axis translation in the PostScript output from `handwrite'." 110 "X-axis translation in the PostScript output from `handwrite'."
113 :type 'integer 111 :type 'integer)
114 :group 'handwrite) 112
115(defcustom handwrite-ystart 810 113(defcustom handwrite-ystart 810
116 "Y-axis translation in the PostScript output from `handwrite'." 114 "Y-axis translation in the PostScript output from `handwrite'."
117 :type 'integer 115 :type 'integer)
118 :group 'handwrite) 116
119(defcustom handwrite-pagenumbering nil 117(defcustom handwrite-pagenumbering nil
120 "If non-nil, number each page of the PostScript output from `handwrite'." 118 "If non-nil, number each page of the PostScript output from `handwrite'."
121 :type 'boolean 119 :type 'boolean)
122 :group 'handwrite) 120
123(defcustom handwrite-10pt-numlines 65 121(defcustom handwrite-10pt-numlines 65
124 "The number of lines on a page for the function `handwrite-10pt'." 122 "The number of lines on a page for the function `handwrite-10pt'."
125 :type 'integer 123 :type 'integer)
126 :group 'handwrite) 124
127(defcustom handwrite-11pt-numlines 60 125(defcustom handwrite-11pt-numlines 60
128 "The number of lines on a page for the function `handwrite-11pt'." 126 "The number of lines on a page for the function `handwrite-11pt'."
129 :type 'integer 127 :type 'integer)
130 :group 'handwrite) 128
131(defcustom handwrite-12pt-numlines 55 129(defcustom handwrite-12pt-numlines 55
132 "The number of lines on a page for the function `handwrite-12pt'." 130 "The number of lines on a page for the function `handwrite-12pt'."
133 :type 'integer 131 :type 'integer)
134 :group 'handwrite) 132
135(defcustom handwrite-13pt-numlines 50 133(defcustom handwrite-13pt-numlines 50
136 "The number of lines on a page for the function `handwrite-13pt'." 134 "The number of lines on a page for the function `handwrite-13pt'."
137 :type 'integer 135 :type 'integer)
138 :group 'handwrite)
139 136
140;; Interactive functions 137;; Interactive functions
141 138
@@ -150,17 +147,17 @@ Variables: `handwrite-linespace' (default 12)
150 `handwrite-numlines' (default 60) 147 `handwrite-numlines' (default 60)
151 `handwrite-pagenumbering' (default nil)" 148 `handwrite-pagenumbering' (default nil)"
152 (interactive) 149 (interactive)
150 (setq handwrite-psindex (1+ handwrite-psindex))
153 (let 151 (let
154 (;(pmin) ; thanks, Havard 152 ((cur-buf (current-buffer))
155 (cur-buf (current-buffer))
156 (tpoint (point)) 153 (tpoint (point))
157 (ps-ypos 63) 154 (ps-ypos 63)
158 (lcount 0) 155 (lcount 0)
159 (ipage 1) 156 (ipage 1)
160 (nlan next-line-add-newlines) ;remember the old value 157 (next-line-add-newlines t)
161 (buf-name (buffer-name) ) 158 (buf-name (buffer-name) )
162 (textp) 159 (textp)
163 (ps-buf-name) ;name of the PostScript buffer 160 (ps-buf-name (format "*handwritten%d.ps*" handwrite-psindex))
164 (trans-table 161 (trans-table
165 '(("ÿ" . "264") ("á" . "207") ("à" . "210") ("â" . "211") 162 '(("ÿ" . "264") ("á" . "207") ("à" . "210") ("â" . "211")
166 ("ä" . "212") ("ã" . "213") ("å" . "214") ("é" . "216") 163 ("ä" . "212") ("ã" . "213") ("å" . "214") ("é" . "216")
@@ -175,10 +172,6 @@ Variables: `handwrite-linespace' (default 12)
175 ; on inserted backslashes 172 ; on inserted backslashes
176 line) 173 line)
177 (goto-char (point-min)) ;start at beginning 174 (goto-char (point-min)) ;start at beginning
178 (setq handwrite-psindex (1+ handwrite-psindex))
179 (setq ps-buf-name
180 (format "*handwritten%d.ps*" handwrite-psindex))
181 (setq next-line-add-newlines t)
182 (switch-to-buffer ps-buf-name) 175 (switch-to-buffer ps-buf-name)
183 (handwrite-insert-header buf-name) 176 (handwrite-insert-header buf-name)
184 (insert "%%Creator: GNU Emacs's handwrite version " emacs-version "\n") 177 (insert "%%Creator: GNU Emacs's handwrite version " emacs-version "\n")
@@ -258,9 +251,7 @@ Variables: `handwrite-linespace' (default 12)
258 (message "") 251 (message "")
259 (bury-buffer ()) 252 (bury-buffer ())
260 (switch-to-buffer cur-buf) 253 (switch-to-buffer cur-buf)
261 (goto-char tpoint) 254 (goto-char tpoint)))
262 (setq next-line-add-newlines nlan)
263 ))
264 255
265 256
266(defun handwrite-set-pagenumber () 257(defun handwrite-set-pagenumber ()
@@ -280,7 +271,6 @@ values for `handwrite-linespace' and `handwrite-numlines'."
280 (setq handwrite-numlines handwrite-10pt-numlines) 271 (setq handwrite-numlines handwrite-10pt-numlines)
281 (message "Handwrite output size set to 10 points")) 272 (message "Handwrite output size set to 10 points"))
282 273
283
284(defun handwrite-11pt () 274(defun handwrite-11pt ()
285 "Specify 11-point output for `handwrite'. 275 "Specify 11-point output for `handwrite'.
286This sets `handwrite-fontsize' to 11 and finds correct 276This sets `handwrite-fontsize' to 11 and finds correct
@@ -1238,28 +1228,16 @@ end
1238/Joepie Hwfdict definefont 1228/Joepie Hwfdict definefont
1239%%EndFont Joepie\n\n")) 1229%%EndFont Joepie\n\n"))
1240 1230
1241;;Sets page numbering off
1242(defun handwrite-set-pagenumber-off () 1231(defun handwrite-set-pagenumber-off ()
1232 "Set page numbering off."
1243 (setq handwrite-pagenumbering nil) 1233 (setq handwrite-pagenumbering nil)
1244 (message "page numbering off")) 1234 (message "page numbering off"))
1245 1235
1246;;Sets page numbering on
1247(defun handwrite-set-pagenumber-on () 1236(defun handwrite-set-pagenumber-on ()
1237 "Set page numbering on."
1248 (setq handwrite-pagenumbering t) 1238 (setq handwrite-pagenumbering t)
1249 (message "page numbering on" )) 1239 (message "page numbering on" ))
1250 1240
1251
1252;; Key bindings
1253
1254;; I'd rather not fill up the menu bar menus with
1255;; lots of random miscellaneous features. -- rms.
1256;;;(define-key-after
1257;;; (lookup-key global-map [menu-bar edit])
1258;;; [handwrite]
1259;;; '("Write by hand" . menu-bar-handwrite-map)
1260;;; 'spell)
1261
1262(provide 'handwrite) 1241(provide 'handwrite)
1263 1242
1264
1265;;; handwrite.el ends here 1243;;; handwrite.el ends here
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 7fff604aead..838bddfb665 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -1,4 +1,4 @@
1;;; mpuz.el --- multiplication puzzle for GNU Emacs 1;;; mpuz.el --- multiplication puzzle for GNU Emacs -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1990, 2001-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1990, 2001-2021 Free Software Foundation, Inc.
4 4
@@ -40,49 +40,41 @@
40The value t means never ding, and `error' means only ding on wrong input." 40The value t means never ding, and `error' means only ding on wrong input."
41 :type '(choice (const :tag "No" nil) 41 :type '(choice (const :tag "No" nil)
42 (const :tag "Yes" t) 42 (const :tag "Yes" t)
43 (const :tag "If correct" error)) 43 (const :tag "If correct" error)))
44 :group 'mpuz)
45 44
46(defcustom mpuz-solve-when-trivial t 45(defcustom mpuz-solve-when-trivial t
47 "Solve any row that can be trivially calculated from what you've found." 46 "Solve any row that can be trivially calculated from what you've found."
48 :type 'boolean 47 :type 'boolean)
49 :group 'mpuz)
50 48
51(defcustom mpuz-allow-double-multiplicator nil 49(defcustom mpuz-allow-double-multiplicator nil
52 "Allow 2nd factors like 33 or 77." 50 "Allow 2nd factors like 33 or 77."
53 :type 'boolean 51 :type 'boolean)
54 :group 'mpuz)
55 52
56(defface mpuz-unsolved 53(defface mpuz-unsolved
57 '((default :weight bold) 54 '((default :weight bold)
58 (((class color)) :foreground "red1")) 55 (((class color)) :foreground "red1"))
59 "Face for letters to be solved." 56 "Face for letters to be solved.")
60 :group 'mpuz)
61 57
62(defface mpuz-solved 58(defface mpuz-solved
63 '((default :weight bold) 59 '((default :weight bold)
64 (((class color)) :foreground "green1")) 60 (((class color)) :foreground "green1"))
65 "Face for solved digits." 61 "Face for solved digits.")
66 :group 'mpuz)
67 62
68(defface mpuz-trivial 63(defface mpuz-trivial
69 '((default :weight bold) 64 '((default :weight bold)
70 (((class color)) :foreground "blue")) 65 (((class color)) :foreground "blue"))
71 "Face for trivial digits solved for you." 66 "Face for trivial digits solved for you.")
72 :group 'mpuz)
73 67
74(defface mpuz-text 68(defface mpuz-text
75 '((t :inherit variable-pitch)) 69 '((t :inherit variable-pitch))
76 "Face for text on right." 70 "Face for text on right.")
77 :group 'mpuz)
78 71
79 72
80;; Mpuz mode and keymaps 73;; Mpuz mode and keymaps
81;;---------------------- 74;;----------------------
82(defcustom mpuz-mode-hook nil 75(defcustom mpuz-mode-hook nil
83 "Hook to run upon entry to mpuz." 76 "Hook to run upon entry to mpuz."
84 :type 'hook 77 :type 'hook)
85 :group 'mpuz)
86 78
87(defvar mpuz-mode-map 79(defvar mpuz-mode-map
88 (let ((map (make-sparse-keymap))) 80 (let ((map (make-sparse-keymap)))
@@ -341,8 +333,8 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
341 333
342(defun mpuz-switch-to-window () 334(defun mpuz-switch-to-window ()
343 "Find or create the Mult-Puzzle buffer, and display it." 335 "Find or create the Mult-Puzzle buffer, and display it."
344 (let ((buf (mpuz-get-buffer))) 336 (let ((buf (or (mpuz-get-buffer)
345 (or buf (setq buf (mpuz-create-buffer))) 337 (mpuz-create-buffer))))
346 (switch-to-buffer buf) 338 (switch-to-buffer buf)
347 (setq buffer-read-only t) 339 (setq buffer-read-only t)
348 (mpuz-mode))) 340 (mpuz-mode)))
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 62ff783fbac..99b2ec6d87e 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -141,8 +141,7 @@ Special commands:
141 (setq-local comment-add 1) 141 (setq-local comment-add 1)
142 (setq-local comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*") 142 (setq-local comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*")
143 (setq-local comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)") 143 (setq-local comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)")
144 (setq-local comment-end "") 144 (setq-local comment-end ""))
145 (setq fill-prefix "\t"))
146 145
147(defun asm-indent-line () 146(defun asm-indent-line ()
148 "Auto-indent the current line." 147 "Auto-indent the current line."
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 44295c3f679..7ba8a69775e 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -1,4 +1,4 @@
1;;; bat-mode.el --- Major mode for editing DOS/Windows scripts 1;;; bat-mode.el --- Major mode for editing DOS/Windows scripts -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2003, 2008-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2008-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 94e4f3c6fa7..2c1e6ff52ec 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."
3041 ;; Get the specified directory from FILE. 3041 ;; Get the specified directory from FILE.
3042 (spec-directory 3042 (spec-directory
3043 (if (cdr file) 3043 (if (cdr file)
3044 (file-truename (concat comint-file-name-prefix (cdr file)))))) 3044 ;; This function is active in `compilation-filter'.
3045 ;; There could be problems to call `file-truename'
3046 ;; for remote compilation processes.
3047 (if (file-remote-p default-directory)
3048 (concat comint-file-name-prefix (cdr file))
3049 (file-truename (concat comint-file-name-prefix (cdr file)))))))
3045 3050
3046 ;; Check for a comint-file-name-prefix and prepend it if appropriate. 3051 ;; Check for a comint-file-name-prefix and prepend it if appropriate.
3047 ;; (This is very useful for compilation-minor-mode in an rlogin-mode 3052 ;; (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 460af718aad..5d96c62b418 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -352,12 +352,20 @@ diagnostics at BEG."
352(flymake--diag-accessor flymake-diagnostic-data flymake--diag-data backend) 352(flymake--diag-accessor flymake-diagnostic-data flymake--diag-data backend)
353 353
354(defun flymake-diagnostic-beg (diag) 354(defun flymake-diagnostic-beg (diag)
355 "Get Flymake diagnostic DIAG's start position." 355 "Get Flymake diagnostic DIAG's start position.
356 (overlay-start (flymake--diag-overlay diag))) 356This position only be queried after DIAG has been reported to Flymake."
357 (let ((overlay (flymake--diag-overlay diag)))
358 (unless overlay
359 (error "DIAG %s not reported to Flymake yet" diag))
360 (overlay-start overlay)))
357 361
358(defun flymake-diagnostic-end (diag) 362(defun flymake-diagnostic-end (diag)
359 "Get Flymake diagnostic DIAG's end position." 363 "Get Flymake diagnostic DIAG's end position.
360 (overlay-end (flymake--diag-overlay diag))) 364This position only be queried after DIAG has been reported to Flymake."
365 (let ((overlay (flymake--diag-overlay diag)))
366 (unless overlay
367 (error "DIAG %s not reported to Flymake yet" diag))
368 (overlay-end overlay)))
361 369
362(cl-defun flymake--overlays (&key beg end filter compare key) 370(cl-defun flymake--overlays (&key beg end filter compare key)
363 "Get flymake-related overlays. 371 "Get flymake-related overlays.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index d047dd543c2..0120e4a7cd1 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -143,7 +143,7 @@
143 '(;; Functions 143 '(;; Functions
144 (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1) 144 (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1)
145 ;;Variables 145 ;;Variables
146 ("Variables" "^[ \t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) 146 ("Variables" "^[ \t]*\\(?:has\\|local\\|my\\|our\\|state\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
147 ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1) 147 ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1)
148 ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) 148 ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
149 "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") 149 "Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
@@ -188,9 +188,8 @@
188 "\\>") 188 "\\>")
189 ;; 189 ;;
190 ;; Fontify declarators and prefixes as types. 190 ;; Fontify declarators and prefixes as types.
191 ("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" . font-lock-type-face) ; declarators 191 ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-type-face) ; declarators
192 ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes 192 ;;
193 ;;
194 ;; Fontify function, variable and file name references. 193 ;; Fontify function, variable and file name references.
195 ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) 194 ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
196 ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable' 195 ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 768cd58ae44..fc5e30111e5 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,8 +1,8 @@
1;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- 1;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2015-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
4;; Version: 0.5.3 4;; Version: 0.5.4
5;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) 5;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
6 6
7;; This is a GNU ELPA :core package. Avoid using functionality that 7;; This is a GNU ELPA :core package. Avoid using functionality that
8;; not compatible with the version of Emacs recorded above. 8;; not compatible with the version of Emacs recorded above.
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index cc045a1b2d1..fd689527676 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."
1957 ('(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) 1957 ('(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt)
1958 (sh-var-value 'sh-indent-for-case-label))) 1958 (sh-var-value 'sh-indent-for-case-label)))
1959 (`(:before . ,(or "(" "{" "[" "while" "if" "for" "case")) 1959 (`(:before . ,(or "(" "{" "[" "while" "if" "for" "case"))
1960 (if (not (smie-rule-prev-p "&&" "||" "|")) 1960 (cond
1961 (when (smie-rule-hanging-p) 1961 ((and (equal token "{") (smie-rule-parent-p "for"))
1962 (smie-rule-parent)) 1962 (let ((data (smie-backward-sexp "in")))
1963 (when (equal (nth 2 data) "for")
1964 `(column . ,(smie-indent-virtual)))))
1965 ((not (smie-rule-prev-p "&&" "||" "|"))
1966 (when (smie-rule-hanging-p)
1967 (smie-rule-parent)))
1968 (t
1963 (unless (smie-rule-bolp) 1969 (unless (smie-rule-bolp)
1964 (while (equal "|" (nth 2 (smie-backward-sexp 'halfexp)))) 1970 (while (equal "|" (nth 2 (smie-backward-sexp 'halfexp))))
1965 `(column . ,(smie-indent-virtual))))) 1971 `(column . ,(smie-indent-virtual))))))
1966 ;; FIXME: Maybe this handling of ;; should be made into 1972 ;; FIXME: Maybe this handling of ;; should be made into
1967 ;; a smie-rule-terminator function that takes the substitute ";" as arg. 1973 ;; a smie-rule-terminator function that takes the substitute ";" as arg.
1968 (`(:before . ,(or ";;" ";&" ";;&")) 1974 (`(:before . ,(or ";;" ";&" ";;&"))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 898cb4fb4c1..18fdd963fb1 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -2,7 +2,7 @@
2 2
3;; Copyright (C) 2014-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
4;; Version: 1.0.4 4;; Version: 1.0.4
5;; Package-Requires: ((emacs "26.3")) 5;; Package-Requires: ((emacs "26.1"))
6 6
7;; This is a GNU ELPA :core package. Avoid functionality that is not 7;; This is a GNU ELPA :core package. Avoid functionality that is not
8;; compatible with the version of Emacs recorded above. 8;; compatible with the version of Emacs recorded above.
@@ -972,6 +972,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
972 (erase-buffer) 972 (erase-buffer)
973 (xref--insert-xrefs alist)) 973 (xref--insert-xrefs alist))
974 (user-error 974 (user-error
975 (erase-buffer)
975 (insert 976 (insert
976 (propertize 977 (propertize
977 (error-message-string err) 978 (error-message-string err)
diff --git a/lisp/recentf.el b/lisp/recentf.el
index a28a3977a76..d39a523289f 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1352,7 +1352,14 @@ That is, remove duplicates, non-kept, and excluded files."
1352 1352
1353When Recentf mode is enabled, a \"Open Recent\" submenu is 1353When Recentf mode is enabled, a \"Open Recent\" submenu is
1354displayed in the \"File\" menu, containing a list of files that 1354displayed in the \"File\" menu, containing a list of files that
1355were operated on recently, in the most-recently-used order." 1355were operated on recently, in the most-recently-used order.
1356
1357By default, only operations like opening a file, writing a buffer
1358to a file, and killing a buffer is counted as \"operating\" on
1359the file. If instead you want to prioritize files that appear in
1360buffers you switch to a lot, you can say something like the following:
1361
1362 (add-hook 'buffer-list-update-hook 'recentf-track-opened-file)"
1356 :global t 1363 :global t
1357 :group 'recentf 1364 :group 'recentf
1358 :keymap recentf-mode-map 1365 :keymap recentf-mode-map
diff --git a/lisp/replace.el b/lisp/replace.el
index db5b340631a..f13d27aff89 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -186,6 +186,21 @@ See `replace-regexp' and `query-replace-regexp-eval'.")
186 length) 186 length)
187 length))))) 187 length)))))
188 188
189(defun query-replace-read-from-suggestions ()
190 "Return a list of standard suggestions for `query-replace-read-from'.
191By default, the list includes the active region, the identifier
192(a.k.a. \"tag\") at point (see Info node `(emacs) Identifier Search'),
193the last isearch string, and the last replacement regexp.
194`query-replace-read-from' appends the list returned
195by this function to the end of values available via
196\\<minibuffer-local-map>\\[next-history-element]."
197 (delq nil (list (when (use-region-p)
198 (buffer-substring-no-properties
199 (region-beginning) (region-end)))
200 (find-tag-default)
201 (car search-ring)
202 (car (symbol-value query-replace-from-history-variable)))))
203
189(defun query-replace-read-from (prompt regexp-flag) 204(defun query-replace-read-from (prompt regexp-flag)
190 "Query and return the `from' argument of a query-replace operation. 205 "Query and return the `from' argument of a query-replace operation.
191Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp. 206Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp.
@@ -242,7 +257,8 @@ wants to replace FROM with TO."
242 (if regexp-flag 257 (if regexp-flag
243 (read-regexp prompt nil 'minibuffer-history) 258 (read-regexp prompt nil 'minibuffer-history)
244 (read-from-minibuffer 259 (read-from-minibuffer
245 prompt nil nil nil nil (car search-ring) t))))) 260 prompt nil nil nil nil
261 (query-replace-read-from-suggestions) t)))))
246 (to)) 262 (to))
247 (if (and (zerop (length from)) query-replace-defaults) 263 (if (and (zerop (length from)) query-replace-defaults)
248 (cons (caar query-replace-defaults) 264 (cons (caar query-replace-defaults)
@@ -327,14 +343,15 @@ Prompt with PROMPT. REGEXP-FLAG non-nil means the response should a regexp."
327(defun query-replace-read-args (prompt regexp-flag &optional noerror) 343(defun query-replace-read-args (prompt regexp-flag &optional noerror)
328 (unless noerror 344 (unless noerror
329 (barf-if-buffer-read-only)) 345 (barf-if-buffer-read-only))
330 (let* ((from (query-replace-read-from prompt regexp-flag)) 346 (save-mark-and-excursion
331 (to (if (consp from) (prog1 (cdr from) (setq from (car from))) 347 (let* ((from (query-replace-read-from prompt regexp-flag))
332 (query-replace-read-to from prompt regexp-flag)))) 348 (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
333 (list from to 349 (query-replace-read-to from prompt regexp-flag))))
334 (or (and current-prefix-arg (not (eq current-prefix-arg '-))) 350 (list from to
335 (and (plist-member (text-properties-at 0 from) 'isearch-regexp-function) 351 (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
336 (get-text-property 0 'isearch-regexp-function from))) 352 (and (plist-member (text-properties-at 0 from) 'isearch-regexp-function)
337 (and current-prefix-arg (eq current-prefix-arg '-))))) 353 (get-text-property 0 'isearch-regexp-function from)))
354 (and current-prefix-arg (eq current-prefix-arg '-))))))
338 355
339(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p) 356(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p)
340 "Replace some occurrences of FROM-STRING with TO-STRING. 357 "Replace some occurrences of FROM-STRING with TO-STRING.
@@ -808,11 +825,16 @@ the function that you set this to can check `this-command'."
808 825
809(defun read-regexp-suggestions () 826(defun read-regexp-suggestions ()
810 "Return a list of standard suggestions for `read-regexp'. 827 "Return a list of standard suggestions for `read-regexp'.
811By default, the list includes the tag at point, the last isearch regexp, 828By default, the list includes the active region, the identifier
812the last isearch string, and the last replacement regexp. `read-regexp' 829(a.k.a. \"tag\") at point (see Info node `(emacs) Identifier Search'),
813appends the list returned by this function to the end of values available 830the last isearch regexp, the last isearch string, and the last
814via \\<minibuffer-local-map>\\[next-history-element]." 831replacement regexp. `read-regexp' appends the list returned
832by this function to the end of values available via
833\\<minibuffer-local-map>\\[next-history-element]."
815 (list 834 (list
835 (when (use-region-p)
836 (buffer-substring-no-properties
837 (region-beginning) (region-end)))
816 (find-tag-default-as-regexp) 838 (find-tag-default-as-regexp)
817 (find-tag-default-as-symbol-regexp) 839 (find-tag-default-as-symbol-regexp)
818 (car regexp-search-ring) 840 (car regexp-search-ring)
@@ -825,31 +847,35 @@ Prompt with the string PROMPT. If PROMPT ends in \":\" (followed by
825optional whitespace), use it as-is. Otherwise, add \": \" to the end, 847optional whitespace), use it as-is. Otherwise, add \": \" to the end,
826possibly preceded by the default result (see below). 848possibly preceded by the default result (see below).
827 849
828The optional argument DEFAULTS can be either: nil, a string, a list 850The optional argument DEFAULTS is used to construct the default
829of strings, or a symbol. We use DEFAULTS to construct the default 851return value in case of empty input. DEFAULTS can be nil, a string,
830return value in case of empty input. 852a list of strings, or a symbol.
831 853
832If DEFAULTS is a string, we use it as-is. 854If DEFAULTS is a string, the function uses it as-is.
833 855
834If DEFAULTS is a list of strings, the first element is the 856If DEFAULTS is a list of strings, the first element is the
835default return value, but all the elements are accessible 857default return value, but all the elements are accessible
836using the history command \\<minibuffer-local-map>\\[next-history-element]. 858using the history command \\<minibuffer-local-map>\\[next-history-element].
837 859
838If DEFAULTS is a non-nil symbol, then if `read-regexp-defaults-function' 860If DEFAULTS is the symbol `regexp-history-last', the default return
839is non-nil, we use that in place of DEFAULTS in the following: 861value will be the first element of HISTORY. If HISTORY is omitted or
840 If DEFAULTS is the symbol `regexp-history-last', we use the first 862nil, `regexp-history' is used instead.
841 element of HISTORY (if specified) or `regexp-history'. 863If DEFAULTS is a symbol with a function definition, it is called with
842 If DEFAULTS is a function, we call it with no arguments and use 864no arguments and should return either nil, a string, or a list of
843 what it returns, which should be either nil, a string, or a list of strings. 865strings, which will be used as above.
866Other symbol values for DEFAULTS are ignored.
867
868If `read-regexp-defaults-function' is non-nil, its value is used
869instead of DEFAULTS in the two cases described in the last paragraph.
844 870
845We append the standard values from `read-regexp-suggestions' to DEFAULTS 871Before using whatever value DEFAULTS yields, the function appends the
846before using it. 872standard values from `read-regexp-suggestions' to that value.
847 873
848If the first element of DEFAULTS is non-nil (and if PROMPT does not end 874If the first element of DEFAULTS is non-nil (and if PROMPT does not end
849in \":\", followed by optional whitespace), we add it to the prompt. 875in \":\", followed by optional whitespace), DEFAULT is added to the prompt.
850 876
851The optional argument HISTORY is a symbol to use for the history list. 877The optional argument HISTORY is a symbol to use for the history list.
852If nil, uses `regexp-history'." 878If nil, use `regexp-history'."
853 (let* ((defaults 879 (let* ((defaults
854 (if (and defaults (symbolp defaults)) 880 (if (and defaults (symbolp defaults))
855 (cond 881 (cond
diff --git a/lisp/simple.el b/lisp/simple.el
index 8d4e4a7a6bb..742fc5004dc 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2472,11 +2472,24 @@ previous element of the minibuffer history in the minibuffer."
2472 (save-excursion 2472 (save-excursion
2473 (goto-char (1- prompt-end)) 2473 (goto-char (1- prompt-end))
2474 (current-column))) 2474 (current-column)))
2475 0) 2475 1)
2476 (current-column))))) 2476 (current-column)))))
2477 (condition-case nil 2477 (condition-case nil
2478 (with-no-warnings 2478 (with-no-warnings
2479 (previous-line arg)) 2479 (previous-line arg)
2480 ;; Avoid moving point to the prompt
2481 (when (< (point) (minibuffer-prompt-end))
2482 ;; If there is minibuffer contents on the same line
2483 (if (<= (minibuffer-prompt-end)
2484 (save-excursion
2485 (if (or truncate-lines (not line-move-visual))
2486 (end-of-line)
2487 (end-of-visual-line))
2488 (point)))
2489 ;; Move to the beginning of minibuffer contents
2490 (goto-char (minibuffer-prompt-end))
2491 ;; Otherwise, go to the previous history element
2492 (signal 'beginning-of-buffer nil))))
2480 (beginning-of-buffer 2493 (beginning-of-buffer
2481 ;; Restore old position since `line-move-visual' moves point to 2494 ;; Restore old position since `line-move-visual' moves point to
2482 ;; the beginning of the line when it fails to go to the previous line. 2495 ;; the beginning of the line when it fails to go to the previous line.
@@ -3978,6 +3991,9 @@ impose the use of a shell (with its need to quote arguments)."
3978 (start-process-shell-command "Shell" buffer command))) 3991 (start-process-shell-command "Shell" buffer command)))
3979 (setq mode-line-process '(":%s")) 3992 (setq mode-line-process '(":%s"))
3980 (shell-mode) 3993 (shell-mode)
3994 (setq-local revert-buffer-function
3995 (lambda (&rest _)
3996 (async-shell-command command buffer)))
3981 (set-process-sentinel proc #'shell-command-sentinel) 3997 (set-process-sentinel proc #'shell-command-sentinel)
3982 ;; Use the comint filter for proper handling of 3998 ;; Use the comint filter for proper handling of
3983 ;; carriage motion (see comint-inhibit-carriage-motion). 3999 ;; carriage motion (see comint-inhibit-carriage-motion).
@@ -4244,6 +4260,9 @@ characters."
4244 buffer)))) 4260 buffer))))
4245 ;; Report the output. 4261 ;; Report the output.
4246 (with-current-buffer buffer 4262 (with-current-buffer buffer
4263 (setq-local revert-buffer-function
4264 (lambda (&rest _)
4265 (shell-command command)))
4247 (setq mode-line-process 4266 (setq mode-line-process
4248 (cond ((null exit-status) 4267 (cond ((null exit-status)
4249 " - Error") 4268 " - Error")
diff --git a/lisp/startup.el b/lisp/startup.el
index 09635b12990..ec58418186c 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -320,6 +320,8 @@ early init file.")
320This variable is used to define the proper function and keypad 320This variable is used to define the proper function and keypad
321keys for use under X. It is used in a fashion analogous to the 321keys for use under X. It is used in a fashion analogous to the
322environment variable TERM.") 322environment variable TERM.")
323(make-obsolete-variable 'keyboard-type nil "28.1")
324(internal-make-var-non-special 'keyboard-type)
323 325
324(defvar window-setup-hook nil 326(defvar window-setup-hook nil
325 "Normal hook run after loading init files and handling the command line. 327 "Normal hook run after loading init files and handling the command line.
diff --git a/lisp/subr.el b/lisp/subr.el
index b1295a0f0d6..b5f7dfd5026 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2970,8 +2970,6 @@ Also discard all previous input in the minibuffer."
2970 (minibuffer-message "Wrong answer") 2970 (minibuffer-message "Wrong answer")
2971 (sit-for 2))) 2971 (sit-for 2)))
2972 2972
2973(defvar empty-history)
2974
2975(defun read-char-from-minibuffer (prompt &optional chars history) 2973(defun read-char-from-minibuffer (prompt &optional chars history)
2976 "Read a character from the minibuffer, prompting for it with PROMPT. 2974 "Read a character from the minibuffer, prompting for it with PROMPT.
2977Like `read-char', but uses the minibuffer to read and return a character. 2975Like `read-char', but uses the minibuffer to read and return a character.
@@ -2986,6 +2984,7 @@ while calling this function, then pressing `help-char'
2986causes it to evaluate `help-form' and display the result. 2984causes it to evaluate `help-form' and display the result.
2987There is no need to explicitly add `help-char' to CHARS; 2985There is no need to explicitly add `help-char' to CHARS;
2988`help-char' is bound automatically to `help-form-show'." 2986`help-char' is bound automatically to `help-form-show'."
2987 (defvar empty-history)
2989 (let* ((empty-history '()) 2988 (let* ((empty-history '())
2990 (map (if (consp chars) 2989 (map (if (consp chars)
2991 (or (gethash (list help-form (cons help-char chars)) 2990 (or (gethash (list help-form (cons help-char chars))
@@ -3098,8 +3097,6 @@ Also discard all previous input in the minibuffer."
3098 "Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'. 3097 "Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'.
3099Otherwise, use the minibuffer.") 3098Otherwise, use the minibuffer.")
3100 3099
3101(defvar empty-history)
3102
3103(defun y-or-n-p (prompt) 3100(defun y-or-n-p (prompt)
3104 "Ask user a \"y or n\" question. 3101 "Ask user a \"y or n\" question.
3105Return t if answer is \"y\" and nil if it is \"n\". 3102Return t if answer is \"y\" and nil if it is \"n\".
@@ -3195,6 +3192,7 @@ is nil and `use-dialog-box' is non-nil."
3195 (discard-input))) 3192 (discard-input)))
3196 (t 3193 (t
3197 (setq prompt (funcall padded prompt)) 3194 (setq prompt (funcall padded prompt))
3195 (defvar empty-history)
3198 (let* ((empty-history '()) 3196 (let* ((empty-history '())
3199 (enable-recursive-minibuffers t) 3197 (enable-recursive-minibuffers t)
3200 (msg help-form) 3198 (msg help-form)
@@ -4928,7 +4926,9 @@ file, FORM is evaluated immediately after the provide statement.
4928Usually FILE is just a library name like \"font-lock\" or a feature name 4926Usually FILE is just a library name like \"font-lock\" or a feature name
4929like `font-lock'. 4927like `font-lock'.
4930 4928
4931This function makes or adds to an entry on `after-load-alist'." 4929This function makes or adds to an entry on `after-load-alist'.
4930
4931See also `with-eval-after-load'."
4932 (declare (compiler-macro 4932 (declare (compiler-macro
4933 (lambda (whole) 4933 (lambda (whole)
4934 (if (eq 'quote (car-safe form)) 4934 (if (eq 'quote (car-safe form))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 2726947a4c2..9209f2d46ec 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -651,7 +651,9 @@ corresponding to the switched buffer."
651 (if (functionp tab-line-new-tab-choice) 651 (if (functionp tab-line-new-tab-choice)
652 (funcall tab-line-new-tab-choice) 652 (funcall tab-line-new-tab-choice)
653 (let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups)) 653 (let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups))
654 (if (and (listp mouse-event) window-system) ; (display-popup-menus-p) 654 (if (and (listp mouse-event)
655 (display-popup-menus-p)
656 (not tty-menu-open-use-tmm))
655 (mouse-buffer-menu mouse-event) ; like (buffer-menu-open) 657 (mouse-buffer-menu mouse-event) ; like (buffer-menu-open)
656 ;; tty menu doesn't support mouse clicks, so use tmm 658 ;; tty menu doesn't support mouse clicks, so use tmm
657 (tmm-prompt (mouse-buffer-menu-keymap)))))) 659 (tmm-prompt (mouse-buffer-menu-keymap))))))
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 8859f13bd20..4a925cd84c3 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,4 +1,4 @@
1;;; w32console.el -- Setup w32 console keys and colors. 1;;; w32console.el -- Setup w32 console keys and colors. -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2007-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 896578513cf..fe70e925b05 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,4 +1,4 @@
1;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source 1;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2021 Free Software 3;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2021 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -43,7 +43,6 @@
43 43
44(defcustom nroff-electric-mode nil 44(defcustom nroff-electric-mode nil
45 "Non-nil means automatically closing requests when you insert an open." 45 "Non-nil means automatically closing requests when you insert an open."
46 :group 'nroff
47 :type 'boolean) 46 :type 'boolean)
48 47
49(defvar nroff-mode-map 48(defvar nroff-mode-map
@@ -111,7 +110,7 @@
111 ;; arguments in common cases, like \f. 110 ;; arguments in common cases, like \f.
112 (concat "\\\\" ; backslash 111 (concat "\\\\" ; backslash
113 "\\(" ; followed by various possibilities 112 "\\(" ; followed by various possibilities
114 (mapconcat 'identity 113 (mapconcat #'identity
115 '("[f*n]*\\[.+?]" ; some groff extensions 114 '("[f*n]*\\[.+?]" ; some groff extensions
116 "(.." ; two chars after ( 115 "(.." ; two chars after (
117 "[^(\"#]" ; single char escape 116 "[^(\"#]" ; single char escape
@@ -119,13 +118,11 @@
119 "\\)") 118 "\\)")
120 ) 119 )
121 "Font-lock highlighting control in `nroff-mode'." 120 "Font-lock highlighting control in `nroff-mode'."
122 :group 'nroff
123 :type '(repeat regexp)) 121 :type '(repeat regexp))
124 122
125(defcustom nroff-mode-hook nil 123(defcustom nroff-mode-hook nil
126 "Hook run by function `nroff-mode'." 124 "Hook run by function `nroff-mode'."
127 :type 'hook 125 :type 'hook)
128 :group 'nroff)
129 126
130;;;###autoload 127;;;###autoload
131(define-derived-mode nroff-mode text-mode "Nroff" 128(define-derived-mode nroff-mode text-mode "Nroff"
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 8465e82b02a..c50c544cb54 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -2402,9 +2402,9 @@ To work around that, do:
2402 2402
2403 (setq-local sgml-empty-tags 2403 (setq-local sgml-empty-tags
2404 ;; From HTML-4.01's loose.dtd, parsed with 2404 ;; From HTML-4.01's loose.dtd, parsed with
2405 ;; `sgml-parse-dtd', plus manual addition of "wbr". 2405 ;; `sgml-parse-dtd', plus manual additions of "source" and "wbr".
2406 '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input" 2406 '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
2407 "isindex" "link" "meta" "param" "wbr")) 2407 "isindex" "link" "meta" "source" "param" "wbr"))
2408 (setq-local sgml-unclosed-tags 2408 (setq-local sgml-unclosed-tags
2409 ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'. 2409 ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
2410 '("body" "colgroup" "dd" "dt" "head" "html" "li" "option" 2410 '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index c4e4864da17..ce665e61656 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."
1169 (setq-local outline-regexp latex-outline-regexp) 1169 (setq-local outline-regexp latex-outline-regexp)
1170 (setq-local outline-level #'latex-outline-level) 1170 (setq-local outline-level #'latex-outline-level)
1171 (setq-local forward-sexp-function #'latex-forward-sexp) 1171 (setq-local forward-sexp-function #'latex-forward-sexp)
1172 (setq-local skeleton-end-hook nil)) 1172 (setq-local skeleton-end-hook nil)
1173 (setq-local comment-region-function #'latex--comment-region)
1174 (setq-local comment-style 'plain))
1175
1176(defun latex--comment-region (beg end &optional arg)
1177 (comment-region-default-1 beg end arg t))
1173 1178
1174;;;###autoload 1179;;;###autoload
1175(define-derived-mode slitex-mode latex-mode "SliTeX" 1180(define-derived-mode slitex-mode latex-mode "SliTeX"
diff --git a/lisp/tmm.el b/lisp/tmm.el
index e49246a5c4f..2040f522700 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -56,12 +56,14 @@ to invoke `tmm-menubar' instead, customize the variable
56`tty-menu-open-use-tmm' to a non-nil value." 56`tty-menu-open-use-tmm' to a non-nil value."
57 (interactive) 57 (interactive)
58 (run-hooks 'menu-bar-update-hook) 58 (run-hooks 'menu-bar-update-hook)
59 (let ((menu-bar (menu-bar-keymap)) 59 (if isearch-mode
60 (menu-bar-item-cons (and x-position 60 (isearch-tmm-menubar)
61 (menu-bar-item-at-x x-position)))) 61 (let ((menu-bar (menu-bar-keymap))
62 (tmm-prompt menu-bar 62 (menu-bar-item-cons (and x-position
63 nil 63 (menu-bar-item-at-x x-position))))
64 (and menu-bar-item-cons (car menu-bar-item-cons))))) 64 (tmm-prompt menu-bar
65 nil
66 (and menu-bar-item-cons (car menu-bar-item-cons))))))
65 67
66;;;###autoload 68;;;###autoload
67(defun tmm-menubar-mouse (event) 69(defun tmm-menubar-mouse (event)
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index bff5570f6df..6ae90ccefad 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -1,4 +1,4 @@
1;;; url-about.el --- Show internal URLs 1;;; url-about.el --- Show internal URLs -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -44,7 +44,7 @@
44 44
45(defvar url-scheme-registry) 45(defvar url-scheme-registry)
46 46
47(defun url-about-protocols (url) 47(defun url-about-protocols (_url)
48 (url-probe-protocols) 48 (url-probe-protocols)
49 (insert "<html>\n" 49 (insert "<html>\n"
50 " <head>\n" 50 " <head>\n"
@@ -73,13 +73,15 @@
73 "ynchronous<br>\n" 73 "ynchronous<br>\n"
74 (if (url-scheme-get-property k 'default-port) 74 (if (url-scheme-get-property k 'default-port)
75 (format "Default Port: %d<br>\n" 75 (format "Default Port: %d<br>\n"
76 (url-scheme-get-property k 'default-port)) "") 76 (url-scheme-get-property k 'default-port))
77 "")
77 (if (assoc k url-proxy-services) 78 (if (assoc k url-proxy-services)
78 (format "Proxy: %s<br>\n" (assoc k url-proxy-services)) "")) 79 (format "Proxy: %s<br>\n" (assoc k url-proxy-services)) ""))
79 ;; Now the description... 80 ;; Now the description...
80 (insert " <td valign=top>" 81 (insert " <td valign=top>"
81 (or (url-scheme-get-property k 'description) "N/A")))) 82 (or (url-scheme-get-property k 'description) "N/A"))))
82 (sort (let (x) (maphash (lambda (k v) (push k x)) url-scheme-registry) x) 'string-lessp)) 83 (sort (let (x) (maphash (lambda (k _v) (push k x)) url-scheme-registry) x)
84 #'string-lessp))
83 (insert " </table>\n" 85 (insert " </table>\n"
84 " </body>\n" 86 " </body>\n"
85 "</html>\n")) 87 "</html>\n"))
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index acf88eb0212..830e6ba9dcc 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,4 +1,4 @@
1;;; url-cache.el --- Uniform Resource Locator retrieval tool 1;;; url-cache.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index d465cabc90c..0ca2d8a0737 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,4 +1,4 @@
1;;; url-cid.el --- Content-ID URL loader 1;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 12d5a683e97..edb1c1de9fc 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -1,4 +1,4 @@
1;;; url-dav.el --- WebDAV support 1;;; url-dav.el --- WebDAV support -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -133,7 +133,8 @@ Returns nil if WebDAV is not supported."
133 (node-type nil) 133 (node-type nil)
134 (props nil) 134 (props nil)
135 (value nil) 135 (value nil)
136 (handler-func nil)) 136 ;; (handler-func nil)
137 )
137 (when (not children) 138 (when (not children)
138 (error "No child nodes in DAV:prop")) 139 (error "No child nodes in DAV:prop"))
139 140
@@ -453,7 +454,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
453 " </DAV:owner>\n")) 454 " </DAV:owner>\n"))
454 (response nil) ; Responses to the LOCK request 455 (response nil) ; Responses to the LOCK request
455 (result nil) ; For walking thru the response list 456 (result nil) ; For walking thru the response list
456 (child-url nil) 457 ;; (child-url nil)
457 (child-status nil) 458 (child-status nil)
458 (failures nil) ; List of failure cases (URL . STATUS) 459 (failures nil) ; List of failure cases (URL . STATUS)
459 (successes nil)) ; List of success cases (URL . STATUS) 460 (successes nil)) ; List of success cases (URL . STATUS)
@@ -468,7 +469,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
468 ;; status code. 469 ;; status code.
469 (while response 470 (while response
470 (setq result (pop response) 471 (setq result (pop response)
471 child-url (url-expand-file-name (pop result) url) 472 ;; child-url (url-expand-file-name (pop result) url)
472 child-status (or (plist-get result 'DAV:status) 500)) 473 child-status (or (plist-get result 'DAV:status) 500))
473 (if (url-dav-http-success-p child-status) 474 (if (url-dav-http-success-p child-status)
474 (push (list url child-status "huh") successes) 475 (push (list url child-status "huh") successes)
@@ -478,7 +479,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
478(defun url-dav-active-locks (url &optional depth) 479(defun url-dav-active-locks (url &optional depth)
479 "Return an assoc list of all active locks on URL." 480 "Return an assoc list of all active locks on URL."
480 (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth)) 481 (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth))
481 (properties nil) 482 ;; (properties nil)
482 (child nil) 483 (child nil)
483 (child-url nil) 484 (child-url nil)
484 (child-results nil) 485 (child-results nil)
@@ -676,7 +677,6 @@ Use with care, and even then think three times."
676If optional second argument RECURSIVE is non-nil, then delete all 677If optional second argument RECURSIVE is non-nil, then delete all
677files in the collection as well." 678files in the collection as well."
678 (let ((status nil) 679 (let ((status nil)
679 (props nil)
680 (props nil)) 680 (props nil))
681 (setq props (url-dav-delete-something 681 (setq props (url-dav-delete-something
682 url lock-token 682 url lock-token
@@ -769,7 +769,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
769 (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype)) 769 (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
770 t))) 770 t)))
771 771
772(defun url-dav-make-directory (url &optional parents) 772(defun url-dav-make-directory (url &optional _parents)
773 "Create the directory DIR and any nonexistent parent dirs." 773 "Create the directory DIR and any nonexistent parent dirs."
774 (let* ((url-request-extra-headers nil) 774 (let* ((url-request-extra-headers nil)
775 (url-request-method "MKCOL") 775 (url-request-method "MKCOL")
@@ -849,7 +849,9 @@ that start with FILE.
849If there is only one and FILE matches it exactly, returns t. 849If there is only one and FILE matches it exactly, returns t.
850Returns nil if URL contains no name starting with FILE." 850Returns nil if URL contains no name starting with FILE."
851 (let ((matches (url-dav-file-name-all-completions file url)) 851 (let ((matches (url-dav-file-name-all-completions file url))
852 (result nil)) 852 ;; (result nil)
853 )
854 ;; FIXME: Use `try-completion'!
853 (cond 855 (cond
854 ((null matches) 856 ((null matches)
855 ;; No matches 857 ;; No matches
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index a42b4c7ad23..05088e3cac8 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."
66 ;; Need to nuke newlines and spaces in the URL, or we open 66 ;; Need to nuke newlines and spaces in the URL, or we open
67 ;; ourselves up to potential security holes. 67 ;; ourselves up to potential security holes.
68 (setq url (mapconcat (lambda (x) 68 (setq url (mapconcat (lambda (x)
69 (if (memq x '(? ?\n ?\r)) 69 (if (memq x '(?\s ?\n ?\r))
70 "" 70 ""
71 (char-to-string x))) 71 (char-to-string x)))
72 url ""))) 72 url "")))
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 52a9588030e..0e2ab5544b9 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -154,7 +154,7 @@ to them."
154 ;; not the compressed one. 154 ;; not the compressed one.
155 ;; FIXME should this regexp not include more extensions; basically 155 ;; FIXME should this regexp not include more extensions; basically
156 ;; everything that url-file-find-possibly-compressed-file does? 156 ;; everything that url-file-find-possibly-compressed-file does?
157 (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)$" filename) 157 (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)\\'" filename)
158 (substring filename 0 (match-beginning 0)) 158 (substring filename 0 (match-beginning 0))
159 filename)) 159 filename))
160 (setq content-type (mailcap-extension-to-mime 160 (setq content-type (mailcap-extension-to-mime
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 68df67f6486..d2bf843fc36 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,4 +1,4 @@
1;;; url-gw.el --- Gateway munging for URL loading 1;;; url-gw.el --- Gateway munging for URL loading -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1997-1998, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1998, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -222,18 +222,17 @@ overriding the value of `url-gateway-method'."
222 host)) 222 host))
223 'native 223 'native
224 gwm)) 224 gwm))
225 ;; An attempt to deal with denied connections, and attempt 225 ;; An attempt to deal with denied connections, and attempt
226 ;; to reconnect 226 ;; to reconnect
227 (cur-retries 0) 227 ;; (cur-retries 0)
228 (retry t) 228 ;; (retry t)
229 (errobj nil) 229 (conn nil))
230 (conn nil))
231 230
232 ;; If the user told us to do DNS for them, do it. 231 ;; If the user told us to do DNS for them, do it.
233 (if url-gateway-broken-resolution 232 (if url-gateway-broken-resolution
234 (setq host (url-gateway-nslookup-host host))) 233 (setq host (url-gateway-nslookup-host host)))
235 234
236 (condition-case errobj 235 (condition-case nil
237 ;; This is a clean way to ensure the new process inherits the 236 ;; This is a clean way to ensure the new process inherits the
238 ;; right coding systems in both Emacs and XEmacs. 237 ;; right coding systems in both Emacs and XEmacs.
239 (let ((coding-system-for-read 'binary) 238 (let ((coding-system-for-read 'binary)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 324cf99554d..61e07a0d9ca 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -66,7 +66,7 @@
66 66
67(defconst url-http-default-port 80 "Default HTTP port.") 67(defconst url-http-default-port 80 "Default HTTP port.")
68(defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.") 68(defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.")
69(defalias 'url-http-expand-file-name 'url-default-expander) 69(defalias 'url-http-expand-file-name #'url-default-expander)
70 70
71(defvar url-http-real-basic-auth-storage nil) 71(defvar url-http-real-basic-auth-storage nil)
72(defvar url-http-proxy-basic-auth-storage nil) 72(defvar url-http-proxy-basic-auth-storage nil)
@@ -150,7 +150,7 @@ request.")
150;; These routines will allow us to implement persistent HTTP 150;; These routines will allow us to implement persistent HTTP
151;; connections. 151;; connections.
152(defsubst url-http-debug (&rest args) 152(defsubst url-http-debug (&rest args)
153 (apply 'url-debug 'http args)) 153 (apply #'url-debug 'http args))
154 154
155(defun url-http-mark-connection-as-busy (host port proc) 155(defun url-http-mark-connection-as-busy (host port proc)
156 (url-http-debug "Marking connection as busy: %s:%d %S" host port proc) 156 (url-http-debug "Marking connection as busy: %s:%d %S" host port proc)
@@ -1203,8 +1203,7 @@ the end of the document."
1203 ;; We got back a headerless malformed response from the 1203 ;; We got back a headerless malformed response from the
1204 ;; server. 1204 ;; server.
1205 (url-http-activate-callback)) 1205 (url-http-activate-callback))
1206 ((or (= url-http-response-status 204) 1206 ((memq url-http-response-status '(204 205))
1207 (= url-http-response-status 205))
1208 (url-http-debug "%d response must have headers only (%s)." 1207 (url-http-debug "%d response must have headers only (%s)."
1209 url-http-response-status (buffer-name)) 1208 url-http-response-status (buffer-name))
1210 (when (url-http-parse-headers) 1209 (when (url-http-parse-headers)
@@ -1239,11 +1238,11 @@ the end of the document."
1239 (url-http-debug 1238 (url-http-debug
1240 "Saw HTTP/0.9 response, connection closed means end of document.") 1239 "Saw HTTP/0.9 response, connection closed means end of document.")
1241 (setq url-http-after-change-function 1240 (setq url-http-after-change-function
1242 'url-http-simple-after-change-function)) 1241 #'url-http-simple-after-change-function))
1243 ((equal url-http-transfer-encoding "chunked") 1242 ((equal url-http-transfer-encoding "chunked")
1244 (url-http-debug "Saw chunked encoding.") 1243 (url-http-debug "Saw chunked encoding.")
1245 (setq url-http-after-change-function 1244 (setq url-http-after-change-function
1246 'url-http-chunked-encoding-after-change-function) 1245 #'url-http-chunked-encoding-after-change-function)
1247 (when (> nd url-http-end-of-headers) 1246 (when (> nd url-http-end-of-headers)
1248 (url-http-debug 1247 (url-http-debug
1249 "Calling initial chunked-encoding for extra data at end of headers") 1248 "Calling initial chunked-encoding for extra data at end of headers")
@@ -1254,7 +1253,7 @@ the end of the document."
1254 (url-http-debug 1253 (url-http-debug
1255 "Got a content-length, being smart about document end.") 1254 "Got a content-length, being smart about document end.")
1256 (setq url-http-after-change-function 1255 (setq url-http-after-change-function
1257 'url-http-content-length-after-change-function) 1256 #'url-http-content-length-after-change-function)
1258 (cond 1257 (cond
1259 ((= 0 url-http-content-length) 1258 ((= 0 url-http-content-length)
1260 ;; We got a NULL body! Activate the callback 1259 ;; We got a NULL body! Activate the callback
@@ -1275,7 +1274,7 @@ the end of the document."
1275 (t 1274 (t
1276 (url-http-debug "No content-length, being dumb.") 1275 (url-http-debug "No content-length, being dumb.")
1277 (setq url-http-after-change-function 1276 (setq url-http-after-change-function
1278 'url-http-simple-after-change-function))))) 1277 #'url-http-simple-after-change-function)))))
1279 ;; We are still at the beginning of the buffer... must just be 1278 ;; We are still at the beginning of the buffer... must just be
1280 ;; waiting for a response. 1279 ;; waiting for a response.
1281 (url-http-debug "Spinning waiting for headers...") 1280 (url-http-debug "Spinning waiting for headers...")
@@ -1374,7 +1373,7 @@ The return value of this function is the retrieval buffer."
1374 url-http-referer referer) 1373 url-http-referer referer)
1375 1374
1376 (set-process-buffer connection buffer) 1375 (set-process-buffer connection buffer)
1377 (set-process-filter connection 'url-http-generic-filter) 1376 (set-process-filter connection #'url-http-generic-filter)
1378 (pcase (process-status connection) 1377 (pcase (process-status connection)
1379 ('connect 1378 ('connect
1380 ;; Asynchronous connection 1379 ;; Asynchronous connection
@@ -1388,12 +1387,12 @@ The return value of this function is the retrieval buffer."
1388 (url-type url-current-object))) 1387 (url-type url-current-object)))
1389 (url-https-proxy-connect connection) 1388 (url-https-proxy-connect connection)
1390 (set-process-sentinel connection 1389 (set-process-sentinel connection
1391 'url-http-end-of-document-sentinel) 1390 #'url-http-end-of-document-sentinel)
1392 (process-send-string connection (url-http-create-request))))))) 1391 (process-send-string connection (url-http-create-request)))))))
1393 buffer)) 1392 buffer))
1394 1393
1395(defun url-https-proxy-connect (connection) 1394(defun url-https-proxy-connect (connection)
1396 (setq url-http-after-change-function 'url-https-proxy-after-change-function) 1395 (setq url-http-after-change-function #'url-https-proxy-after-change-function)
1397 (process-send-string 1396 (process-send-string
1398 connection 1397 connection
1399 (format 1398 (format
@@ -1441,7 +1440,7 @@ The return value of this function is the retrieval buffer."
1441 (with-current-buffer process-buffer (erase-buffer)) 1440 (with-current-buffer process-buffer (erase-buffer))
1442 (set-process-buffer tls-connection process-buffer) 1441 (set-process-buffer tls-connection process-buffer)
1443 (setq url-http-after-change-function 1442 (setq url-http-after-change-function
1444 'url-http-wait-for-headers-change-function) 1443 #'url-http-wait-for-headers-change-function)
1445 (set-process-filter tls-connection 'url-http-generic-filter) 1444 (set-process-filter tls-connection 'url-http-generic-filter)
1446 (process-send-string tls-connection 1445 (process-send-string tls-connection
1447 (url-http-create-request))) 1446 (url-http-create-request)))
@@ -1510,7 +1509,7 @@ The return value of this function is the retrieval buffer."
1510;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1509;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1511(defalias 'url-http-symbol-value-in-buffer 1510(defalias 'url-http-symbol-value-in-buffer
1512 (if (fboundp 'symbol-value-in-buffer) 1511 (if (fboundp 'symbol-value-in-buffer)
1513 'symbol-value-in-buffer 1512 #'symbol-value-in-buffer
1514 (lambda (symbol buffer &optional unbound-value) 1513 (lambda (symbol buffer &optional unbound-value)
1515 "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound." 1514 "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound."
1516 (with-current-buffer buffer 1515 (with-current-buffer buffer
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index 05c3e73fb0e..492907f33ff 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -1,4 +1,4 @@
1;;; url-imap.el --- IMAP retrieval routines 1;;; url-imap.el --- IMAP retrieval routines -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -37,6 +37,9 @@
37 37
38(defconst url-imap-default-port 143 "Default IMAP port.") 38(defconst url-imap-default-port 143 "Default IMAP port.")
39 39
40(defvar imap-username)
41(defvar imap-password)
42
40(defun url-imap-open-host (host port user pass) 43(defun url-imap-open-host (host port user pass)
41 ;; xxx use user and password 44 ;; xxx use user and password
42 (if (fboundp 'nnheader-init-server-buffer) 45 (if (fboundp 'nnheader-init-server-buffer)
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 0fa9970fa47..d26562b7f10 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,4 +1,4 @@
1;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code 1;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 688f102cabd..72884c07cc9 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,4 +1,4 @@
1;;; url-mail.el --- Mail Uniform Resource Locator retrieval code 1;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -67,7 +67,7 @@
67 ;; mailto:wmperry@gnu.org 67 ;; mailto:wmperry@gnu.org
68 (setf (url-filename url) (concat (url-user url) "@" (url-filename url)))) 68 (setf (url-filename url) (concat (url-user url) "@" (url-filename url))))
69 (setq url (url-filename url)) 69 (setq url (url-filename url))
70 (let (to args source-url subject func headers-start) 70 (let (to args source-url subject headers-start) ;; func
71 (if (string-match (regexp-quote "?") url) 71 (if (string-match (regexp-quote "?") url)
72 (setq headers-start (match-end 0) 72 (setq headers-start (match-end 0)
73 to (url-unhex-string (substring url 0 (match-beginning 0))) 73 to (url-unhex-string (substring url 0 (match-beginning 0)))
@@ -76,10 +76,11 @@
76 (setq to (url-unhex-string url))) 76 (setq to (url-unhex-string url)))
77 (setq source-url (url-view-url t)) 77 (setq source-url (url-view-url t))
78 (if (and url-request-data (not (assoc "subject" args))) 78 (if (and url-request-data (not (assoc "subject" args)))
79 (setq args (cons (list "subject" 79 (push (list "subject"
80 (concat "Automatic submission from " 80 (concat "Automatic submission from "
81 url-package-name "/" 81 url-package-name "/"
82 url-package-version)) args))) 82 url-package-version))
83 args))
83 (if (and source-url (not (assoc "x-url-from" args))) 84 (if (and source-url (not (assoc "x-url-from" args)))
84 (setq args (cons (list "x-url-from" source-url) args))) 85 (setq args (cons (list "x-url-from" source-url) args)))
85 86
@@ -107,7 +108,7 @@
107 (replace-regexp-in-string "\r\n" "\n" string)) 108 (replace-regexp-in-string "\r\n" "\n" string))
108 (cdar args) "\n"))) 109 (cdar args) "\n")))
109 (url-mail-goto-field (caar args)) 110 (url-mail-goto-field (caar args))
110 (setq func (intern-soft (concat "mail-" (caar args)))) 111 ;; (setq func (intern-soft (concat "mail-" (caar args))))
111 (insert (mapconcat 'identity (cdar args) ", "))) 112 (insert (mapconcat 'identity (cdar args) ", ")))
112 (setq args (cdr args))) 113 (setq args (cdr args)))
113 ;; (url-mail-goto-field "User-Agent") 114 ;; (url-mail-goto-field "User-Agent")
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 7aad741210d..cfe7d5bc6a3 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -1,4 +1,4 @@
1;;; url-methods.el --- Load URL schemes as needed 1;;; url-methods.el --- Load URL schemes as needed -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -57,7 +57,7 @@
57 'file-exists-p 'ignore 57 'file-exists-p 'ignore
58 'file-attributes 'ignore)) 58 'file-attributes 'ignore))
59 59
60(defun url-scheme-default-loader (url &optional callback cbargs) 60(defun url-scheme-default-loader (url &optional _callback _cbargs)
61 "Signal an error for an unknown URL scheme." 61 "Signal an error for an unknown URL scheme."
62 (error "Unknown URL scheme: %s" (url-type url))) 62 (error "Unknown URL scheme: %s" (url-type url)))
63 63
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index d3db31d612a..fe2393beb64 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,4 +1,4 @@
1;;; url-misc.el --- Misc Uniform Resource Locator retrieval code 1;;; url-misc.el --- Misc Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2002, 2004-2021 Free Software Foundation, 3;; Copyright (C) 1996-1999, 2002, 2004-2021 Free Software Foundation,
4;; Inc. 4;; Inc.
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index d5f8483ab7a..585a28291ae 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,4 +1,4 @@
1;;; url-news.el --- News Uniform Resource Locator retrieval code 1;;; url-news.el --- News Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -106,7 +106,7 @@
106 ;; Find a news reference 106 ;; Find a news reference
107 (let* ((host (or (url-host url) url-news-server)) 107 (let* ((host (or (url-host url) url-news-server))
108 (port (url-port url)) 108 (port (url-port url))
109 (article-brackets nil) 109 ;; (article-brackets nil)
110 (buf nil) 110 (buf nil)
111 (article (url-unhex-string (url-filename url)))) 111 (article (url-unhex-string (url-filename url))))
112 (url-news-open-host host port (url-user url) (url-password url)) 112 (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 3c80c8059b5..0449930408d 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,4 +1,4 @@
1;;; url-nfs.el --- NFS URL interface 1;;; url-nfs.el --- NFS URL interface -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index e3ca0f66d98..d926775c48d 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,4 +1,4 @@
1;;; url-privacy.el --- Global history tracking for URL package 1;;; url-privacy.el --- Global history tracking for URL package -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
4 4
@@ -23,7 +23,7 @@
23 23
24(require 'url-vars) 24(require 'url-vars)
25 25
26(defun url-device-type (&optional device) 26(defun url-device-type (&optional _device)
27 (declare (obsolete nil "27.1")) 27 (declare (obsolete nil "27.1"))
28 (or window-system 'tty)) 28 (or window-system 'tty))
29 29
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 6bf65845098..8436c7a4be2 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -1,4 +1,4 @@
1;;; url-proxy.el --- Proxy server support 1;;; url-proxy.el --- Proxy server support -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 325d25cb8e2..5b9dd8a2682 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -1,4 +1,4 @@
1;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols 1;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2014-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
4 4
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 172a3af2b3b..8daf9f0a8e8 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
156the server. 156the server.
157If URL is a multibyte string, it will be encoded as utf-8 and 157If URL is a multibyte string, it will be encoded as utf-8 and
158URL-encoded before it's used." 158URL-encoded before it's used."
159;;; XXX: There is code in Emacs that does dynamic binding 159 ;; XXX: There is code in Emacs that does dynamic binding
160;;; of the following variables around url-retrieve: 160 ;; of the following variables around url-retrieve:
161;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets, 161 ;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
162;;; url-confirmation-func, url-cookie-multiple-line, 162 ;; url-confirmation-func, url-cookie-multiple-line,
163;;; url-cookie-{{,secure-}storage,confirmation} 163 ;; url-cookie-{{,secure-}storage,confirmation}
164;;; url-standalone-mode and url-gateway-unplugged should work as 164 ;; url-standalone-mode and url-gateway-unplugged should work as
165;;; usual. url-confirmation-func is only used in nnwarchive.el and 165 ;; usual. url-confirmation-func is only used in nnwarchive.el and
166;;; webmail.el; the latter should be updated. Is 166 ;; webmail.el; the latter should be updated. Is
167;;; url-cookie-multiple-line needed anymore? The other url-cookie-* 167 ;; url-cookie-multiple-line needed anymore? The other url-cookie-*
168;;; are (for now) only used in synchronous retrievals. 168 ;; are (for now) only used in synchronous retrievals.
169 (url-retrieve-internal url callback (cons nil cbargs) silent 169 (url-retrieve-internal url callback (cons nil cbargs) silent
170 inhibit-cookies)) 170 inhibit-cookies))
171 171
@@ -210,7 +210,7 @@ URL-encoded before it's used."
210 (asynch (url-scheme-get-property (url-type url) 'asynchronous-p))) 210 (asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
211 (if url-using-proxy 211 (if url-using-proxy
212 (setq asynch t 212 (setq asynch t
213 loader 'url-proxy)) 213 loader #'url-proxy))
214 (if asynch 214 (if asynch
215 (let ((url-current-object url)) 215 (let ((url-current-object url))
216 (setq buffer (funcall loader url callback cbargs))) 216 (setq buffer (funcall loader url callback cbargs)))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index bbb73240be2..9d0808c0435 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -300,7 +300,6 @@ See `run-hooks'."
300 (define-key map "\C-o" 'vc-dir-display-file) 300 (define-key map "\C-o" 'vc-dir-display-file)
301 (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process) 301 (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
302 (define-key map [down-mouse-3] 'vc-dir-menu) 302 (define-key map [down-mouse-3] 'vc-dir-menu)
303 (define-key map [mouse-2] 'vc-dir-toggle-mark)
304 (define-key map [follow-link] 'mouse-face) 303 (define-key map [follow-link] 'mouse-face)
305 (define-key map "x" 'vc-dir-hide-up-to-date) 304 (define-key map "x" 'vc-dir-hide-up-to-date)
306 (define-key map [?\C-k] 'vc-dir-kill-line) 305 (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
1085 as the current file 1084 as the current file
1086 - if the cursor is on a directory: unmark all child files 1085 - if the cursor is on a directory: unmark all child files
1087 - with a prefix argument: unmark all files 1086 - with a prefix argument: unmark all files
1088mouse-2 - toggles the mark state
1089 1087
1090VC commands 1088VC commands
1091VC commands in the `C-x v' prefix can be used. 1089VC 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:
1392 (propertize "Please add backend specific headers here. It's easy!" 1390 (propertize "Please add backend specific headers here. It's easy!"
1393 'face 'font-lock-warning-face))) 1391 'face 'font-lock-warning-face)))
1394 1392
1393(defvar vc-dir-status-mouse-map
1394 (let ((map (make-sparse-keymap)))
1395 (define-key map [mouse-2] 'vc-dir-toggle-mark)
1396 map)
1397 "Local keymap for toggling mark.")
1398
1395(defvar vc-dir-filename-mouse-map 1399(defvar vc-dir-filename-mouse-map
1396 (let ((map (make-sparse-keymap))) 1400 (let ((map (make-sparse-keymap)))
1397 (define-key map [mouse-2] 'vc-dir-find-file-other-window) 1401 (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:
1418 ((memq state '(missing conflict)) 'font-lock-warning-face) 1422 ((memq state '(missing conflict)) 'font-lock-warning-face)
1419 ((eq state 'edited) 'font-lock-constant-face) 1423 ((eq state 'edited) 'font-lock-constant-face)
1420 (t 'font-lock-variable-name-face)) 1424 (t 'font-lock-variable-name-face))
1421 'mouse-face 'highlight) 1425 'mouse-face 'highlight
1426 'keymap vc-dir-status-mouse-map)
1422 " " 1427 " "
1423 (propertize 1428 (propertize
1424 (format "%s" filename) 1429 (format "%s" filename)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index a9ee28e3aad..94fac3a83b8 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -481,7 +481,8 @@ or an empty string if none."
481 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) 481 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
482 ((eq state 'missing) 'font-lock-warning-face) 482 ((eq state 'missing) 'font-lock-warning-face)
483 (t 'font-lock-variable-name-face)) 483 (t 'font-lock-variable-name-face))
484 'mouse-face 'highlight) 484 'mouse-face 'highlight
485 'keymap vc-dir-status-mouse-map)
485 " " (vc-git-permissions-as-string old-perm new-perm) 486 " " (vc-git-permissions-as-string old-perm new-perm)
486 " " 487 " "
487 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info)) 488 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index c4b82ab11eb..1d163a64ab2 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1166,7 +1166,8 @@ hg binary."
1166;; Modeled after the similar function in vc-bzr.el 1166;; Modeled after the similar function in vc-bzr.el
1167(defun vc-hg-rename-file (old new) 1167(defun vc-hg-rename-file (old new)
1168 "Rename file from OLD to NEW using `hg mv'." 1168 "Rename file from OLD to NEW using `hg mv'."
1169 (vc-hg-command nil 0 new "mv" old)) 1169 (vc-hg-command nil 0 (expand-file-name new) "mv"
1170 (expand-file-name old)))
1170 1171
1171(defun vc-hg-register (files &optional _comment) 1172(defun vc-hg-register (files &optional _comment)
1172 "Register FILES under hg. COMMENT is ignored." 1173 "Register FILES under hg. COMMENT is ignored."
diff --git a/lisp/wdired.el b/lisp/wdired.el
index f4a0b6d9a93..a096abd106f 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -27,26 +27,26 @@
27;; wdired.el (the "w" is for writable) provides an alternative way of 27;; wdired.el (the "w" is for writable) provides an alternative way of
28;; renaming files. 28;; renaming files.
29;; 29;;
30;; Have you ever wished to use C-x r t (string-rectangle), M-% 30;; Have you ever wanted to use C-x r t (string-rectangle), M-%
31;; (query-replace), M-c (capitalize-word), etc... to change the name of 31;; (query-replace), M-c (capitalize-word), etc... to change the name of
32;; the files in a "dired" buffer? Now you can do this. All the power 32;; the files in a "dired" buffer? Now you can do this. All the power
33;; of Emacs commands are available to renaming files! 33;; of Emacs commands are available when renaming files!
34;; 34;;
35;; This package provides a function that makes the filenames of a 35;; This package provides a function that makes the filenames of a
36;; dired buffer editable, by changing the buffer mode (which inhibits 36;; dired buffer editable, by changing the buffer mode (which inhibits
37;; all of the commands of dired mode). Here you can edit the names of 37;; all of the commands of dired mode). Here you can edit the names of
38;; one or more files and directories, and when you press C-c C-c, the 38;; one or more files and directories, and when you press C-c C-c, the
39;; renaming takes effect and you are back to dired mode. 39;; renaming takes effect and you are back to dired mode.
40;; 40;;
41;; Another things you can do with WDired: 41;; Other things you can do with WDired:
42;; 42;;
43;; - To move files to another directory (by typing their path, 43;; - Move files to another directory (by typing their path,
44;; absolute or relative, as a part of the new filename). 44;; absolute or relative, as a part of the new filename).
45;; 45;;
46;; - To change the target of symbolic links. 46;; - Change the target of symbolic links.
47;; 47;;
48;; - To change the permission bits of the filenames (in systems with a 48;; - Change the permission bits of the filenames (in systems with a
49;; working unix-alike `dired-chmod-program'). See and customize the 49;; working unix-alike `dired-chmod-program'). See and customize the
50;; variable `wdired-allow-to-change-permissions'. To change a single 50;; variable `wdired-allow-to-change-permissions'. To change a single
51;; char (toggling between its two more usual values) you can press 51;; char (toggling between its two more usual values) you can press
52;; the space bar over it or left-click the mouse. To set any char to 52;; the space bar over it or left-click the mouse. To set any char to
@@ -56,7 +56,7 @@
56;; the change would affect to their targets, and this would not be 56;; the change would affect to their targets, and this would not be
57;; WYSIWYG :-). 57;; WYSIWYG :-).
58;; 58;;
59;; - To mark files for deletion, by deleting their whole filename. 59;; - Mark files for deletion, by deleting their whole filename.
60 60
61;;; Usage: 61;;; Usage:
62 62
@@ -68,8 +68,8 @@
68 68
69;;; Change Log: 69;;; Change Log:
70 70
71;; Google is your friend (previous versions with complete changelogs 71;; Previous versions with complete changelogs were posted to
72;; were posted to gnu.emacs.sources) 72;; gnu.emacs.sources.
73 73
74;;; Code: 74;;; Code:
75 75
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 7b8e5b7cc11..22bfae06975 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1000,8 +1000,8 @@ See also `whitespace-style', `whitespace-newline' and
1000 ((eq whitespace-global-modes t)) 1000 ((eq whitespace-global-modes t))
1001 ((listp whitespace-global-modes) 1001 ((listp whitespace-global-modes)
1002 (if (eq (car-safe whitespace-global-modes) 'not) 1002 (if (eq (car-safe whitespace-global-modes) 'not)
1003 (not (memq major-mode (cdr whitespace-global-modes))) 1003 (not (apply #'derived-mode-p (cdr whitespace-global-modes)))
1004 (memq major-mode whitespace-global-modes))) 1004 (apply #'derived-mode-p whitespace-global-modes)))
1005 (t nil)) 1005 (t nil))
1006 ;; ...we have a display (not running a batch job) 1006 ;; ...we have a display (not running a batch job)
1007 (not noninteractive) 1007 (not noninteractive)
diff --git a/lisp/window.el b/lisp/window.el
index 0a37d16273f..d5876914201 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8196,8 +8196,8 @@ such alists.
8196If ALIST has a non-nil `inhibit-same-window' entry, the selected 8196If ALIST has a non-nil `inhibit-same-window' entry, the selected
8197window is not usable. A dedicated window is usable only if it 8197window is not usable. A dedicated window is usable only if it
8198already shows BUFFER. If ALIST contains a `previous-window' 8198already shows BUFFER. If ALIST contains a `previous-window'
8199entry, the window specified by that entry is usable even if it 8199entry, the window specified by that entry (either a variable
8200never showed BUFFER before. 8200or a value) is usable even if it never showed BUFFER before.
8201 8201
8202If ALIST contains a `reusable-frames' entry, its value determines 8202If ALIST contains a `reusable-frames' entry, its value determines
8203which frames to search for a usable window: 8203which frames to search for a usable window:
@@ -8239,6 +8239,7 @@ indirectly called by the latter."
8239 0) 8239 0)
8240 (display-buffer-reuse-frames 0) 8240 (display-buffer-reuse-frames 0)
8241 (t (last-nonminibuffer-frame)))) 8241 (t (last-nonminibuffer-frame))))
8242 (previous-window (cdr (assq 'previous-window alist)))
8242 best-window second-best-window window) 8243 best-window second-best-window window)
8243 ;; Scan windows whether they have shown the buffer recently. 8244 ;; Scan windows whether they have shown the buffer recently.
8244 (catch 'best 8245 (catch 'best
@@ -8252,7 +8253,9 @@ indirectly called by the latter."
8252 (throw 'best t))))) 8253 (throw 'best t)))))
8253 ;; When ALIST has a `previous-window' entry, that entry may override 8254 ;; When ALIST has a `previous-window' entry, that entry may override
8254 ;; anything we found so far. 8255 ;; anything we found so far.
8255 (when (and (setq window (cdr (assq 'previous-window alist))) 8256 (when (and previous-window (boundp previous-window))
8257 (setq previous-window (symbol-value previous-window)))
8258 (when (and (setq window previous-window)
8256 (window-live-p window) 8259 (window-live-p window)
8257 (or (eq buffer (window-buffer window)) 8260 (or (eq buffer (window-buffer window))
8258 (not (window-dedicated-p window)))) 8261 (not (window-dedicated-p window))))
diff --git a/src/cmds.c b/src/cmds.c
index 1547db80e88..c8a96d918cd 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -99,6 +99,7 @@ DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
99Precisely, if point is on line I, move to the start of line I + N 99Precisely, if point is on line I, move to the start of line I + N
100\("start of line" in the logical order). 100\("start of line" in the logical order).
101If there isn't room, go as far as possible (no error). 101If there isn't room, go as far as possible (no error).
102Interactively, N is the numeric prefix argument and defaults to 1.
102 103
103Returns the count of lines left to move. If moving forward, 104Returns the count of lines left to move. If moving forward,
104that is N minus number of lines moved; if backward, N plus number 105that is N minus number of lines moved; if backward, N plus number
diff --git a/src/dispextern.h b/src/dispextern.h
index 3ad98b8344e..f4e872644db 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1826,6 +1826,7 @@ enum face_id
1826 WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID, 1826 WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID,
1827 WINDOW_DIVIDER_LAST_PIXEL_FACE_ID, 1827 WINDOW_DIVIDER_LAST_PIXEL_FACE_ID,
1828 INTERNAL_BORDER_FACE_ID, 1828 INTERNAL_BORDER_FACE_ID,
1829 CHILD_FRAME_BORDER_FACE_ID,
1829 TAB_BAR_FACE_ID, 1830 TAB_BAR_FACE_ID,
1830 TAB_LINE_FACE_ID, 1831 TAB_LINE_FACE_ID,
1831 BASIC_FACE_ID_SENTINEL 1832 BASIC_FACE_ID_SENTINEL
diff --git a/src/editfns.c b/src/editfns.c
index 6f04c998915..e3285494c14 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/>. */
52#include "window.h" 52#include "window.h"
53#include "blockinput.h" 53#include "blockinput.h"
54 54
55#ifdef WINDOWSNT
56# include "w32common.h"
57#endif
55static void update_buffer_properties (ptrdiff_t, ptrdiff_t); 58static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
56static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool); 59static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
57 60
@@ -121,12 +124,14 @@ init_editfns (void)
121 else if (NILP (Vuser_full_name)) 124 else if (NILP (Vuser_full_name))
122 Vuser_full_name = build_string ("unknown"); 125 Vuser_full_name = build_string ("unknown");
123 126
124#ifdef HAVE_SYS_UTSNAME_H 127#if defined HAVE_SYS_UTSNAME_H
125 { 128 {
126 struct utsname uts; 129 struct utsname uts;
127 uname (&uts); 130 uname (&uts);
128 Voperating_system_release = build_string (uts.release); 131 Voperating_system_release = build_string (uts.release);
129 } 132 }
133#elif defined WINDOWSNT
134 Voperating_system_release = build_string (w32_version_string ());
130#else 135#else
131 Voperating_system_release = Qnil; 136 Voperating_system_release = Qnil;
132#endif 137#endif
@@ -4479,7 +4484,9 @@ functions if all the text being accessed has this property. */);
4479 doc: /* The user's name, based upon the real uid only. */); 4484 doc: /* The user's name, based upon the real uid only. */);
4480 4485
4481 DEFVAR_LISP ("operating-system-release", Voperating_system_release, 4486 DEFVAR_LISP ("operating-system-release", Voperating_system_release,
4482 doc: /* The release of the operating system Emacs is running on. */); 4487 doc: /* The kernel version of the operating system on which Emacs is running.
4488The value is a string. It can also be nil if Emacs doesn't
4489know how to get the kernel version on the underlying OS. */);
4483 4490
4484 DEFVAR_BOOL ("binary-as-unsigned", 4491 DEFVAR_BOOL ("binary-as-unsigned",
4485 binary_as_unsigned, 4492 binary_as_unsigned,
diff --git a/src/emacs.c b/src/emacs.c
index c6581bba37e..acf8a17a12a 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -186,7 +186,8 @@ bool build_details;
186/* Name for the server started by the daemon.*/ 186/* Name for the server started by the daemon.*/
187static char *daemon_name; 187static char *daemon_name;
188 188
189/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). */ 189/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background).
190 A negative value means the daemon initialization was already done. */
190int daemon_type; 191int daemon_type;
191 192
192#ifndef WINDOWSNT 193#ifndef WINDOWSNT
@@ -2387,7 +2388,10 @@ all of which are called before Emacs is actually killed. */
2387 int exit_code; 2388 int exit_code;
2388 2389
2389#ifdef HAVE_LIBSYSTEMD 2390#ifdef HAVE_LIBSYSTEMD
2390 sd_notify(0, "STOPPING=1"); 2391 /* Notify systemd we are shutting down, but only if we have notified
2392 it about startup. */
2393 if (daemon_type == -1)
2394 sd_notify(0, "STOPPING=1");
2391#endif /* HAVE_LIBSYSTEMD */ 2395#endif /* HAVE_LIBSYSTEMD */
2392 2396
2393 /* Fsignal calls emacs_abort () if it sees that waiting_for_input is 2397 /* Fsignal calls emacs_abort () if it sees that waiting_for_input is
@@ -2903,7 +2907,7 @@ from the parent process and its tty file descriptors. */)
2903 } 2907 }
2904 2908
2905 /* Set it to an invalid value so we know we've already run this function. */ 2909 /* Set it to an invalid value so we know we've already run this function. */
2906 daemon_type = -1; 2910 daemon_type = -daemon_type;
2907 2911
2908#else /* WINDOWSNT */ 2912#else /* WINDOWSNT */
2909 /* Signal the waiting emacsclient process. */ 2913 /* Signal the waiting emacsclient process. */
diff --git a/src/fns.c b/src/fns.c
index 7ab2e8f1a03..bd4afa0c4e9 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)
4599EMACS_UINT 4599EMACS_UINT
4600hash_string (char const *ptr, ptrdiff_t len) 4600hash_string (char const *ptr, ptrdiff_t len)
4601{ 4601{
4602 EMACS_UINT const *p = (EMACS_UINT const *) ptr; 4602 char const *p = ptr;
4603 EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len); 4603 char const *end = ptr + len;
4604 EMACS_UINT hash = len; 4604 EMACS_UINT hash = len;
4605 /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, 4605 /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course,
4606 * but dividing by 8 is cheaper. */ 4606 * but dividing by 8 is cheaper. */
4607 ptrdiff_t step = 1 + ((end - p) >> 3); 4607 ptrdiff_t step = sizeof hash + ((end - p) >> 3);
4608 4608
4609 /* Beware: `end` might be unaligned, so `p < end` is not always the same 4609 while (p + sizeof hash <= end)
4610 * as `p <= end - 1`. */
4611 while (p <= end - 1)
4612 { 4610 {
4613 EMACS_UINT c = *p; 4611 EMACS_UINT c;
4612 /* We presume that the compiler will replace this `memcpy` with
4613 a single load/move instruction when applicable. */
4614 memcpy (&c, p, sizeof hash);
4614 p += step; 4615 p += step;
4615 hash = sxhash_combine (hash, c); 4616 hash = sxhash_combine (hash, c);
4616 } 4617 }
4617 if (p < end) 4618 /* A few last bytes may remain (smaller than an EMACS_UINT). */
4618 { /* A few last bytes remain (smaller than an EMACS_UINT). */ 4619 /* FIXME: We could do this without a loop, but it'd require
4619 /* FIXME: We could do this without a loop, but it'd require 4620 endian-dependent code :-( */
4620 endian-dependent code :-( */ 4621 while (p < end)
4621 char const *p1 = (char const *)p; 4622 {
4622 char const *end1 = (char const *)end; 4623 unsigned char c = *p++;
4623 do 4624 hash = sxhash_combine (hash, c);
4624 {
4625 unsigned char c = *p1++;
4626 hash = sxhash_combine (hash, c);
4627 }
4628 while (p1 < end1);
4629 } 4625 }
4630 4626
4631 return hash; 4627 return hash;
diff --git a/src/frame.c b/src/frame.c
index 599c4075f88..a2167ce1e49 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3543,6 +3543,13 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0,
3543 return make_fixnum (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame))); 3543 return make_fixnum (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
3544} 3544}
3545 3545
3546DEFUN ("frame-child-frame-border-width", Fframe_child_frame_border_width, Sframe_child_frame_border_width, 0, 1, 0,
3547 doc: /* Return width of FRAME's child-frame border in pixels. */)
3548 (Lisp_Object frame)
3549{
3550 return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame)));
3551}
3552
3546DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0, 3553DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0,
3547 doc: /* Return width of FRAME's internal border in pixels. */) 3554 doc: /* Return width of FRAME's internal border in pixels. */)
3548 (Lisp_Object frame) 3555 (Lisp_Object frame)
@@ -3759,6 +3766,7 @@ static const struct frame_parm_table frame_parms[] =
3759 {"foreground-color", -1}, 3766 {"foreground-color", -1},
3760 {"icon-name", SYMBOL_INDEX (Qicon_name)}, 3767 {"icon-name", SYMBOL_INDEX (Qicon_name)},
3761 {"icon-type", SYMBOL_INDEX (Qicon_type)}, 3768 {"icon-type", SYMBOL_INDEX (Qicon_type)},
3769 {"child-frame-border-width", SYMBOL_INDEX (Qchild_frame_border_width)},
3762 {"internal-border-width", SYMBOL_INDEX (Qinternal_border_width)}, 3770 {"internal-border-width", SYMBOL_INDEX (Qinternal_border_width)},
3763 {"right-divider-width", SYMBOL_INDEX (Qright_divider_width)}, 3771 {"right-divider-width", SYMBOL_INDEX (Qright_divider_width)},
3764 {"bottom-divider-width", SYMBOL_INDEX (Qbottom_divider_width)}, 3772 {"bottom-divider-width", SYMBOL_INDEX (Qbottom_divider_width)},
@@ -4302,6 +4310,8 @@ gui_report_frame_params (struct frame *f, Lisp_Object *alistptr)
4302 4310
4303 store_in_alist (alistptr, Qborder_width, 4311 store_in_alist (alistptr, Qborder_width,
4304 make_fixnum (f->border_width)); 4312 make_fixnum (f->border_width));
4313 store_in_alist (alistptr, Qchild_frame_border_width,
4314 make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f)));
4305 store_in_alist (alistptr, Qinternal_border_width, 4315 store_in_alist (alistptr, Qinternal_border_width,
4306 make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f))); 4316 make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)));
4307 store_in_alist (alistptr, Qright_divider_width, 4317 store_in_alist (alistptr, Qright_divider_width,
@@ -5999,6 +6009,7 @@ syms_of_frame (void)
5999 DEFSYM (Qhorizontal_scroll_bars, "horizontal-scroll-bars"); 6009 DEFSYM (Qhorizontal_scroll_bars, "horizontal-scroll-bars");
6000 DEFSYM (Qicon_name, "icon-name"); 6010 DEFSYM (Qicon_name, "icon-name");
6001 DEFSYM (Qicon_type, "icon-type"); 6011 DEFSYM (Qicon_type, "icon-type");
6012 DEFSYM (Qchild_frame_border_width, "child-frame-border-width");
6002 DEFSYM (Qinternal_border_width, "internal-border-width"); 6013 DEFSYM (Qinternal_border_width, "internal-border-width");
6003 DEFSYM (Qleft_fringe, "left-fringe"); 6014 DEFSYM (Qleft_fringe, "left-fringe");
6004 DEFSYM (Qline_spacing, "line-spacing"); 6015 DEFSYM (Qline_spacing, "line-spacing");
@@ -6423,6 +6434,7 @@ iconify the top level frame instead. */);
6423 defsubr (&Sscroll_bar_width); 6434 defsubr (&Sscroll_bar_width);
6424 defsubr (&Sscroll_bar_height); 6435 defsubr (&Sscroll_bar_height);
6425 defsubr (&Sfringe_width); 6436 defsubr (&Sfringe_width);
6437 defsubr (&Sframe_child_frame_border_width);
6426 defsubr (&Sframe_internal_border_width); 6438 defsubr (&Sframe_internal_border_width);
6427 defsubr (&Sright_divider_width); 6439 defsubr (&Sright_divider_width);
6428 defsubr (&Sbottom_divider_width); 6440 defsubr (&Sbottom_divider_width);
diff --git a/src/frame.h b/src/frame.h
index 8cf41dc0046..9b0852c7b9c 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -534,6 +534,10 @@ struct frame
534 /* Border width of the frame window as known by the (X) window system. */ 534 /* Border width of the frame window as known by the (X) window system. */
535 int border_width; 535 int border_width;
536 536
537 /* Width of child frames' internal border. Acts as
538 internal_border_width for child frames. */
539 int child_frame_border_width;
540
537 /* Width of the internal border. This is a line of background color 541 /* Width of the internal border. This is a line of background color
538 just inside the window's border. When the frame is selected, 542 just inside the window's border. When the frame is selected,
539 a highlighting is displayed inside the internal border. */ 543 a highlighting is displayed inside the internal border. */
@@ -1432,11 +1436,27 @@ FRAME_TOTAL_FRINGE_WIDTH (struct frame *f)
1432 return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f); 1436 return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
1433} 1437}
1434 1438
1435/* Pixel-width of internal border lines. */ 1439INLINE int
1440FRAME_CHILD_FRAME_BORDER_WIDTH (struct frame *f)
1441{
1442 return frame_dimension (f->child_frame_border_width);
1443}
1444
1445/* Pixel-width of internal border. Uses child_frame_border_width for
1446 child frames if possible, and falls back on internal_border_width
1447 otherwise. */
1436INLINE int 1448INLINE int
1437FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) 1449FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
1438{ 1450{
1451#ifdef HAVE_WINDOW_SYSTEM
1452 return FRAME_PARENT_FRAME(f)
1453 ? (f->child_frame_border_width
1454 ? FRAME_CHILD_FRAME_BORDER_WIDTH(f)
1455 : frame_dimension (f->internal_border_width))
1456 : frame_dimension (f->internal_border_width);
1457#else
1439 return frame_dimension (f->internal_border_width); 1458 return frame_dimension (f->internal_border_width);
1459#endif
1440} 1460}
1441 1461
1442/* Pixel-size of window divider lines. */ 1462/* Pixel-size of window divider lines. */
diff --git a/src/nsfns.m b/src/nsfns.m
index 24ea7d7f63b..c383e2f7ecf 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)
687 } 687 }
688} 688}
689 689
690static void
691ns_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
692{
693 int old_width = FRAME_CHILD_FRAME_BORDER_WIDTH (f);
694 int new_width = check_int_nonnegative (arg);
695
696 if (new_width == old_width)
697 return;
698 f->child_frame_border_width = new_width;
699
700 if (FRAME_NATIVE_WINDOW (f) != 0)
701 adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width);
702
703 SET_FRAME_GARBAGED (f);
704}
690 705
691static void 706static void
692ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) 707ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
@@ -912,6 +927,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
912 ns_set_foreground_color, 927 ns_set_foreground_color,
913 ns_set_icon_name, 928 ns_set_icon_name,
914 ns_set_icon_type, 929 ns_set_icon_type,
930 ns_set_child_frame_border_width,
915 ns_set_internal_border_width, 931 ns_set_internal_border_width,
916 gui_set_right_divider_width, /* generic OK */ 932 gui_set_right_divider_width, /* generic OK */
917 gui_set_bottom_divider_width, /* generic OK */ 933 gui_set_bottom_divider_width, /* generic OK */
@@ -1197,6 +1213,9 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1197 gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2), 1213 gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2),
1198 "internalBorderWidth", "InternalBorderWidth", 1214 "internalBorderWidth", "InternalBorderWidth",
1199 RES_TYPE_NUMBER); 1215 RES_TYPE_NUMBER);
1216 gui_default_parameter (f, parms, Qchild_frame_border_width, make_fixnum (2),
1217 "childFrameBorderWidth", "childFrameBorderWidth",
1218 RES_TYPE_NUMBER);
1200 gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), 1219 gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0),
1201 NULL, NULL, RES_TYPE_NUMBER); 1220 NULL, NULL, RES_TYPE_NUMBER);
1202 gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), 1221 gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0),
diff --git a/src/nsterm.m b/src/nsterm.m
index df3934c5c34..1b2328628ee 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -3037,9 +3037,13 @@ ns_clear_under_internal_border (struct frame *f)
3037 NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge}; 3037 NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge};
3038 3038
3039 int face_id = 3039 int face_id =
3040 !NILP (Vface_remapping_alist) 3040 (FRAME_PARENT_FRAME (f)
3041 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) 3041 ? (!NILP (Vface_remapping_alist)
3042 : INTERNAL_BORDER_FACE_ID; 3042 ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
3043 : CHILD_FRAME_BORDER_FACE_ID)
3044 : (!NILP (Vface_remapping_alist)
3045 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
3046 : INTERNAL_BORDER_FACE_ID));
3043 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); 3047 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
3044 3048
3045 if (!face) 3049 if (!face)
diff --git a/src/process.c b/src/process.c
index 1df4ed9ce03..3beb9cf7146 100644
--- a/src/process.c
+++ b/src/process.c
@@ -7217,7 +7217,7 @@ child_signal_read (int fd, void *data)
7217 eassert (0 <= fd); 7217 eassert (0 <= fd);
7218 eassert (fd == child_signal_read_fd); 7218 eassert (fd == child_signal_read_fd);
7219 char dummy; 7219 char dummy;
7220 if (emacs_read (fd, &dummy, 1) < 0) 7220 if (emacs_read (fd, &dummy, 1) < 0 && errno != EAGAIN)
7221 emacs_perror ("reading from child signal FD"); 7221 emacs_perror ("reading from child signal FD");
7222} 7222}
7223#endif /* !WINDOWSNT */ 7223#endif /* !WINDOWSNT */
diff --git a/src/w32common.h b/src/w32common.h
index 90e88876aba..cbe05c5d8d1 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -50,6 +50,11 @@ extern int os_subtype;
50/* Cache system info, e.g., the NT page size. */ 50/* Cache system info, e.g., the NT page size. */
51extern void cache_system_info (void); 51extern void cache_system_info (void);
52 52
53#ifdef WINDOWSNT
54/* Return a static buffer with the MS-Windows version string. */
55extern char * w32_version_string (void);
56#endif
57
53typedef void (* VOIDFNPTR) (void); 58typedef void (* VOIDFNPTR) (void);
54 59
55/* Load a function address from a DLL. Cast the result via VOIDFNPTR 60/* Load a function address from a DLL. Cast the result via VOIDFNPTR
diff --git a/src/w32fns.c b/src/w32fns.c
index c1e18ff7fad..e93a0b85d93 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1519,9 +1519,13 @@ w32_clear_under_internal_border (struct frame *f)
1519 int width = FRAME_PIXEL_WIDTH (f); 1519 int width = FRAME_PIXEL_WIDTH (f);
1520 int height = FRAME_PIXEL_HEIGHT (f); 1520 int height = FRAME_PIXEL_HEIGHT (f);
1521 int face_id = 1521 int face_id =
1522 !NILP (Vface_remapping_alist) 1522 (FRAME_PARENT_FRAME (f)
1523 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) 1523 ? (!NILP (Vface_remapping_alist)
1524 : INTERNAL_BORDER_FACE_ID; 1524 ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
1525 : CHILD_FRAME_BORDER_FACE_ID)
1526 : (!NILP (Vface_remapping_alist)
1527 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
1528 : INTERNAL_BORDER_FACE_ID));
1525 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); 1529 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
1526 1530
1527 block_input (); 1531 block_input ();
@@ -1548,6 +1552,32 @@ w32_clear_under_internal_border (struct frame *f)
1548 } 1552 }
1549} 1553}
1550 1554
1555/**
1556 * w32_set_child_frame_border_width:
1557 *
1558 * Set width of child frame F's internal border to ARG pixels.
1559 * ARG < 0 is treated like ARG = 0.
1560 */
1561static void
1562w32_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1563{
1564 int argval = check_integer_range (arg, INT_MIN, INT_MAX);
1565 int border = max (argval, 0);
1566
1567 if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
1568 {
1569 f->child_frame_border_width = border;
1570
1571 if (FRAME_NATIVE_WINDOW (f) != 0)
1572 {
1573 adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
1574
1575 if (FRAME_VISIBLE_P (f))
1576 w32_clear_under_internal_border (f);
1577 }
1578 }
1579}
1580
1551 1581
1552/** 1582/**
1553 * w32_set_internal_border_width: 1583 * w32_set_internal_border_width:
@@ -5873,6 +5903,28 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
5873 parameters); 5903 parameters);
5874 } 5904 }
5875 5905
5906 /* Same for child frames. */
5907 if (NILP (Fassq (Qchild_frame_border_width, parameters)))
5908 {
5909 Lisp_Object value;
5910
5911 value = gui_display_get_arg (dpyinfo, parameters, Qchild_frame_border_width,
5912 "childFrameBorderWidth", "childFrameBorderWidth",
5913 RES_TYPE_NUMBER);
5914 if (! EQ (value, Qunbound))
5915 parameters = Fcons (Fcons (Qchild_frame_border_width, value),
5916 parameters);
5917
5918 }
5919
5920 gui_default_parameter (f, parameters, Qchild_frame_border_width,
5921#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
5922 make_fixnum (0),
5923#else
5924 make_fixnum (1),
5925#endif
5926 "childFrameBorderWidth", "childFrameBorderWidth",
5927 RES_TYPE_NUMBER);
5876 gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum (0), 5928 gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum (0),
5877 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER); 5929 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5878 gui_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0), 5930 gui_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0),
@@ -9428,6 +9480,18 @@ cache_system_info (void)
9428 w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS); 9480 w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
9429} 9481}
9430 9482
9483#ifdef WINDOWSNT
9484char *
9485w32_version_string (void)
9486{
9487 /* NNN.NNN.NNNNNNNNNN */
9488 static char version_string[3 + 1 + 3 + 1 + 10 + 1];
9489 _snprintf (version_string, sizeof version_string, "%d.%d.%d",
9490 w32_major_version, w32_minor_version, w32_build_number);
9491 return version_string;
9492}
9493#endif
9494
9431#ifdef EMACSDEBUG 9495#ifdef EMACSDEBUG
9432void 9496void
9433_DebPrint (const char *fmt, ...) 9497_DebPrint (const char *fmt, ...)
@@ -10232,6 +10296,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
10232 w32_set_foreground_color, 10296 w32_set_foreground_color,
10233 w32_set_icon_name, 10297 w32_set_icon_name,
10234 w32_set_icon_type, 10298 w32_set_icon_type,
10299 w32_set_child_frame_border_width,
10235 w32_set_internal_border_width, 10300 w32_set_internal_border_width,
10236 gui_set_right_divider_width, 10301 gui_set_right_divider_width,
10237 gui_set_bottom_divider_width, 10302 gui_set_bottom_divider_width,
diff --git a/src/w32term.c b/src/w32term.c
index 109aa58d732..0ee805a8526 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2404,14 +2404,29 @@ w32_draw_stretch_glyph_string (struct glyph_string *s)
2404 else if (!s->background_filled_p) 2404 else if (!s->background_filled_p)
2405 { 2405 {
2406 int background_width = s->background_width; 2406 int background_width = s->background_width;
2407 int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA); 2407 int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
2408 2408
2409 /* Don't draw into left margin, fringe or scrollbar area 2409 /* Don't draw into left fringe or scrollbar area except for
2410 except for header line and mode line. */ 2410 header line and mode line. */
2411 if (x < left_x && !s->row->mode_line_p) 2411 if (x < text_left_x && !s->row->mode_line_p)
2412 { 2412 {
2413 background_width -= left_x - x; 2413 int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
2414 x = left_x; 2414 int right_x = text_left_x;
2415
2416 if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
2417 left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
2418 else
2419 right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
2420
2421 /* Adjust X and BACKGROUND_WIDTH to fit inside the space
2422 between LEFT_X and RIGHT_X. */
2423 if (x < left_x)
2424 {
2425 background_width -= left_x - x;
2426 x = left_x;
2427 }
2428 if (x + background_width > right_x)
2429 background_width = right_x - x;
2415 } 2430 }
2416 if (background_width > 0) 2431 if (background_width > 0)
2417 w32_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); 2432 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 e1e4ff41365..11b9e1becfd 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -29813,7 +29813,8 @@ produce_stretch_glyph (struct it *it)
29813#endif /* HAVE_WINDOW_SYSTEM */ 29813#endif /* HAVE_WINDOW_SYSTEM */
29814 height = 1; 29814 height = 1;
29815 29815
29816 if (width > 0 && it->line_wrap != TRUNCATE 29816 if (width > 0
29817 && it->area == TEXT_AREA && it->line_wrap != TRUNCATE
29817 && it->current_x + width > it->last_visible_x) 29818 && it->current_x + width > it->last_visible_x)
29818 { 29819 {
29819 width = it->last_visible_x - it->current_x; 29820 width = it->last_visible_x - it->current_x;
diff --git a/src/xfaces.c b/src/xfaces.c
index 258b365eda3..12087138e51 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)
4914 case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID: name = Qwindow_divider_first_pixel; break; 4914 case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID: name = Qwindow_divider_first_pixel; break;
4915 case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID: name = Qwindow_divider_last_pixel; break; 4915 case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID: name = Qwindow_divider_last_pixel; break;
4916 case INTERNAL_BORDER_FACE_ID: name = Qinternal_border; break; 4916 case INTERNAL_BORDER_FACE_ID: name = Qinternal_border; break;
4917 case CHILD_FRAME_BORDER_FACE_ID: name = Qchild_frame_border; break;
4917 4918
4918 default: 4919 default:
4919 emacs_abort (); /* the caller is supposed to pass us a basic face id */ 4920 emacs_abort (); /* the caller is supposed to pass us a basic face id */
@@ -5620,6 +5621,7 @@ realize_basic_faces (struct frame *f)
5620 realize_named_face (f, Qwindow_divider_last_pixel, 5621 realize_named_face (f, Qwindow_divider_last_pixel,
5621 WINDOW_DIVIDER_LAST_PIXEL_FACE_ID); 5622 WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
5622 realize_named_face (f, Qinternal_border, INTERNAL_BORDER_FACE_ID); 5623 realize_named_face (f, Qinternal_border, INTERNAL_BORDER_FACE_ID);
5624 realize_named_face (f, Qchild_frame_border, CHILD_FRAME_BORDER_FACE_ID);
5623 realize_named_face (f, Qtab_bar, TAB_BAR_FACE_ID); 5625 realize_named_face (f, Qtab_bar, TAB_BAR_FACE_ID);
5624 realize_named_face (f, Qtab_line, TAB_LINE_FACE_ID); 5626 realize_named_face (f, Qtab_line, TAB_LINE_FACE_ID);
5625 5627
@@ -6973,6 +6975,7 @@ syms_of_xfaces (void)
6973 DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel"); 6975 DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel");
6974 DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel"); 6976 DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel");
6975 DEFSYM (Qinternal_border, "internal-border"); 6977 DEFSYM (Qinternal_border, "internal-border");
6978 DEFSYM (Qchild_frame_border, "child-frame-border");
6976 6979
6977 /* TTY color-related functions (defined in tty-colors.el). */ 6980 /* TTY color-related functions (defined in tty-colors.el). */
6978 DEFSYM (Qtty_color_desc, "tty-color-desc"); 6981 DEFSYM (Qtty_color_desc, "tty-color-desc");
diff --git a/src/xfns.c b/src/xfns.c
index 9ab537ca8d9..cac41ee4856 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1800,6 +1800,28 @@ x_change_tool_bar_height (struct frame *f, int height)
1800#endif /* USE_GTK */ 1800#endif /* USE_GTK */
1801} 1801}
1802 1802
1803static void
1804x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
1805{
1806 int border = check_int_nonnegative (arg);
1807
1808 if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
1809 {
1810 f->child_frame_border_width = border;
1811
1812#ifdef USE_X_TOOLKIT
1813 if (FRAME_X_OUTPUT (f)->edit_widget)
1814 widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
1815#endif
1816
1817 if (FRAME_X_WINDOW (f))
1818 {
1819 adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
1820 x_clear_under_internal_border (f);
1821 }
1822 }
1823
1824}
1803 1825
1804static void 1826static void
1805x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) 1827x_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. */)
3897 parms = Fcons (Fcons (Qinternal_border_width, value), 3919 parms = Fcons (Fcons (Qinternal_border_width, value),
3898 parms); 3920 parms);
3899 } 3921 }
3922
3923 /* Same for child frames. */
3924 if (NILP (Fassq (Qchild_frame_border_width, parms)))
3925 {
3926 Lisp_Object value;
3927
3928 value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width,
3929 "childFrameBorderWidth", "childFrameBorderWidth",
3930 RES_TYPE_NUMBER);
3931 if (! EQ (value, Qunbound))
3932 parms = Fcons (Fcons (Qchild_frame_border_width, value),
3933 parms);
3934
3935 }
3936
3937 gui_default_parameter (f, parms, Qchild_frame_border_width,
3938#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
3939 make_fixnum (0),
3940#else
3941 make_fixnum (1),
3942#endif
3943 "childFrameBorderWidth", "childFrameBorderWidth",
3944 RES_TYPE_NUMBER);
3900 gui_default_parameter (f, parms, Qinternal_border_width, 3945 gui_default_parameter (f, parms, Qinternal_border_width,
3901#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */ 3946#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
3902 make_fixnum (0), 3947 make_fixnum (0),
@@ -7762,6 +7807,7 @@ frame_parm_handler x_frame_parm_handlers[] =
7762 x_set_foreground_color, 7807 x_set_foreground_color,
7763 x_set_icon_name, 7808 x_set_icon_name,
7764 x_set_icon_type, 7809 x_set_icon_type,
7810 x_set_child_frame_border_width,
7765 x_set_internal_border_width, 7811 x_set_internal_border_width,
7766 gui_set_right_divider_width, 7812 gui_set_right_divider_width,
7767 gui_set_bottom_divider_width, 7813 gui_set_bottom_divider_width,
diff --git a/src/xterm.c b/src/xterm.c
index b8374fed8b1..744b80c68a0 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1293,9 +1293,13 @@ x_clear_under_internal_border (struct frame *f)
1293 int height = FRAME_PIXEL_HEIGHT (f); 1293 int height = FRAME_PIXEL_HEIGHT (f);
1294 int margin = FRAME_TOP_MARGIN_HEIGHT (f); 1294 int margin = FRAME_TOP_MARGIN_HEIGHT (f);
1295 int face_id = 1295 int face_id =
1296 !NILP (Vface_remapping_alist) 1296 (FRAME_PARENT_FRAME (f)
1297 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) 1297 ? (!NILP (Vface_remapping_alist)
1298 : INTERNAL_BORDER_FACE_ID; 1298 ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
1299 : CHILD_FRAME_BORDER_FACE_ID)
1300 : (!NILP (Vface_remapping_alist)
1301 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
1302 : INTERNAL_BORDER_FACE_ID));
1299 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); 1303 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
1300 1304
1301 block_input (); 1305 block_input ();
@@ -1360,9 +1364,13 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row)
1360 { 1364 {
1361 int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); 1365 int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
1362 int face_id = 1366 int face_id =
1363 !NILP (Vface_remapping_alist) 1367 (FRAME_PARENT_FRAME (f)
1364 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) 1368 ? (!NILP (Vface_remapping_alist)
1365 : INTERNAL_BORDER_FACE_ID; 1369 ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
1370 : CHILD_FRAME_BORDER_FACE_ID)
1371 : (!NILP (Vface_remapping_alist)
1372 ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
1373 : INTERNAL_BORDER_FACE_ID));
1366 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); 1374 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
1367 1375
1368 block_input (); 1376 block_input ();
@@ -3577,14 +3585,29 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
3577 else if (!s->background_filled_p) 3585 else if (!s->background_filled_p)
3578 { 3586 {
3579 int background_width = s->background_width; 3587 int background_width = s->background_width;
3580 int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA); 3588 int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
3581 3589
3582 /* Don't draw into left margin, fringe or scrollbar area 3590 /* Don't draw into left fringe or scrollbar area except for
3583 except for header line and mode line. */ 3591 header line and mode line. */
3584 if (x < left_x && !s->row->mode_line_p) 3592 if (x < text_left_x && !s->row->mode_line_p)
3585 { 3593 {
3586 background_width -= left_x - x; 3594 int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
3587 x = left_x; 3595 int right_x = text_left_x;
3596
3597 if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
3598 left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
3599 else
3600 right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
3601
3602 /* Adjust X and BACKGROUND_WIDTH to fit inside the space
3603 between LEFT_X and RIGHT_X. */
3604 if (x < left_x)
3605 {
3606 background_width -= left_x - x;
3607 x = left_x;
3608 }
3609 if (x + background_width > right_x)
3610 background_width = right_x - x;
3588 } 3611 }
3589 if (background_width > 0) 3612 if (background_width > 0)
3590 x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); 3613 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 bfab95b9381..3b6c18d9410 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -123,8 +123,9 @@ MODULES_EMACSOPT :=
123endif 123endif
124 124
125# The actual Emacs command run in the targets below. 125# The actual Emacs command run in the targets below.
126# Prevent any setting of EMACSLOADPATH in user environment causing problems. 126# Prevent any setting of EMACSLOADPATH in user environment causing problems,
127emacs = EMACSLOADPATH= \ 127# and prevent locals to influence the text of the errors we expect to receive.
128emacs = LANG=C EMACSLOADPATH= \
128 EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \ 129 EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
129 $(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT) 130 $(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT)
130 131
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 1b7beeaa366..62a42b7fe44 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -1,4 +1,4 @@
1;;; electric-tests.el --- tests for electric.el 1;;; electric-tests.el --- tests for electric.el -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2013-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
4 4
@@ -135,9 +135,11 @@ The buffer's contents should %s:
135 (length fixture) 135 (length fixture)
136 fixture 136 fixture
137 (if fixture-fn (format "\nNow call this:\n\n%s" 137 (if fixture-fn (format "\nNow call this:\n\n%s"
138 (pp-to-string fixture-fn)) "") 138 (pp-to-string fixture-fn))
139 "")
139 (if bindings (format "\nEnsure the following bindings:\n\n%s" 140 (if bindings (format "\nEnsure the following bindings:\n\n%s"
140 (pp-to-string bindings)) "") 141 (pp-to-string bindings))
142 "")
141 char 143 char
142 (if (string= fixture expected-string) "stay" "become") 144 (if (string= fixture expected-string) "stay" "become")
143 (replace-regexp-in-string "\n" "\\\\n" expected-string) 145 (replace-regexp-in-string "\n" "\\\\n" expected-string)
@@ -163,8 +165,11 @@ The buffer's contents should %s:
163 (test-in-comments t) 165 (test-in-comments t)
164 (test-in-strings t) 166 (test-in-strings t)
165 (test-in-code t) 167 (test-in-code t)
166 (fixture-fn #'(lambda () 168 ;; The semantics of CL's defmacro "default values" is subtle:
167 (electric-pair-mode 1)))) 169 ;; contrary to the actual arguments, these are evaluated (and
170 ;; are expected to return the "default form").
171 ;; `fixture-fn' contains a form whose evaluation returns a function.
172 (fixture-fn '#'electric-pair-mode))
168 `(progn 173 `(progn
169 ,@(cl-loop 174 ,@(cl-loop
170 for mode in (eval modes) ;FIXME: avoid `eval' 175 for mode in (eval modes) ;FIXME: avoid `eval'
diff --git a/test/lisp/find-cmd-tests.el b/test/lisp/find-cmd-tests.el
new file mode 100644
index 00000000000..b8e0f273988
--- /dev/null
+++ b/test/lisp/find-cmd-tests.el
@@ -0,0 +1,45 @@
1;;; find-cmd-tests.el --- tests for find-cmd.el. -*- lexical-binding: t -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Code:
21
22(require 'ert)
23(require 'find-cmd)
24
25(ert-deftest find-cmd-test-find-cmd ()
26 (should
27 (string-match
28 (rx "find " (+ any)
29 " \\( \\( -name .svn -or -name .git -or -name .CVS \\)"
30 " -prune -or -true \\)"
31 " \\( \\( \\(" " -name \\*.pl -or -name \\*.pm -or -name \\*.t \\)"
32 " -or -mtime \\+1 \\) -and \\( -fstype nfs -or -fstype ufs \\) \\) ")
33 (find-cmd '(prune (name ".svn" ".git" ".CVS"))
34 '(and (or (name "*.pl" "*.pm" "*.t")
35 (mtime "+1"))
36 (fstype "nfs" "ufs"))))))
37
38(ert-deftest find-cmd-test-find-cmd/error-unknown-atom ()
39 (should-error (find-cmd '(unknown 123))))
40
41(ert-deftest find-cmd-test-find-cmd/error-wrong-argnum ()
42 (should-error (find-cmd '(name))))
43
44(provide 'find-cmd-tests)
45;;; 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 00000000000..e0230ddee60
--- /dev/null
+++ b/test/lisp/net/sasl-cram-tests.el
@@ -0,0 +1,46 @@
1;;; sasl-cram-tests.el --- tests for sasl-cram.el -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; Author: Stefan Kangas <stefankangas@gmail.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;; Test case from RFC 2195.
25
26;;; Code:
27
28(require 'ert)
29(require 'sasl)
30(require 'sasl-cram)
31
32(ert-deftest sasl-cram-md5-response-test ()
33 ;; The following strings are taken from section 2 of RFC 2195.
34 (let ((client
35 (sasl-make-client (sasl-find-mechanism '("CRAM-MD5"))
36 "user"
37 "imap"
38 "localhost"))
39 (data (base64-decode-string "PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+"))
40 (sasl-read-passphrase
41 (lambda (_prompt) (copy-sequence "tanstaaftanstaaf"))))
42 (should (equal (sasl-cram-md5-response client (vector nil data))
43 "user b913a602c7eda7a495b4e6e7334d3890"))))
44
45(provide 'sasl-cram-tests)
46;;; 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 00000000000..dab40754c00
--- /dev/null
+++ b/test/lisp/net/sasl-tests.el
@@ -0,0 +1,59 @@
1;;; sasl-tests.el --- tests for sasl.el -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; Author: Stefan Kangas <stefankangas@gmail.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;;; Code:
25
26(require 'ert)
27(require 'sasl)
28
29(ert-deftest sasl-test-make-client ()
30 (let ((client (sasl-make-client 'foo 'bar 'baz 'zut)))
31 (should (eq (sasl-client-mechanism client) 'foo))
32 (should (eq (sasl-client-name client) 'bar))
33 (should (eq (sasl-client-service client) 'baz))
34 (should (eq (sasl-client-server client) 'zut))))
35
36(ert-deftest sasl-test-client-set-properties ()
37 (let ((client (sasl-make-client 'foo 'bar 'baz 'zut)))
38 (sasl-client-set-property client 'foo 'bar)
39 (should (eq (sasl-client-property client 'foo) 'bar))))
40
41(ert-deftest sasl-test-step-data ()
42 (let ((step [nil nil]))
43 (sasl-step-set-data step "foo")
44 (should (equal (sasl-step-data step) "foo"))))
45
46(ert-deftest sasl-test-unique-id ()
47 (should (stringp (sasl-unique-id)))
48 (should-not (equal (sasl-unique-id) (sasl-unique-id))))
49
50(ert-deftest sasl-test-find-mechanism ()
51 (should (sasl-find-mechanism '("ANONYMOUS")))
52 (should-not (sasl-find-mechanism '("nonexistent mechanism"))))
53
54(ert-deftest sasl-test-mechanism-name ()
55 (let ((mechanism (sasl-find-mechanism '("ANONYMOUS"))))
56 (should (equal (sasl-mechanism-name mechanism) "ANONYMOUS"))))
57
58(provide 'sasl-tests)
59;;; sasl-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7757c55c16b..19a40fdf06c 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'."
3192(ert-deftest tramp-test17-insert-directory-one-file () 3192(ert-deftest tramp-test17-insert-directory-one-file ()
3193 "Check `insert-directory' inside directory listing." 3193 "Check `insert-directory' inside directory listing."
3194 (skip-unless (tramp--test-enabled)) 3194 (skip-unless (tramp--test-enabled))
3195 ;; Relative file names in dired are not supported in tramp-crypt.el.
3196 (skip-unless (not (tramp--test-crypt-p)))
3195 3197
3196 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) 3198 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
3197 (let* ((tmp-name1 3199 (let* ((tmp-name1
@@ -5793,7 +5795,9 @@ Additionally, ls does not support \"--dired\"."
5793 (and (tramp--test-sh-p) 5795 (and (tramp--test-sh-p)
5794 (with-temp-buffer 5796 (with-temp-buffer
5795 ;; We must refill the cache. `insert-directory' does it. 5797 ;; We must refill the cache. `insert-directory' does it.
5796 (insert-directory tramp-test-temporary-file-directory "-al") 5798 ;; This fails for tramp-crypt.el, so we ignore that.
5799 (ignore-errors
5800 (insert-directory tramp-test-temporary-file-directory "-al"))
5797 (not (tramp-get-connection-property tramp-test-vec "ls--dired" nil))))) 5801 (not (tramp-get-connection-property tramp-test-vec "ls--dired" nil)))))
5798 5802
5799(defun tramp--test-share-p () 5803(defun tramp--test-share-p ()
@@ -6033,13 +6037,13 @@ This requires restrictions of file name syntax."
6033 (let ((files 6037 (let ((files
6034 (list 6038 (list
6035 (cond ((or (tramp--test-ange-ftp-p) 6039 (cond ((or (tramp--test-ange-ftp-p)
6040 (tramp--test-docker-p)
6036 (tramp--test-gvfs-p) 6041 (tramp--test-gvfs-p)
6037 (tramp--test-rclone-p) 6042 (tramp--test-rclone-p)
6038 (tramp--test-sudoedit-p) 6043 (tramp--test-sudoedit-p)
6039 (tramp--test-windows-nt-or-smb-p)) 6044 (tramp--test-windows-nt-or-smb-p))
6040 "foo bar baz") 6045 "foo bar baz")
6041 ((or (tramp--test-adb-p) 6046 ((or (tramp--test-adb-p)
6042 (tramp--test-docker-p)
6043 (eq system-type 'cygwin)) 6047 (eq system-type 'cygwin))
6044 " foo bar baz ") 6048 " foo bar baz ")
6045 ((tramp--test-sh-no-ls--dired-p) 6049 ((tramp--test-sh-no-ls--dired-p)
diff --git a/test/lisp/progmodes/asm-mode-tests.el b/test/lisp/progmodes/asm-mode-tests.el
index 6ae4fdf5850..87872179d93 100644
--- a/test/lisp/progmodes/asm-mode-tests.el
+++ b/test/lisp/progmodes/asm-mode-tests.el
@@ -69,4 +69,14 @@
69 (should (string-match-p ";;; \nlabel:" (buffer-string))) 69 (should (string-match-p ";;; \nlabel:" (buffer-string)))
70 (should (= (current-column) 4)))) 70 (should (= (current-column) 4))))
71 71
72(ert-deftest asm-mode-tests-fill-comment ()
73 (asm-mode-tests--with-temp-buffer
74 (call-interactively #'comment-dwim)
75 (insert "Pellentesque condimentum, magna ut suscipit hendrerit, \
76ipsum augue ornare nulla, non luctus diam neque sit amet urna.")
77 (call-interactively #'fill-paragraph)
78 (should (equal (buffer-string) "\t;; Pellentesque condimentum, \
79magna ut suscipit hendrerit,\n\t;; ipsum augue ornare nulla, non \
80luctus diam neque sit amet\n\t;; urna."))))
81
72;;; asm-mode-tests.el ends here 82;;; 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 0da0e393535..badcad670c2 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -864,7 +864,6 @@ to (xref-elisp-test-descr-to-target xref)."
864 'nil))) 864 'nil)))
865 865
866(ert-deftest test-elisp-font-keywords-2 () 866(ert-deftest test-elisp-font-keywords-2 ()
867 :expected-result :failed ; FIXME bug#43265
868 (should (eq (test--font '(condition-case nil 867 (should (eq (test--font '(condition-case nil
869 (foo) 868 (foo)
870 (error (when a b))) 869 (error (when a b)))
@@ -872,12 +871,11 @@ to (xref-elisp-test-descr-to-target xref)."
872 'font-lock-keyword-face))) 871 'font-lock-keyword-face)))
873 872
874(ert-deftest test-elisp-font-keywords-3 () 873(ert-deftest test-elisp-font-keywords-3 ()
875 :expected-result :failed ; FIXME bug#43265
876 (should (eq (test--font '(setq a '(if when zot)) 874 (should (eq (test--font '(setq a '(if when zot))
877 "(\\(if\\)") 875 "(\\(if\\)")
878 nil))) 876 nil)))
879 877
880(ert-deftest test-elisp-font-keywords-if () 878(ert-deftest test-elisp-font-keywords-4 ()
881 :expected-result :failed ; FIXME bug#43265 879 :expected-result :failed ; FIXME bug#43265
882 (should (eq (test--font '(condition-case nil 880 (should (eq (test--font '(condition-case nil
883 (foo) 881 (foo)
@@ -885,5 +883,12 @@ to (xref-elisp-test-descr-to-target xref)."
885 "(\\(if\\)") 883 "(\\(if\\)")
886 nil))) 884 nil)))
887 885
886(ert-deftest test-elisp-font-keywords-5 ()
887 (should (eq (test--font '(condition-case (when a)
888 (foo)
889 (error t))
890 "(\\(when\\)")
891 nil)))
892
888(provide 'elisp-mode-tests) 893(provide 'elisp-mode-tests)
889;;; elisp-mode-tests.el ends here 894;;; elisp-mode-tests.el ends here
diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh
index dc184ea0d77..bd4a74f7054 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
6toto=$(grep hello foo | 6toto=$(grep hello foo |
7 wc) 7 wc)
8 8
9myfun () {
10 for ((it=0; it<${limit}; ++it))
11 {
12 echo "whatever $it"
13 }
14}
15
9# adsgsdg 16# adsgsdg
10 17
11if foo; then 18if foo; then