aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2020-03-29 12:31:24 +0100
committerAndrea Corallo2020-03-29 12:31:24 +0100
commit00ee320a620704ae12a1e2104c2d08bf8bbdf0c9 (patch)
tree498c59219b572c89e10f9521b54c98896cb52ca9
parent530faee2752c7b316fa21f2ac4d1266d3e7a38e6 (diff)
parent76b3bd8cbb9a0a01941d9c1766c054960e4bfd97 (diff)
downloademacs-00ee320a620704ae12a1e2104c2d08bf8bbdf0c9.tar.gz
emacs-00ee320a620704ae12a1e2104c2d08bf8bbdf0c9.zip
Merge remote-tracking branch 'savannah/master' into HEAD
-rwxr-xr-xadmin/merge-gnulib4
-rw-r--r--doc/emacs/building.texi28
-rw-r--r--doc/lispref/internals.texi14
-rw-r--r--doc/lispref/processes.texi1
-rw-r--r--etc/NEWS77
-rw-r--r--lib-src/emacsclient.c2
-rw-r--r--lib/at-func.c2
-rw-r--r--lib/canonicalize-lgpl.c2
-rw-r--r--lib/dosname.h52
-rw-r--r--lib/filename.h110
-rw-r--r--lib/getopt-pfx-core.h8
-rw-r--r--lib/gnulib.mk.in20
-rw-r--r--lisp/char-fold.el6
-rw-r--r--lisp/dired.el33
-rw-r--r--lisp/emacs-lisp/cl-macs.el5
-rw-r--r--lisp/emacs-lisp/timer-list.el15
-rw-r--r--lisp/gnus/gnus-registry.el89
-rw-r--r--lisp/image/gravatar.el43
-rw-r--r--lisp/isearch.el12
-rw-r--r--lisp/jit-lock.el31
-rw-r--r--lisp/ls-lisp.el6
-rw-r--r--lisp/net/tramp-adb.el15
-rw-r--r--lisp/net/tramp-cache.el94
-rw-r--r--lisp/net/tramp-cmds.el22
-rw-r--r--lisp/net/tramp-gvfs.el6
-rw-r--r--lisp/net/tramp-sh.el69
-rw-r--r--lisp/net/tramp-smb.el12
-rw-r--r--lisp/net/tramp-sudoedit.el4
-rw-r--r--lisp/net/tramp.el12
-rw-r--r--lisp/progmodes/compile.el13
-rw-r--r--lisp/progmodes/ebrowse.el458
-rw-r--r--lisp/progmodes/gdb-mi.el8
-rw-r--r--lisp/subr.el6
-rw-r--r--lisp/textmodes/conf-mode.el46
-rw-r--r--lisp/textmodes/tex-mode.el60
-rw-r--r--lisp/vc/diff-mode.el4
-rw-r--r--lisp/vc/vc-dir.el12
-rw-r--r--lisp/vc/vc-hooks.el6
-rw-r--r--m4/acl.m44
-rw-r--r--m4/gnulib-comp.m44
-rw-r--r--src/bignum.h2
-rw-r--r--src/buffer.c32
-rw-r--r--src/buffer.h2
-rw-r--r--src/character.c6
-rw-r--r--src/cmds.c15
-rw-r--r--src/coding.c42
-rw-r--r--src/composite.c17
-rw-r--r--src/data.c77
-rw-r--r--src/editfns.c121
-rw-r--r--src/emacs-module.c9
-rw-r--r--src/fileio.c2
-rw-r--r--src/filelock.c24
-rw-r--r--src/fns.c18
-rw-r--r--src/font.c16
-rw-r--r--src/fringe.c6
-rw-r--r--src/lisp.h32
-rw-r--r--src/module-env-28.h3
-rw-r--r--src/process.c12
-rw-r--r--src/process.h2
-rw-r--r--src/search.c3
-rw-r--r--src/textprop.c15
-rw-r--r--src/window.c5
-rw-r--r--src/xdisp.c20
-rw-r--r--test/data/emacs-module/mod-test.c93
-rw-r--r--test/lisp/image/gravatar-tests.el2
-rw-r--r--test/src/emacs-module-tests.el17
66 files changed, 1122 insertions, 886 deletions
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 768e5051f0b..99469e47aa7 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -31,10 +31,10 @@ GNULIB_MODULES='
31 careadlinkat close-stream copy-file-range 31 careadlinkat close-stream copy-file-range
32 count-leading-zeros count-one-bits count-trailing-zeros 32 count-leading-zeros count-one-bits count-trailing-zeros
33 crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer 33 crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer
34 d-type diffseq dosname double-slash-root dtoastr dtotimespec dup2 34 d-type diffseq double-slash-root dtoastr dtotimespec dup2
35 environ execinfo explicit_bzero faccessat 35 environ execinfo explicit_bzero faccessat
36 fchmodat fcntl fcntl-h fdopendir 36 fchmodat fcntl fcntl-h fdopendir
37 filemode filevercmp flexmember fpieee fstatat fsusage fsync futimens 37 filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens
38 getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog 38 getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog
39 ieee754-h ignore-value intprops largefile lstat 39 ieee754-h ignore-value intprops largefile lstat
40 manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime 40 manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 38963f225ca..8a05680c742 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -975,9 +975,27 @@ displays the following frame layout:
975@end group 975@end group
976@end smallexample 976@end smallexample
977 977
978@findex gdb-save-window-configuration
979@findex gdb-load-window-configuration
980@vindex gdb-default-window-configuration-file
981@vindex gdb-window-configuration-directory
982 You can customize the window layout based on the one above and save
983that layout to a file using @code{gdb-save-window-configuration}.
984Then you can later load this layout back using
985@code{gdb-load-window-configuration}. (Internally, Emacs uses the
986term window configuration instead of window layout.) You can set your
987custom layout as the default one used by @code{gdb-many-windows} by
988customizing @code{gdb-default-window-configuration-file}. If it is
989not an absolute file name, GDB looks under
990@code{gdb-window-configuration-directory} for the file.
991@code{gdb-window-configuration-directory} defaults to
992@code{user-emacs-directory} (@pxref{Find Init}).
993
994
978@findex gdb-restore-windows 995@findex gdb-restore-windows
979@findex gdb-many-windows 996@findex gdb-many-windows
980 If you ever change the window layout, you can restore the many-windows 997@vindex gdb-restore-window-configuration-after-quit
998 If you ever change the window layout, you can restore the default
981layout by typing @kbd{M-x gdb-restore-windows}. To toggle 999layout by typing @kbd{M-x gdb-restore-windows}. To toggle
982between the many windows layout and a simple layout with just the GUD 1000between the many windows layout and a simple layout with just the GUD
983interaction buffer and a source file, type @kbd{M-x gdb-many-windows}. 1001interaction buffer and a source file, type @kbd{M-x gdb-many-windows}.
@@ -988,7 +1006,13 @@ interaction buffer and a source file, type @kbd{M-x gdb-many-windows}.
988of windows on your original frame will not be affected. A separate 1006of windows on your original frame will not be affected. A separate
989frame for GDB sessions can come in especially handy if you work on a 1007frame for GDB sessions can come in especially handy if you work on a
990text-mode terminal, where the screen estate for windows could be at a 1008text-mode terminal, where the screen estate for windows could be at a
991premium. 1009premium. If you choose to start GDB in the same frame, consider
1010setting @code{gdb-restore-window-configuration-after-quit} to a
1011non-@code{nil} value. Your original layout will then be restored
1012after GDB quits. Use @code{t} to always restore; use
1013@code{if-gdb-many-windows} to restore only when
1014@code{gdb-many-windows} is non-@code{nil}; use @code{if-gdb-show-main}
1015to restore only when @code{gdb-show-main} is non-@code{nil}.
992 1016
993 You may also specify additional GDB-related buffers to display, 1017 You may also specify additional GDB-related buffers to display,
994either in the same frame or a different one. Select the buffers you 1018either in the same frame or a different one. Select the buffers you
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 442f6d156b6..d70c3543f2a 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -2022,6 +2022,20 @@ variable values and buffer content may have been modified in arbitrary
2022ways. 2022ways.
2023@end deftypefn 2023@end deftypefn
2024 2024
2025@anchor{open_channel}
2026@deftypefun int open_channel (emacs_env *@var{env}, emacs_value @var{pipe_process})
2027This function, which is available since Emacs 28, opens a channel to
2028an existing pipe process. @var{pipe_process} must refer to an
2029existing pipe process created by @code{make-pipe-process}. @ref{Pipe
2030Processes}. If successful, the return value will be a new file
2031descriptor that you can use to write to the pipe. Unlike all other
2032module functions, you can use the returned file descriptor from
2033arbitrary threads, even if no module environment is active. You can
2034use the @code{write} function to write to the file descriptor. Once
2035done, close the file descriptor using @code{close}. @ref{Low-Level
2036I/O,,,libc}.
2037@end deftypefun
2038
2025@node Module Nonlocal 2039@node Module Nonlocal
2026@subsection Nonlocal Exits in Modules 2040@subsection Nonlocal Exits in Modules
2027@cindex nonlocal exits, in modules 2041@cindex nonlocal exits, in modules
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index f515213615e..14cd079c563 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -743,6 +743,7 @@ Some file name handlers may not support @code{make-process}. In such
743cases, this function does nothing and returns @code{nil}. 743cases, this function does nothing and returns @code{nil}.
744@end defun 744@end defun
745 745
746@anchor{Pipe Processes}
746@defun make-pipe-process &rest args 747@defun make-pipe-process &rest args
747This function creates a bidirectional pipe which can be attached to a 748This function creates a bidirectional pipe which can be attached to a
748child process. This is useful with the @code{:stderr} keyword of 749child process. This is useful with the @code{:stderr} keyword of
diff --git a/etc/NEWS b/etc/NEWS
index ba3e691ff91..4b477e5def6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -38,7 +38,7 @@ when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz
38text shaping support, and 'ftcr' otherwise. You can determine this by 38text shaping support, and 'ftcr' otherwise. You can determine this by
39checking 'system-configuration-features'. The 'ftcr' backend will 39checking 'system-configuration-features'. The 'ftcr' backend will
40still be available when HarfBuzz is supported, but will not be used by 40still be available when HarfBuzz is supported, but will not be used by
41default. We strongly recommend building with HarBuzz support. 'x' is 41default. We strongly recommend building with HarBuzz support. 'x' is
42still a valid backend. 42still a valid backend.
43 43
44--- 44---
@@ -64,9 +64,9 @@ It was declared obsolete in Emacs 27.1.
64 64
65* Changes in Emacs 28.1 65* Changes in Emacs 28.1
66 66
67** Support for '(box . SIZE)' cursor-type. 67** Support for '(box . SIZE)' 'cursor-type'.
68By default, 'box' cursor always has a filled box shape. But if you 68By default, 'box' cursor always has a filled box shape. But if you
69specify cursor-type to be '(box . SIZE)', the cursor becomes a hollow 69specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow
70box if the point is on an image larger than 'SIZE' pixels in any 70box if the point is on an image larger than 'SIZE' pixels in any
71dimension. 71dimension.
72 72
@@ -97,24 +97,33 @@ shows equivalent key bindings for all commands that have them.
97* Changes in Specialized Modes and Packages in Emacs 28.1 97* Changes in Specialized Modes and Packages in Emacs 28.1
98 98
99** Emacs-Lisp mode 99** Emacs-Lisp mode
100
100*** The mode-line now indicates whether we're using lexical or dynamic scoping. 101*** The mode-line now indicates whether we're using lexical or dynamic scoping.
101 102
102** Dired 103** Dired
103 104
104*** New option 'dired-mark-region' affects all Dired commands that mark files. 105*** New user option 'dired-mark-region' affects all Dired commands
105When non-nil and the region is active in Transient Mark mode, 106that mark files. When non-nil and the region is active in Transient
106then Dired commands operate only on files in the active region. 107Mark mode, then Dired commands operate only on files in the active
107The values 'exclusive' and 'inclusive' of this option define 108region. The values 'file' and 'line' of this user option define the
108the details of marking the last file at the end of the region. 109details of marking the file at the end of the region.
109 110
110*** State changing VC operations are supported in dired-mode on files 111*** State changing VC operations are supported in 'dired-mode' on files
111(but still not on directories). 112(but still not on directories).
112 113
114** Change Logs and VC
115
116*** New command 'vc-dir-root' uses the root directory without asking.
117
113** Gnus 118** Gnus
114 119
115--- 120---
116*** Change to default value of 'message-draft-headers' option. 121*** Change to default value of 'message-draft-headers' user option.
117No longer includes the Date header. 122The 'Date' symbol has been removed from the default value, meaning that
123draft or delayed messages will get a date reflecting when the message
124was sent. To restore the original behavior of dating a message
125from when it is first saved or delayed, add the symbol 'Date' back to
126this user option.
118 127
119** Help 128** Help
120 129
@@ -148,8 +157,8 @@ doc string functions. This makes the results of all doc string
148functions accessible to the user through the existing single function hook 157functions accessible to the user through the existing single function hook
149'eldoc-documentation-function'. 158'eldoc-documentation-function'.
150 159
151*** 'eldoc-documentation-function' is now a custom variable. 160*** 'eldoc-documentation-function' is now a user option.
152Modes should use the new hook instead of this variable to register 161Modes should use the new hook instead of this user option to register
153their backends. 162their backends.
154 163
155** Tramp 164** Tramp
@@ -171,6 +180,7 @@ effect.
171*** Pcase 'map' pattern added keyword symbols abbreviation. 180*** Pcase 'map' pattern added keyword symbols abbreviation.
172A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', 181A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
173equivalent to '(map (:sym sym))'. 182equivalent to '(map (:sym sym))'.
183
174** Package 184** Package
175 185
176+++ 186+++
@@ -186,17 +196,48 @@ key binding
186/ v package-menu-filter-by-version 196/ v package-menu-filter-by-version
187/ / package-menu-filter-clear 197/ / package-menu-filter-clear
188 198
199** gdb-mi
200
201+++
202*** gdb-mi can now store and restore window configurations.
203Use 'gdb-save-window-configuration' to save window configuration to a
204file and 'gdb-load-window-configuration' to load from a file. These
205commands can also be accessed through the menu bar under 'Gud --
206GDB-Windows'. 'gdb-default-window-configuration-file', when non-nil,
207is loaded when GDB starts up.
208
209+++
210*** gdb-mi can now restore window configuration after quit.
211Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs
212will remember the window configuration before GDB started and restore
213it after GDB quits. A toggle button is also provided under 'Gud --
214GDB-Windows'.
215
216** Gravatar
217
218---
219*** New user option 'gravatar-service' for host to query for gravatars.
220Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
221
222** Compilation mode
223
224*** Regexp matching of messages is now case-sensitive by default.
225The variable 'compilation-error-case-fold-search' can be set for
226case-insensitive matching of messages when the old behaviour is
227required, but the recommended solution is to use a correctly matching
228regexp instead.
229
189 230
190* New Modes and Packages in Emacs 28.1 231* New Modes and Packages in Emacs 28.1
191 232
192 233
193* Incompatible Editing Changes in Emacs 28.1 234* Incompatible Editing Changes in Emacs 28.1
194 235
195** In nroff mode, 'center-line' is now bound to 'M-o M-s'. 236** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'.
196The original key binding was 'M-s', which interfered with I-search, 237The original key binding was 'M-s', which interfered with I-search,
197since the latter uses 'M-s' as a prefix key of the search prefix map. 238since the latter uses 'M-s' as a prefix key of the search prefix map.
198 239
199** vc-print-branch-log shows the change log for BRANCH from its root 240** 'vc-print-branch-log' shows the change log for BRANCH from its root
200directory instead of the default directory. 241directory instead of the default directory.
201 242
202 243
@@ -228,7 +269,7 @@ This is no longer supported, and setting this variable has no effect.
228 269
229* Lisp Changes in Emacs 28.1 270* Lisp Changes in Emacs 28.1
230 271
231** New macro 'dlet' to dynamically bind variables 272** New macro 'dlet' to dynamically bind variables.
232 273
233** The variable 'force-new-style-backquotes' has been removed. 274** The variable 'force-new-style-backquotes' has been removed.
234This removes the final remaining trace of old-style backquotes. 275This removes the final remaining trace of old-style backquotes.
@@ -242,6 +283,10 @@ called when the function object is garbage-collected. Use
242'set_function_finalizer' to set the finalizer and 283'set_function_finalizer' to set the finalizer and
243'get_function_finalizer' to retrieve it. 284'get_function_finalizer' to retrieve it.
244 285
286** Modules can now open a channel to an existing pipe process using
287the new module function 'open_channel'. Modules can use this
288functionality to asynchronously send data back to Emacs.
289
245** 'file-modes', 'set-file-modes', and 'set-file-times' now have an 290** 'file-modes', 'set-file-modes', and 'set-file-times' now have an
246optional argument specifying whether to follow symbolic links. 291optional argument specifying whether to follow symbolic links.
247 292
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 204064f1871..380be95222b 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -80,7 +80,7 @@ char *w32_getenv (const char *);
80#include <sys/stat.h> 80#include <sys/stat.h>
81#include <unistd.h> 81#include <unistd.h>
82 82
83#include <dosname.h> 83#include <filename.h>
84#include <intprops.h> 84#include <intprops.h>
85#include <min-max.h> 85#include <min-max.h>
86#include <pathmax.h> 86#include <pathmax.h>
diff --git a/lib/at-func.c b/lib/at-func.c
index 4a1c909d38e..90022e05787 100644
--- a/lib/at-func.c
+++ b/lib/at-func.c
@@ -16,7 +16,7 @@
16 16
17/* written by Jim Meyering */ 17/* written by Jim Meyering */
18 18
19#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */ 19#include "filename.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
20 20
21#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD 21#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
22# include <errno.h> 22# include <errno.h>
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index 7d3c710f10f..9f990988393 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -51,7 +51,7 @@
51# define __realpath realpath 51# define __realpath realpath
52# include "pathmax.h" 52# include "pathmax.h"
53# include "malloca.h" 53# include "malloca.h"
54# include "dosname.h" 54# include "filename.h"
55# if HAVE_GETCWD 55# if HAVE_GETCWD
56# if IN_RELOCWRAPPER 56# if IN_RELOCWRAPPER
57 /* When building the relocatable program wrapper, use the system's getcwd 57 /* When building the relocatable program wrapper, use the system's getcwd
diff --git a/lib/dosname.h b/lib/dosname.h
deleted file mode 100644
index 57829600948..00000000000
--- a/lib/dosname.h
+++ /dev/null
@@ -1,52 +0,0 @@
1/* File names on MS-DOS/Windows systems.
2
3 Copyright (C) 2000-2001, 2004-2006, 2009-2020 Free Software Foundation, Inc.
4
5 This program is free software: you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 3 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program. If not, see <https://www.gnu.org/licenses/>.
17
18 From Paul Eggert and Jim Meyering. */
19
20#ifndef _DOSNAME_H
21#define _DOSNAME_H
22
23#if (defined _WIN32 || defined __CYGWIN__ \
24 || defined __EMX__ || defined __MSDOS__ || defined __DJGPP__)
25 /* This internal macro assumes ASCII, but all hosts that support drive
26 letters use ASCII. */
27# define _IS_DRIVE_LETTER(C) (((unsigned int) (C) | ('a' - 'A')) - 'a' \
28 <= 'z' - 'a')
29# define FILE_SYSTEM_PREFIX_LEN(Filename) \
30 (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':' ? 2 : 0)
31# ifndef __CYGWIN__
32# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1
33# endif
34# define ISSLASH(C) ((C) == '/' || (C) == '\\')
35#else
36# define FILE_SYSTEM_PREFIX_LEN(Filename) 0
37# define ISSLASH(C) ((C) == '/')
38#endif
39
40#ifndef FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
41# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
42#endif
43
44#if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
45# define IS_ABSOLUTE_FILE_NAME(F) ISSLASH ((F)[FILE_SYSTEM_PREFIX_LEN (F)])
46# else
47# define IS_ABSOLUTE_FILE_NAME(F) \
48 (ISSLASH ((F)[0]) || FILE_SYSTEM_PREFIX_LEN (F) != 0)
49#endif
50#define IS_RELATIVE_FILE_NAME(F) (! IS_ABSOLUTE_FILE_NAME (F))
51
52#endif /* DOSNAME_H_ */
diff --git a/lib/filename.h b/lib/filename.h
new file mode 100644
index 00000000000..4598fb1d638
--- /dev/null
+++ b/lib/filename.h
@@ -0,0 +1,110 @@
1/* Basic filename support macros.
2 Copyright (C) 2001-2004, 2007-2020 Free Software Foundation, Inc.
3
4 This program is free software: you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 3 of the License, or
7 (at your option) any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with this program. If not, see <https://www.gnu.org/licenses/>. */
16
17/* From Paul Eggert and Jim Meyering. */
18
19#ifndef _FILENAME_H
20#define _FILENAME_H
21
22#include <string.h>
23
24#ifdef __cplusplus
25extern "C" {
26#endif
27
28
29/* Filename support.
30 ISSLASH(C) tests whether C is a directory separator
31 character.
32 HAS_DEVICE(Filename) tests whether Filename contains a device
33 specification.
34 FILE_SYSTEM_PREFIX_LEN(Filename) length of the device specification
35 at the beginning of Filename,
36 index of the part consisting of
37 alternating components and slashes.
38 FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
39 1 when a non-empty device specification
40 can be followed by an empty or relative
41 part,
42 0 when a non-empty device specification
43 must be followed by a slash,
44 0 when device specification don't exist.
45 IS_ABSOLUTE_FILE_NAME(Filename)
46 tests whether Filename is independent of
47 any notion of "current directory".
48 IS_RELATIVE_FILE_NAME(Filename)
49 tests whether Filename may be concatenated
50 to a directory filename.
51 Note: On native Windows, OS/2, DOS, "c:" is neither an absolute nor a
52 relative file name!
53 IS_FILE_NAME_WITH_DIR(Filename) tests whether Filename contains a device
54 or directory specification.
55 */
56#if defined _WIN32 || defined __CYGWIN__ \
57 || defined __EMX__ || defined __MSDOS__ || defined __DJGPP__
58 /* Native Windows, Cygwin, OS/2, DOS */
59# define ISSLASH(C) ((C) == '/' || (C) == '\\')
60 /* Internal macro: Tests whether a character is a drive letter. */
61# define _IS_DRIVE_LETTER(C) \
62 (((C) >= 'A' && (C) <= 'Z') || ((C) >= 'a' && (C) <= 'z'))
63 /* Help the compiler optimizing it. This assumes ASCII. */
64# undef _IS_DRIVE_LETTER
65# define _IS_DRIVE_LETTER(C) \
66 (((unsigned int) (C) | ('a' - 'A')) - 'a' <= 'z' - 'a')
67# define HAS_DEVICE(Filename) \
68 (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':')
69# define FILE_SYSTEM_PREFIX_LEN(Filename) (HAS_DEVICE (Filename) ? 2 : 0)
70# ifdef __CYGWIN__
71# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
72# else
73 /* On native Windows, OS/2, DOS, the system has the notion of a
74 "current directory" on each drive. */
75# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1
76# endif
77# if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
78# define IS_ABSOLUTE_FILE_NAME(Filename) \
79 ISSLASH ((Filename)[FILE_SYSTEM_PREFIX_LEN (Filename)])
80# else
81# define IS_ABSOLUTE_FILE_NAME(Filename) \
82 (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename))
83# endif
84# define IS_RELATIVE_FILE_NAME(Filename) \
85 (! (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename)))
86# define IS_FILE_NAME_WITH_DIR(Filename) \
87 (strchr ((Filename), '/') != NULL || strchr ((Filename), '\\') != NULL \
88 || HAS_DEVICE (Filename))
89#else
90 /* Unix */
91# define ISSLASH(C) ((C) == '/')
92# define HAS_DEVICE(Filename) ((void) (Filename), 0)
93# define FILE_SYSTEM_PREFIX_LEN(Filename) ((void) (Filename), 0)
94# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
95# define IS_ABSOLUTE_FILE_NAME(Filename) ISSLASH ((Filename)[0])
96# define IS_RELATIVE_FILE_NAME(Filename) (! ISSLASH ((Filename)[0]))
97# define IS_FILE_NAME_WITH_DIR(Filename) (strchr ((Filename), '/') != NULL)
98#endif
99
100/* Deprecated macros. For backward compatibility with old users of the
101 'filename' module. */
102#define IS_ABSOLUTE_PATH IS_ABSOLUTE_FILE_NAME
103#define IS_PATH_WITH_DIR IS_FILE_NAME_WITH_DIR
104
105
106#ifdef __cplusplus
107}
108#endif
109
110#endif /* _FILENAME_H */
diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h
index da0a6d0c3c4..ec545c1b51c 100644
--- a/lib/getopt-pfx-core.h
+++ b/lib/getopt-pfx-core.h
@@ -48,6 +48,14 @@
48# define optind __GETOPT_ID (optind) 48# define optind __GETOPT_ID (optind)
49# define optopt __GETOPT_ID (optopt) 49# define optopt __GETOPT_ID (optopt)
50 50
51/* Work around a a problem on macOS, which declares getopt with a
52 trailing __DARWIN_ALIAS(getopt) that would expand to something like
53 __asm("_" "rpl_getopt" "$UNIX2003") were it not for the following
54 hack to suppress the macOS declaration <https://bugs.gnu.org/40205>. */
55# ifdef __APPLE__
56# define _GETOPT
57# endif
58
51/* The system's getopt.h may have already included getopt-core.h to 59/* The system's getopt.h may have already included getopt-core.h to
52 declare the unprefixed identifiers. Undef _GETOPT_CORE_H so that 60 declare the unprefixed identifiers. Undef _GETOPT_CORE_H so that
53 getopt-core.h declares them with prefixes. */ 61 getopt-core.h declares them with prefixes. */
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index e90d2e39049..0c7c2fb2b66 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -86,7 +86,6 @@
86# crypto/sha512-buffer \ 86# crypto/sha512-buffer \
87# d-type \ 87# d-type \
88# diffseq \ 88# diffseq \
89# dosname \
90# double-slash-root \ 89# double-slash-root \
91# dtoastr \ 90# dtoastr \
92# dtotimespec \ 91# dtotimespec \
@@ -100,6 +99,7 @@
100# fcntl-h \ 99# fcntl-h \
101# fdopendir \ 100# fdopendir \
102# filemode \ 101# filemode \
102# filename \
103# filevercmp \ 103# filevercmp \
104# flexmember \ 104# flexmember \
105# fpieee \ 105# fpieee \
@@ -1452,15 +1452,6 @@ EXTRA_libgnu_a_SOURCES += dirfd.c
1452endif 1452endif
1453## end gnulib module dirfd 1453## end gnulib module dirfd
1454 1454
1455## begin gnulib module dosname
1456ifeq (,$(OMIT_GNULIB_MODULE_dosname))
1457
1458
1459EXTRA_DIST += dosname.h
1460
1461endif
1462## end gnulib module dosname
1463
1464## begin gnulib module dtoastr 1455## begin gnulib module dtoastr
1465ifeq (,$(OMIT_GNULIB_MODULE_dtoastr)) 1456ifeq (,$(OMIT_GNULIB_MODULE_dtoastr))
1466 1457
@@ -1672,6 +1663,15 @@ EXTRA_DIST += filemode.h
1672endif 1663endif
1673## end gnulib module filemode 1664## end gnulib module filemode
1674 1665
1666## begin gnulib module filename
1667ifeq (,$(OMIT_GNULIB_MODULE_filename))
1668
1669
1670EXTRA_DIST += filename.h
1671
1672endif
1673## end gnulib module filename
1674
1675## begin gnulib module filevercmp 1675## begin gnulib module filevercmp
1676ifeq (,$(OMIT_GNULIB_MODULE_filevercmp)) 1676ifeq (,$(OMIT_GNULIB_MODULE_filevercmp))
1677 1677
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index f8a303956e3..5a3c20c7832 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -370,11 +370,7 @@ from which to start."
370 (setq i (1+ i))) 370 (setq i (1+ i)))
371 (when (> spaces 0) 371 (when (> spaces 0)
372 (push (char-fold--make-space-string spaces) out)) 372 (push (char-fold--make-space-string spaces) out))
373 (let ((regexp (apply #'concat (nreverse out)))) 373 (apply #'concat (nreverse out))))
374 ;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'.
375 (if (> (length regexp) 5000)
376 (regexp-quote string)
377 regexp))))
378 374
379 375
380;;; Commands provided for completeness. 376;;; Commands provided for completeness.
diff --git a/lisp/dired.el b/lisp/dired.el
index 438f5e7d8b4..41bbf9f56a2 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -296,7 +296,7 @@ new Dired buffers."
296 :version "26.1" 296 :version "26.1"
297 :group 'dired) 297 :group 'dired)
298 298
299(defcustom dired-mark-region 'exclusive 299(defcustom dired-mark-region 'file
300 "Defines what commands that mark files do with the active region. 300 "Defines what commands that mark files do with the active region.
301 301
302When nil, marking commands don't operate on all files in the 302When nil, marking commands don't operate on all files in the
@@ -306,7 +306,8 @@ When the value of this option is non-nil, then all Dired commands
306that mark or unmark files will operate on all files in the region 306that mark or unmark files will operate on all files in the region
307if the region is active in Transient Mark mode. 307if the region is active in Transient Mark mode.
308 308
309When `exclusive', don't mark the file if the end of the region is 309When `file', the region marking is based on the file name.
310This means don't mark the file if the end of the region is
310before the file name displayed on the Dired line, so the file name 311before the file name displayed on the Dired line, so the file name
311is visually outside the region. This behavior is consistent with 312is visually outside the region. This behavior is consistent with
312marking files without the region using the key `m' that advances 313marking files without the region using the key `m' that advances
@@ -315,12 +316,13 @@ of keys used to mark files is the same as the number of keys
315used to select the region, e.g. `M-2 m' marks 2 files, and 316used to select the region, e.g. `M-2 m' marks 2 files, and
316`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files. 317`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files.
317 318
318When `inclusive', include the file into marking if the end of the region 319When `line', the region marking is based on Dired lines,
320so include the file into marking if the end of the region
319is anywhere on its Dired line, except the beginning of the line." 321is anywhere on its Dired line, except the beginning of the line."
320 :type '(choice 322 :type '(choice
321 (const :tag "Don't mark files in active region" nil) 323 (const :tag "Don't mark files in active region" nil)
322 (const :tag "Exclude file name outside of region" exclusive) 324 (const :tag "Exclude file name outside of region" file)
323 (const :tag "Include the file at region end line" inclusive)) 325 (const :tag "Include the file at region end line" line))
324 :group 'dired 326 :group 'dired
325 :version "28.1") 327 :version "28.1")
326 328
@@ -646,16 +648,19 @@ of the region if `dired-mark-region' is non-nil. Otherwise, operate
646on the whole buffer. 648on the whole buffer.
647 649
648Return value is the number of files marked, or nil if none were marked." 650Return value is the number of files marked, or nil if none were marked."
649 `(let ((inhibit-read-only t) count 651 `(let* ((inhibit-read-only t) count
650 (beg (if (and dired-mark-region (use-region-p)) 652 (use-region-p (and dired-mark-region
653 (region-active-p)
654 (> (region-end) (region-beginning))))
655 (beg (if use-region-p
651 (save-excursion 656 (save-excursion
652 (goto-char (region-beginning)) 657 (goto-char (region-beginning))
653 (line-beginning-position)) 658 (line-beginning-position))
654 (point-min))) 659 (point-min)))
655 (end (if (and dired-mark-region (use-region-p)) 660 (end (if use-region-p
656 (save-excursion 661 (save-excursion
657 (goto-char (region-end)) 662 (goto-char (region-end))
658 (if (if (eq dired-mark-region 'inclusive) 663 (if (if (eq dired-mark-region 'line)
659 (not (bolp)) 664 (not (bolp))
660 (get-text-property (1- (point)) 'dired-filename)) 665 (get-text-property (1- (point)) 'dired-filename))
661 (line-end-position) 666 (line-end-position)
@@ -673,7 +678,7 @@ Return value is the number of files marked, or nil if none were marked."
673 (if (eq dired-del-marker dired-marker-char) 678 (if (eq dired-del-marker dired-marker-char)
674 " for deletion" 679 " for deletion"
675 "") 680 "")
676 (if (and dired-mark-region (use-region-p)) 681 (if use-region-p
677 " in region" 682 " in region"
678 ""))) 683 "")))
679 (goto-char beg) 684 (goto-char beg)
@@ -691,7 +696,7 @@ Return value is the number of files marked, or nil if none were marked."
691 (if (eq dired-marker-char ?\s) "un" "") 696 (if (eq dired-marker-char ?\s) "un" "")
692 (if (eq dired-marker-char dired-del-marker) 697 (if (eq dired-marker-char dired-del-marker)
693 "flagged" "marked") 698 "flagged" "marked")
694 (if (and dired-mark-region (use-region-p)) 699 (if use-region-p
695 " in region" 700 " in region"
696 "")))) 701 ""))))
697 (and (> count 0) count))) 702 (and (> count 0) count)))
@@ -3645,14 +3650,16 @@ this subdir."
3645 (interactive (list current-prefix-arg t)) 3650 (interactive (list current-prefix-arg t))
3646 (cond 3651 (cond
3647 ;; Mark files in the active region. 3652 ;; Mark files in the active region.
3648 ((and dired-mark-region interactive (use-region-p)) 3653 ((and interactive dired-mark-region
3654 (region-active-p)
3655 (> (region-end) (region-beginning)))
3649 (save-excursion 3656 (save-excursion
3650 (let ((beg (region-beginning)) 3657 (let ((beg (region-beginning))
3651 (end (region-end))) 3658 (end (region-end)))
3652 (dired-mark-files-in-region 3659 (dired-mark-files-in-region
3653 (progn (goto-char beg) (line-beginning-position)) 3660 (progn (goto-char beg) (line-beginning-position))
3654 (progn (goto-char end) 3661 (progn (goto-char end)
3655 (if (if (eq dired-mark-region 'inclusive) 3662 (if (if (eq dired-mark-region 'line)
3656 (not (bolp)) 3663 (not (bolp))
3657 (get-text-property (1- (point)) 'dired-filename)) 3664 (get-text-property (1- (point)) 'dired-filename))
3658 (line-end-position) 3665 (line-end-position)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 954731b06b8..7f5d197b532 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2868,7 +2868,9 @@ Supported keywords for slots are:
2868 (append pred-form '(t)) 2868 (append pred-form '(t))
2869 `(and ,pred-form t))) 2869 `(and ,pred-form t)))
2870 forms) 2870 forms)
2871 (push `(put ',name 'cl-deftype-satisfies ',predicate) forms)) 2871 (push `(eval-and-compile
2872 (put ',name 'cl-deftype-satisfies ',predicate))
2873 forms))
2872 (let ((pos 0) (descp descs)) 2874 (let ((pos 0) (descp descs))
2873 (while descp 2875 (while descp
2874 (let* ((desc (pop descp)) 2876 (let* ((desc (pop descp))
@@ -3138,6 +3140,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
3138 ;; "Obvious" mappings. 3140 ;; "Obvious" mappings.
3139 (string . stringp) 3141 (string . stringp)
3140 (list . listp) 3142 (list . listp)
3143 (cons . consp)
3141 (symbol . symbolp) 3144 (symbol . symbolp)
3142 (function . functionp) 3145 (function . functionp)
3143 (integer . integerp) 3146 (integer . integerp)
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 4fa31f32673..4cebd739c3b 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -52,7 +52,7 @@
52 (let ((repeat (aref timer 4))) 52 (let ((repeat (aref timer 4)))
53 (cond 53 (cond
54 ((numberp repeat) 54 ((numberp repeat)
55 (format "%.2f" (/ repeat 60))) 55 (format "%.1f" repeat))
56 ((null repeat) 56 ((null repeat)
57 "-") 57 "-")
58 (t 58 (t
@@ -91,7 +91,18 @@
91 (setq header-line-format 91 (setq header-line-format
92 (concat (propertize " " 'display '(space :align-to 0)) 92 (concat (propertize " " 'display '(space :align-to 0))
93 (format "%4s %10s %8s %s" 93 (format "%4s %10s %8s %s"
94 "Idle" "Next" "Repeat" "Function")))) 94 (propertize "Idle"
95 'mouse-face 'highlight
96 'help-echo "* marks idle timers")
97 (propertize "Next"
98 'mouse-face 'highlight
99 'help-echo "Time in sec till next invocation")
100 (propertize "Repeat"
101 'mouse-face 'highlight
102 'help-echo "Symbol: repeat; number: repeat interval in sec")
103 (propertize "Function"
104 'mouse-face 'highlight
105 'help-echo "Function called by timer")))))
95 106
96(defun timer-list-cancel () 107(defun timer-list-cancel ()
97 "Cancel the timer on the line under point." 108 "Cancel the timer on the line under point."
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index fd2b44f7424..480ed80ef81 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,4 +1,4 @@
1;;; gnus-registry.el --- article registry for Gnus 1;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2002-2020 Free Software Foundation, Inc. 3;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
4 4
@@ -62,10 +62,10 @@
62 62
63;; show the marks as single characters (see the :char property in 63;; show the marks as single characters (see the :char property in
64;; `gnus-registry-marks'): 64;; `gnus-registry-marks'):
65;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) 65;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
66 66
67;; show the marks by name (see `gnus-registry-marks'): 67;; show the marks by name (see `gnus-registry-marks'):
68;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) 68;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
69 69
70;; TODO: 70;; TODO:
71 71
@@ -588,7 +588,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
588 subject 588 subject
589 (< gnus-registry-minimum-subject-length (length subject))) 589 (< gnus-registry-minimum-subject-length (length subject)))
590 (let ((groups (apply 590 (let ((groups (apply
591 'append 591 #'append
592 (mapcar 592 (mapcar
593 (lambda (reference) 593 (lambda (reference)
594 (gnus-registry-get-id-key reference 'group)) 594 (gnus-registry-get-id-key reference 'group))
@@ -615,7 +615,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
615 sender 615 sender
616 gnus-registry-unfollowed-addresses))) 616 gnus-registry-unfollowed-addresses)))
617 (let ((groups (apply 617 (let ((groups (apply
618 'append 618 #'append
619 (mapcar 619 (mapcar
620 (lambda (reference) 620 (lambda (reference)
621 (gnus-registry-get-id-key reference 'group)) 621 (gnus-registry-get-id-key reference 'group))
@@ -644,7 +644,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
644 (not (gnus-grep-in-list 644 (not (gnus-grep-in-list
645 recp 645 recp
646 gnus-registry-unfollowed-addresses))) 646 gnus-registry-unfollowed-addresses)))
647 (let ((groups (apply 'append 647 (let ((groups (apply #'append
648 (mapcar 648 (mapcar
649 (lambda (reference) 649 (lambda (reference)
650 (gnus-registry-get-id-key reference 'group)) 650 (gnus-registry-get-id-key reference 'group))
@@ -663,7 +663,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
663 ;; filter the found groups and return them 663 ;; filter the found groups and return them
664 ;; the found groups are NOT the full groups 664 ;; the found groups are NOT the full groups
665 (setq found (gnus-registry-post-process-groups 665 (setq found (gnus-registry-post-process-groups
666 "recipients" (mapconcat 'identity recipients ", ") found))) 666 "recipients" (mapconcat #'identity recipients ", ") found)))
667 667
668 ;; after the (cond) we extract the actual value safely 668 ;; after the (cond) we extract the actual value safely
669 (car-safe found))) 669 (car-safe found)))
@@ -791,7 +791,8 @@ Consults `gnus-registry-ignored-groups' and
791 ((stringp g) g) 791 ((stringp g) g)
792 ((and (listp g) (nth 1 g)) 792 ((and (listp g) (nth 1 g))
793 (nth 0 g)) 793 (nth 0 g))
794 (t nil))) gnus-registry-ignored-groups))) 794 (t nil)))
795 gnus-registry-ignored-groups)))
795 ;; only use `gnus-parameter-registry-ignore' if 796 ;; only use `gnus-parameter-registry-ignore' if
796 ;; `gnus-registry-ignored-groups' is a list of lists 797 ;; `gnus-registry-ignored-groups' is a list of lists
797 ;; (it can be a list of regexes) 798 ;; (it can be a list of regexes)
@@ -871,7 +872,7 @@ Addresses without a name will say \"noname\"."
871 872
872(defun gnus-registry-sort-addresses (&rest addresses) 873(defun gnus-registry-sort-addresses (&rest addresses)
873 "Return a normalized and sorted list of ADDRESSES." 874 "Return a normalized and sorted list of ADDRESSES."
874 (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp)) 875 (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp))
875 876
876(defun gnus-registry-simplify-subject (subject) 877(defun gnus-registry-simplify-subject (subject)
877 (if (stringp subject) 878 (if (stringp subject)
@@ -961,16 +962,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
961 (intern (format function-format variant-name))) 962 (intern (format function-format variant-name)))
962 (shortcut (format "%c" (if remove (upcase data) data)))) 963 (shortcut (format "%c" (if remove (upcase data) data))))
963 (defalias function-name 964 (defalias function-name
964 ;; If it weren't for the function's docstring, we could 965 (lambda (&rest articles)
965 ;; use a closure, with lexical-let :-( 966 (:documentation
966 `(lambda (&rest articles) 967 (format
967 ,(format 968 "%s the %s mark over process-marked ARTICLES."
968 "%s the %s mark over process-marked ARTICLES." 969 (upcase-initials variant-name)
969 (upcase-initials variant-name) 970 mark))
970 mark) 971 (interactive
971 (interactive 972 (gnus-summary-work-articles current-prefix-arg))
972 (gnus-summary-work-articles current-prefix-arg)) 973 (gnus-registry--set/remove-mark mark remove articles)))
973 (gnus-registry--set/remove-mark ',mark ',remove articles)))
974 (push function-name keys-plist) 974 (push function-name keys-plist)
975 (push shortcut keys-plist) 975 (push shortcut keys-plist)
976 (push (vector (format "%s %s" 976 (push (vector (format "%s %s"
@@ -990,14 +990,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
990 nil 990 nil
991 (cons "Registry Marks" gnus-registry-misc-menus)))))) 991 (cons "Registry Marks" gnus-registry-misc-menus))))))
992 992
993(make-obsolete 'gnus-registry-user-format-function-M 993(define-obsolete-function-alias 'gnus-registry-user-format-function-M
994 'gnus-registry-article-marks-to-chars "24.1") ? 994 #'gnus-registry-article-marks-to-chars "24.1")
995
996(defalias 'gnus-registry-user-format-function-M
997 'gnus-registry-article-marks-to-chars)
998 995
999;; use like this: 996;; use like this:
1000;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) 997;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
1001(defun gnus-registry-article-marks-to-chars (headers) 998(defun gnus-registry-article-marks-to-chars (headers)
1002 "Show the marks for an article by the :char property." 999 "Show the marks for an article by the :char property."
1003 (if gnus-registry-enabled 1000 (if gnus-registry-enabled
@@ -1013,20 +1010,20 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
1013 "")) 1010 ""))
1014 1011
1015;; use like this: 1012;; use like this:
1016;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) 1013;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
1017(defun gnus-registry-article-marks-to-names (headers) 1014(defun gnus-registry-article-marks-to-names (headers)
1018 "Show the marks for an article by name." 1015 "Show the marks for an article by name."
1019 (if gnus-registry-enabled 1016 (if gnus-registry-enabled
1020 (let* ((id (mail-header-message-id headers)) 1017 (let* ((id (mail-header-message-id headers))
1021 (marks (when id (gnus-registry-get-id-key id 'mark)))) 1018 (marks (when id (gnus-registry-get-id-key id 'mark))))
1022 (mapconcat (lambda (mark) (symbol-name mark)) marks ",")) 1019 (mapconcat #'symbol-name marks ","))
1023 "")) 1020 ""))
1024 1021
1025(defun gnus-registry-read-mark () 1022(defun gnus-registry-read-mark ()
1026 "Read a mark name from the user with completion." 1023 "Read a mark name from the user with completion."
1027 (let ((mark (gnus-completing-read 1024 (let ((mark (gnus-completing-read
1028 "Label" 1025 "Label"
1029 (mapcar 'symbol-name (mapcar 'car gnus-registry-marks)) 1026 (mapcar #'symbol-name (mapcar #'car gnus-registry-marks))
1030 nil nil nil 1027 nil nil nil
1031 (symbol-name gnus-registry-default-mark)))) 1028 (symbol-name gnus-registry-default-mark))))
1032 (when (stringp mark) 1029 (when (stringp mark)
@@ -1050,7 +1047,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
1050 show-message) 1047 show-message)
1051 "Apply or remove MARK across a list of ARTICLES." 1048 "Apply or remove MARK across a list of ARTICLES."
1052 (let ((article-id-list 1049 (let ((article-id-list
1053 (mapcar 'gnus-registry-fetch-message-id-fast articles))) 1050 (mapcar #'gnus-registry-fetch-message-id-fast articles)))
1054 (dolist (id article-id-list) 1051 (dolist (id article-id-list)
1055 (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark))) 1052 (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark)))
1056 (marks (if remove marks (cons mark marks)))) 1053 (marks (if remove marks (cons mark marks))))
@@ -1173,34 +1170,34 @@ only the last one's marks are returned."
1173 (gnus-registry-install-shortcuts) 1170 (gnus-registry-install-shortcuts)
1174 (if (gnus-alive-p) 1171 (if (gnus-alive-p)
1175 (gnus-registry-load) 1172 (gnus-registry-load)
1176 (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load))) 1173 (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)))
1177 1174
1178(defun gnus-registry-install-hooks () 1175(defun gnus-registry-install-hooks ()
1179 "Install the registry hooks." 1176 "Install the registry hooks."
1180 (setq gnus-registry-enabled t) 1177 (setq gnus-registry-enabled t)
1181 (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) 1178 (add-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
1182 (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) 1179 (add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
1183 (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) 1180 (add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
1184 (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) 1181 (add-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
1185 1182
1186 (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) 1183 (add-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
1187 1184
1188 (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) 1185 (add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids))
1189 1186
1190(defun gnus-registry-unload-hook () 1187(defun gnus-registry-unload-hook ()
1191 "Uninstall the registry hooks." 1188 "Uninstall the registry hooks."
1192 (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) 1189 (remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
1193 (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) 1190 (remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
1194 (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) 1191 (remove-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
1195 (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) 1192 (remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
1196 1193
1197 (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) 1194 (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
1198 (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) 1195 (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)
1199 1196
1200 (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids) 1197 (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)
1201 (setq gnus-registry-enabled nil)) 1198 (setq gnus-registry-enabled nil))
1202 1199
1203(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) 1200(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook)
1204 1201
1205(defun gnus-registry-install-p () 1202(defun gnus-registry-install-p ()
1206 "Return non-nil if the registry is enabled (and maybe enable it first). 1203 "Return non-nil if the registry is enabled (and maybe enable it first).
@@ -1234,7 +1231,7 @@ data stored in the registry."
1234 (seen-groups (list (gnus-group-group-name)))) 1231 (seen-groups (list (gnus-group-group-name))))
1235 1232
1236 (catch 'found 1233 (catch 'found
1237 (dolist (group (mapcar 'gnus-simplify-group-name groups)) 1234 (dolist (group (mapcar #'gnus-simplify-group-name groups))
1238 1235
1239 ;; skip over any groups we really don't want to warp to. 1236 ;; skip over any groups we really don't want to warp to.
1240 (unless (or (member group seen-groups) 1237 (unless (or (member group seen-groups)
@@ -1270,7 +1267,7 @@ EXTRA is a list of symbols. Valid symbols are those contained in
1270the docs of `gnus-registry-track-extra'. This command is useful 1267the docs of `gnus-registry-track-extra'. This command is useful
1271when you stop tracking some extra data and now want to purge it 1268when you stop tracking some extra data and now want to purge it
1272from your existing entries." 1269from your existing entries."
1273 (interactive (list (mapcar 'intern 1270 (interactive (list (mapcar #'intern
1274 (completing-read-multiple 1271 (completing-read-multiple
1275 "Extra data: " 1272 "Extra data: "
1276 '("subject" "sender" "recipient"))))) 1273 '("subject" "sender" "recipient")))))
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc3c35..ff59a72ac87 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -26,6 +26,7 @@
26 26
27(require 'url) 27(require 'url)
28(require 'url-cache) 28(require 'url-cache)
29(require 'dns)
29(eval-when-compile 30(eval-when-compile
30 (require 'subr-x)) 31 (require 'subr-x))
31 32
@@ -118,9 +119,42 @@ a gravatar for a given email address."
118 :version "27.1" 119 :version "27.1"
119 :group 'gravatar) 120 :group 'gravatar)
120 121
121(defconst gravatar-base-url 122(defconst gravatar-service-alist
122 "https://www.gravatar.com/avatar" 123 `((gravatar . ,(lambda (_addr) "https://www.gravatar.com/avatar"))
123 "Base URL for getting gravatars.") 124 (unicornify . ,(lambda (_addr) "https://unicornify.pictures/avatar/"))
125 (libravatar . ,#'gravatar--service-libravatar))
126 "Alist of supported gravatar services.")
127
128(defcustom gravatar-service 'libravatar
129 "Symbol denoting gravatar-like service to use.
130Note that certain services might ignore other options, such as
131`gravatar-default-image' or certain values as with
132`gravatar-rating'."
133 :type `(choice ,@(mapcar (lambda (s) `(const ,(car s)))
134 gravatar-service-alist))
135 :version "28.1"
136 :link '(url-link "https://www.libravatar.org/")
137 :link '(url-link "https://unicornify.pictures/")
138 :link '(url-link "https://gravatar.com/")
139 :group 'gravatar)
140
141(defun gravatar--service-libravatar (addr)
142 "Find domain that hosts avatars for email address ADDR."
143 ;; implements https://wiki.libravatar.org/api/
144 (save-match-data
145 (if (not (string-match ".+@\\(.+\\)" addr))
146 "https://seccdn.libravatar.org/avatar"
147 (let ((domain (match-string 1 addr)))
148 (catch 'found
149 (dolist (record '(("_avatars-sec" . "https")
150 ("_avatars" . "http")))
151 (let* ((query (concat (car record) "._tcp." domain))
152 (result (dns-query query 'SRV)))
153 (when result
154 (throw 'found (format "%s://%s/avatar"
155 (cdr record)
156 result)))))
157 "https://seccdn.libravatar.org/avatar")))))
124 158
125(defun gravatar-hash (mail-address) 159(defun gravatar-hash (mail-address)
126 "Return the Gravatar hash for MAIL-ADDRESS." 160 "Return the Gravatar hash for MAIL-ADDRESS."
@@ -142,7 +176,8 @@ a gravatar for a given email address."
142 "Return the URL of a gravatar for MAIL-ADDRESS." 176 "Return the URL of a gravatar for MAIL-ADDRESS."
143 ;; https://gravatar.com/site/implement/images/ 177 ;; https://gravatar.com/site/implement/images/
144 (format "%s/%s?%s" 178 (format "%s/%s?%s"
145 gravatar-base-url 179 (funcall (alist-get gravatar-service gravatar-service-alist)
180 mail-address)
146 (gravatar-hash mail-address) 181 (gravatar-hash mail-address)
147 (gravatar--query-string))) 182 (gravatar--query-string)))
148 183
diff --git a/lisp/isearch.el b/lisp/isearch.el
index ddf9190dc6d..7625ec12b58 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2011,15 +2011,16 @@ Turning on character-folding turns off regexp mode.")
2011(defvar isearch-message-properties minibuffer-prompt-properties 2011(defvar isearch-message-properties minibuffer-prompt-properties
2012 "Text properties that are added to the isearch prompt.") 2012 "Text properties that are added to the isearch prompt.")
2013 2013
2014(defun isearch--momentary-message (string) 2014(defun isearch--momentary-message (string &optional seconds)
2015 "Print STRING at the end of the isearch prompt for 1 second." 2015 "Print STRING at the end of the isearch prompt for 1 second.
2016The optional argument SECONDS overrides the number of seconds."
2016 (let ((message-log-max nil)) 2017 (let ((message-log-max nil))
2017 (message "%s%s%s" 2018 (message "%s%s%s"
2018 (isearch-message-prefix nil isearch-nonincremental) 2019 (isearch-message-prefix nil isearch-nonincremental)
2019 isearch-message 2020 isearch-message
2020 (apply #'propertize (format " [%s]" string) 2021 (apply #'propertize (format " [%s]" string)
2021 isearch-message-properties))) 2022 isearch-message-properties)))
2022 (sit-for 1)) 2023 (sit-for (or seconds 1)))
2023 2024
2024(isearch-define-mode-toggle lax-whitespace " " nil 2025(isearch-define-mode-toggle lax-whitespace " " nil
2025 "In ordinary search, toggles the value of the variable 2026 "In ordinary search, toggles the value of the variable
@@ -3443,7 +3444,10 @@ Optional third argument, if t, means if fail just return nil (no error).
3443 (string-match "\\`Regular expression too big" isearch-error)) 3444 (string-match "\\`Regular expression too big" isearch-error))
3444 (cond 3445 (cond
3445 (isearch-regexp-function 3446 (isearch-regexp-function
3446 (setq isearch-error "Too many words")) 3447 (setq isearch-error nil)
3448 (setq isearch-regexp-function nil)
3449 (isearch-search-and-update)
3450 (isearch--momentary-message "Too many words; switched to literal mode" 2))
3447 ((and isearch-lax-whitespace search-whitespace-regexp) 3451 ((and isearch-lax-whitespace search-whitespace-regexp)
3448 (setq isearch-error "Too many spaces for whitespace matching")))))) 3452 (setq isearch-error "Too many spaces for whitespace matching"))))))
3449 3453
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index d73cd74da0b..9cdb108be03 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -48,8 +48,7 @@ Preserves the `buffer-modified-p' state of the current buffer."
48 "Jit-lock fontifies chunks of at most this many characters at a time. 48 "Jit-lock fontifies chunks of at most this many characters at a time.
49 49
50This variable controls both display-time and stealth fontification." 50This variable controls both display-time and stealth fontification."
51 :type 'integer 51 :type 'integer)
52 :group 'jit-lock)
53 52
54 53
55(defcustom jit-lock-stealth-time nil 54(defcustom jit-lock-stealth-time nil
@@ -59,8 +58,7 @@ If nil, stealth fontification is never performed.
59 58
60The value of this variable is used when JIT Lock mode is turned on." 59The value of this variable is used when JIT Lock mode is turned on."
61 :type '(choice (const :tag "never" nil) 60 :type '(choice (const :tag "never" nil)
62 (number :tag "seconds" :value 16)) 61 (number :tag "seconds" :value 16)))
63 :group 'jit-lock)
64 62
65 63
66(defcustom jit-lock-stealth-nice 0.5 64(defcustom jit-lock-stealth-nice 0.5
@@ -72,8 +70,7 @@ To reduce machine load during stealth fontification, at the cost of stealth
72taking longer to fontify, you could increase the value of this variable. 70taking longer to fontify, you could increase the value of this variable.
73See also `jit-lock-stealth-load'." 71See also `jit-lock-stealth-load'."
74 :type '(choice (const :tag "never" nil) 72 :type '(choice (const :tag "never" nil)
75 (number :tag "seconds")) 73 (number :tag "seconds")))
76 :group 'jit-lock)
77 74
78 75
79(defcustom jit-lock-stealth-load 76(defcustom jit-lock-stealth-load
@@ -89,14 +86,12 @@ See also `jit-lock-stealth-nice'."
89 :type (if (condition-case nil (load-average) (error)) 86 :type (if (condition-case nil (load-average) (error))
90 '(choice (const :tag "never" nil) 87 '(choice (const :tag "never" nil)
91 (integer :tag "load")) 88 (integer :tag "load"))
92 '(const :format "%t: unsupported\n" nil)) 89 '(const :format "%t: unsupported\n" nil)))
93 :group 'jit-lock)
94 90
95 91
96(defcustom jit-lock-stealth-verbose nil 92(defcustom jit-lock-stealth-verbose nil
97 "If non-nil, means stealth fontification should show status messages." 93 "If non-nil, means stealth fontification should show status messages."
98 :type 'boolean 94 :type 'boolean)
99 :group 'jit-lock)
100 95
101 96
102(defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually) 97(defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually)
@@ -115,13 +110,11 @@ buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
115The value of this variable is used when JIT Lock mode is turned on." 110The value of this variable is used when JIT Lock mode is turned on."
116 :type '(choice (const :tag "never" nil) 111 :type '(choice (const :tag "never" nil)
117 (const :tag "always" t) 112 (const :tag "always" t)
118 (other :tag "syntax-driven" syntax-driven)) 113 (other :tag "syntax-driven" syntax-driven)))
119 :group 'jit-lock)
120 114
121(defcustom jit-lock-context-time 0.5 115(defcustom jit-lock-context-time 0.5
122 "Idle time after which text is contextually refontified, if applicable." 116 "Idle time after which text is contextually refontified, if applicable."
123 :type '(number :tag "seconds") 117 :type '(number :tag "seconds"))
124 :group 'jit-lock)
125 118
126(defcustom jit-lock-antiblink-grace 2 119(defcustom jit-lock-antiblink-grace 2
127 "Delay after which to refontify unterminated strings and comments. 120 "Delay after which to refontify unterminated strings and comments.
@@ -134,14 +127,12 @@ and comments, the delay helps avoid unpleasant \"blinking\", between
134string/comment and non-string/non-comment fontification." 127string/comment and non-string/non-comment fontification."
135 :type '(choice (const :tag "never" nil) 128 :type '(choice (const :tag "never" nil)
136 (number :tag "seconds")) 129 (number :tag "seconds"))
137 :group 'jit-lock
138 :version "27.1") 130 :version "27.1")
139 131
140(defcustom jit-lock-defer-time nil ;; 0.25 132(defcustom jit-lock-defer-time nil ;; 0.25
141 "Idle time after which deferred fontification should take place. 133 "Idle time after which deferred fontification should take place.
142If nil, fontification is not deferred. 134If nil, fontification is not deferred.
143If 0, then fontification is only deferred while there is input pending." 135If 0, then fontification is only deferred while there is input pending."
144 :group 'jit-lock
145 :type '(choice (const :tag "never" nil) 136 :type '(choice (const :tag "never" nil)
146 (number :tag "seconds"))) 137 (number :tag "seconds")))
147 138
@@ -262,7 +253,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
262 253
263 ;; Setup our hooks. 254 ;; Setup our hooks.
264 (add-hook 'after-change-functions 'jit-lock-after-change nil t) 255 (add-hook 'after-change-functions 'jit-lock-after-change nil t)
265 (add-hook 'fontification-functions 'jit-lock-function)) 256 (add-hook 'fontification-functions 'jit-lock-function nil t))
266 257
267 ;; Turn Just-in-time Lock mode off. 258 ;; Turn Just-in-time Lock mode off.
268 (t 259 (t
@@ -294,7 +285,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
294When this minor mode is enabled, jit-lock runs as little code as possible 285When this minor mode is enabled, jit-lock runs as little code as possible
295during redisplay and moves the rest to a timer, where things 286during redisplay and moves the rest to a timer, where things
296like `debug-on-error' and Edebug can be used." 287like `debug-on-error' and Edebug can be used."
297 :global t :group 'jit-lock 288 :global t
298 (when jit-lock-defer-timer 289 (when jit-lock-defer-timer
299 (cancel-timer jit-lock-defer-timer) 290 (cancel-timer jit-lock-defer-timer)
300 (setq jit-lock-defer-timer nil)) 291 (setq jit-lock-defer-timer nil))
@@ -438,8 +429,8 @@ Defaults to the whole buffer. END can be out of bounds."
438 (quit (put-text-property start next 'fontified nil) 429 (quit (put-text-property start next 'fontified nil)
439 (signal (car err) (cdr err)))))) 430 (signal (car err) (cdr err))))))
440 431
441 ;; In case we fontified more than requested, take advantage of the 432 ;; In case we fontified more than requested, take
442 ;; good news. 433 ;; advantage of the good news.
443 (when (or (< tight-beg start) (> tight-end next)) 434 (when (or (< tight-beg start) (> tight-end next))
444 (put-text-property tight-beg tight-end 'fontified t)) 435 (put-text-property tight-beg tight-end 'fontified t))
445 436
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 2952242c251..8851522bbdb 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -435,9 +435,9 @@ not contain `d', so that a full listing is expected."
435 ;; text. But if the listing is empty, as e.g. in empty 435 ;; text. But if the listing is empty, as e.g. in empty
436 ;; directories with -a removed from switches, point will be 436 ;; directories with -a removed from switches, point will be
437 ;; before the inserted text, and dired-insert-directory will 437 ;; before the inserted text, and dired-insert-directory will
438 ;; not indent the listing correctly. Going to the end of the 438 ;; not indent the listing correctly. Getting past the
439 ;; buffer fixes that. 439 ;; inserted text solves this.
440 (unless files (goto-char (point-max))) 440 (unless (cdr total-line) (forward-line 2))
441 (if (memq ?R switches) 441 (if (memq ?R switches)
442 ;; List the contents of all directories recursively. 442 ;; List the contents of all directories recursively.
443 ;; cadr of each element of `file-alist' is t for 443 ;; cadr of each element of `file-alist' is t for
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index bfeaebac2cd..aae25d1dbf3 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -629,9 +629,6 @@ But handle the case, if the \"test\" command is not available."
629 (format "File %s exists; overwrite anyway? " filename))))) 629 (format "File %s exists; overwrite anyway? " filename)))))
630 (tramp-error v 'file-already-exists filename)) 630 (tramp-error v 'file-already-exists filename))
631 631
632 ;; We must also flush the cache of the directory, because
633 ;; `file-attributes' reads the values from there.
634 (tramp-flush-file-properties v localname)
635 (let* ((curbuf (current-buffer)) 632 (let* ((curbuf (current-buffer))
636 (tmpfile (tramp-compat-make-temp-file filename))) 633 (tmpfile (tramp-compat-make-temp-file filename)))
637 (when (and append (file-exists-p filename)) 634 (when (and append (file-exists-p filename))
@@ -648,6 +645,10 @@ But handle the case, if the \"test\" command is not available."
648 (tramp-error v 'file-error "Cannot write: `%s'" filename)) 645 (tramp-error v 'file-error "Cannot write: `%s'" filename))
649 (delete-file tmpfile))) 646 (delete-file tmpfile)))
650 647
648 ;; We must also flush the cache of the directory, because
649 ;; `file-attributes' reads the values from there.
650 (tramp-flush-file-properties v localname)
651
651 (unless (equal curbuf (current-buffer)) 652 (unless (equal curbuf (current-buffer))
652 (tramp-error 653 (tramp-error
653 v 'file-error 654 v 'file-error
@@ -1096,7 +1097,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
1096 "Like `exec-path' for Tramp files." 1097 "Like `exec-path' for Tramp files."
1097 (append 1098 (append
1098 (with-parsed-tramp-file-name default-directory nil 1099 (with-parsed-tramp-file-name default-directory nil
1099 (with-tramp-connection-property v "remote-path" 1100 (with-tramp-connection-property (tramp-get-process v) "remote-path"
1100 (tramp-adb-send-command v "echo \\\"$PATH\\\"") 1101 (tramp-adb-send-command v "echo \\\"$PATH\\\"")
1101 (split-string 1102 (split-string
1102 (with-current-buffer (tramp-get-connection-buffer v) 1103 (with-current-buffer (tramp-get-connection-buffer v)
@@ -1111,11 +1112,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
1111 "Return full host name from VEC to be used in shell execution. 1112 "Return full host name from VEC to be used in shell execution.
1112E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" 1113E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
1113 a host name \"R38273882DE\" returns \"R38273882DE\"." 1114 a host name \"R38273882DE\" returns \"R38273882DE\"."
1114 ;; Sometimes this is called before there is a connection process 1115 (with-tramp-connection-property (tramp-get-process vec) "device"
1115 ;; yet. In order to work with the connection cache, we flush all
1116 ;; unwanted entries first.
1117 (tramp-flush-connection-properties nil)
1118 (with-tramp-connection-property (tramp-get-connection-process vec) "device"
1119 (let* ((host (tramp-file-name-host vec)) 1116 (let* ((host (tramp-file-name-host vec))
1120 (port (tramp-file-name-port-or-default vec)) 1117 (port (tramp-file-name-port-or-default vec))
1121 (devices (mapcar #'cadr (tramp-adb-parse-device-names nil)))) 1118 (devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 91ed5465695..93eeb16f547 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -31,13 +31,13 @@
31;; a process, has a unique cache. We distinguish 4 kind of caches, 31;; a process, has a unique cache. We distinguish 4 kind of caches,
32;; depending on the key: 32;; depending on the key:
33;; 33;;
34;; - localname is NIL. This are reusable properties. Examples: 34;; - localname is nil. These are reusable properties. Examples:
35;; "remote-shell" identifies the POSIX shell to be called on the 35;; "remote-shell" identifies the POSIX shell to be called on the
36;; remote host, or "perl" is the command to be called on the remote 36;; remote host, or "perl" is the command to be called on the remote
37;; host when starting a Perl script. These properties are saved in 37;; host when starting a Perl script. These properties are saved in
38;; the file `tramp-persistency-file-name'. 38;; the file `tramp-persistency-file-name'.
39;; 39;;
40;; - localname is a string. This are temporary properties, which are 40;; - localname is a string. These are temporary properties, which are
41;; related to the file localname is referring to. Examples: 41;; related to the file localname is referring to. Examples:
42;; "file-exists-p" is t or nil, depending on the file existence, or 42;; "file-exists-p" is t or nil, depending on the file existence, or
43;; "file-attributes" caches the result of the function 43;; "file-attributes" caches the result of the function
@@ -45,21 +45,32 @@
45;; expire after `remote-file-name-inhibit-cache' seconds if this 45;; expire after `remote-file-name-inhibit-cache' seconds if this
46;; variable is set. 46;; variable is set.
47;; 47;;
48;; - The key is a process. This are temporary properties related to 48;; - The key is a process. These are temporary properties related to
49;; an open connection. Examples: "scripts" keeps shell script 49;; an open connection. Examples: "scripts" keeps shell script
50;; definitions already sent to the remote shell, "last-cmd-time" is 50;; definitions already sent to the remote shell, "last-cmd-time" is
51;; the time stamp a command has been sent to the remote process. 51;; the time stamp a command has been sent to the remote process.
52;; 52;;
53;; - The key is nil. This are temporary properties related to the 53;; - The key is nil. These are temporary properties related to the
54;; local machine. Examples: "parse-passwd" and "parse-group" keep 54;; local machine. Examples: "parse-passwd" and "parse-group" keep
55;; the results of parsing "/etc/passwd" and "/etc/group", 55;; the results of parsing "/etc/passwd" and "/etc/group",
56;; "{uid,gid}-{integer,string}" are the local uid and gid, and 56;; "{uid,gid}-{integer,string}" are the local uid and gid, and
57;; "locale" is the used shell locale. 57;; "locale" is the used shell locale.
58;;
59;; - The key is `tramp-cache-undefined'. All functions return the
60;; expected values, but nothing is cached.
58 61
59;; Some properties are handled special: 62;; Some properties are handled special:
60;; 63;;
61;; - "process-name", "process-buffer" and "first-password-request" are 64;; - "process-name", "process-buffer" and "first-password-request" are
62;; not saved in the file `tramp-persistency-file-name'. 65;; not saved in the file `tramp-persistency-file-name', although
66;; being connection properties related to a `tramp-file-name'
67;; structure.
68;;
69;; - Reusable properties, which should not be saved, are kept in the
70;; process key retrieved by `tramp-get-process' (the main connection
71;; process). Other processes could reuse these properties, avoiding
72;; recomputation when a new asynchronous process is created by
73;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el).
63 74
64;;; Code: 75;;; Code:
65 76
@@ -96,25 +107,31 @@ details see the info pages."
96(defvar tramp-cache-data-changed nil 107(defvar tramp-cache-data-changed nil
97 "Whether persistent cache data have been changed.") 108 "Whether persistent cache data have been changed.")
98 109
110;;;###tramp-autoload
111(defconst tramp-cache-undefined 'undef
112 "The symbol marking undefined hash keys and values.")
113
99(defun tramp-get-hash-table (key) 114(defun tramp-get-hash-table (key)
100 "Return the hash table for KEY. 115 "Return the hash table for KEY.
101If it doesn't exist yet, it is created and initialized with 116If it doesn't exist yet, it is created and initialized with
102matching entries of `tramp-connection-properties'." 117matching entries of `tramp-connection-properties'.
103 (or (gethash key tramp-cache-data) 118If KEY is `tramp-cache-undefined', don't create anything, and return nil."
104 (let ((hash 119 (unless (eq key tramp-cache-undefined)
105 (puthash key (make-hash-table :test #'equal) tramp-cache-data))) 120 (or (gethash key tramp-cache-data)
106 (when (tramp-file-name-p key) 121 (let ((hash
107 (dolist (elt tramp-connection-properties) 122 (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
108 (when (string-match-p 123 (when (tramp-file-name-p key)
109 (or (nth 0 elt) "") 124 (dolist (elt tramp-connection-properties)
110 (tramp-make-tramp-file-name key 'noloc 'nohop)) 125 (when (string-match-p
111 (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) 126 (or (nth 0 elt) "")
112 hash))) 127 (tramp-make-tramp-file-name key 'noloc 'nohop))
128 (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
129 hash))))
113 130
114;;;###tramp-autoload 131;;;###tramp-autoload
115(defun tramp-get-file-property (key file property default) 132(defun tramp-get-file-property (key file property default)
116 "Get the PROPERTY of FILE from the cache context of KEY. 133 "Get the PROPERTY of FILE from the cache context of KEY.
117Returns DEFAULT if not set." 134Return DEFAULT if not set."
118 ;; Unify localname. Remove hop from `tramp-file-name' structure. 135 ;; Unify localname. Remove hop from `tramp-file-name' structure.
119 (setq file (tramp-compat-file-name-unquote file) 136 (setq file (tramp-compat-file-name-unquote file)
120 key (copy-tramp-file-name key)) 137 key (copy-tramp-file-name key))
@@ -152,7 +169,7 @@ Returns DEFAULT if not set."
152;;;###tramp-autoload 169;;;###tramp-autoload
153(defun tramp-set-file-property (key file property value) 170(defun tramp-set-file-property (key file property value)
154 "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. 171 "Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
155Returns VALUE." 172Return VALUE."
156 ;; Unify localname. Remove hop from `tramp-file-name' structure. 173 ;; Unify localname. Remove hop from `tramp-file-name' structure.
157 (setq file (tramp-compat-file-name-unquote file) 174 (setq file (tramp-compat-file-name-unquote file)
158 key (copy-tramp-file-name key)) 175 key (copy-tramp-file-name key))
@@ -283,8 +300,9 @@ This is suppressed for temporary buffers."
283 "Get the named PROPERTY for the connection. 300 "Get the named PROPERTY for the connection.
284KEY identifies the connection, it is either a process or a 301KEY identifies the connection, it is either a process or a
285`tramp-file-name' structure. A special case is nil, which is 302`tramp-file-name' structure. A special case is nil, which is
286used to cache connection properties of the local machine. If the 303used to cache connection properties of the local machine.
287value is not set for the connection, returns DEFAULT." 304If KEY is `tramp-cache-undefined', or if the value is not set for
305the connection, return DEFAULT."
288 ;; Unify key by removing localname and hop from `tramp-file-name' 306 ;; Unify key by removing localname and hop from `tramp-file-name'
289 ;; structure. Work with a copy in order to avoid side effects. 307 ;; structure. Work with a copy in order to avoid side effects.
290 (when (tramp-file-name-p key) 308 (when (tramp-file-name-p key)
@@ -308,19 +326,22 @@ value is not set for the connection, returns DEFAULT."
308 "Set the named PROPERTY of a connection to VALUE. 326 "Set the named PROPERTY of a connection to VALUE.
309KEY identifies the connection, it is either a process or a 327KEY identifies the connection, it is either a process or a
310`tramp-file-name' structure. A special case is nil, which is 328`tramp-file-name' structure. A special case is nil, which is
311used to cache connection properties of the local machine. 329used to cache connection properties of the local machine. If KEY
312PROPERTY is set persistent when KEY is a `tramp-file-name' structure." 330is `tramp-cache-undefined', nothing is set.
331PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
332Return VALUE."
313 ;; Unify key by removing localname and hop from `tramp-file-name' 333 ;; Unify key by removing localname and hop from `tramp-file-name'
314 ;; structure. Work with a copy in order to avoid side effects. 334 ;; structure. Work with a copy in order to avoid side effects.
315 (when (tramp-file-name-p key) 335 (when (tramp-file-name-p key)
316 (setq key (copy-tramp-file-name key)) 336 (setq key (copy-tramp-file-name key))
317 (setf (tramp-file-name-localname key) nil 337 (setf (tramp-file-name-localname key) nil
318 (tramp-file-name-hop key) nil)) 338 (tramp-file-name-hop key) nil))
319 (let ((hash (tramp-get-hash-table key))) 339 (when-let ((hash (tramp-get-hash-table key)))
320 (puthash property value hash) 340 (puthash property value hash))
321 (setq tramp-cache-data-changed t) 341 (setq tramp-cache-data-changed
322 (tramp-message key 7 "%s %s" property value) 342 (or tramp-cache-data-changed (tramp-tramp-file-p key)))
323 value)) 343 (tramp-message key 7 "%s %s" property value)
344 value)
324 345
325;;;###tramp-autoload 346;;;###tramp-autoload
326(defun tramp-connection-property-p (key property) 347(defun tramp-connection-property-p (key property)
@@ -328,7 +349,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
328KEY identifies the connection, it is either a process or a 349KEY identifies the connection, it is either a process or a
329`tramp-file-name' structure. A special case is nil, which is 350`tramp-file-name' structure. A special case is nil, which is
330used to cache connection properties of the local machine." 351used to cache connection properties of the local machine."
331 (not (eq (tramp-get-connection-property key property 'undef) 'undef))) 352 (not (eq (tramp-get-connection-property key property tramp-cache-undefined)
353 tramp-cache-undefined)))
332 354
333;;;###tramp-autoload 355;;;###tramp-autoload
334(defun tramp-flush-connection-property (key property) 356(defun tramp-flush-connection-property (key property)
@@ -343,8 +365,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
343 (setq key (copy-tramp-file-name key)) 365 (setq key (copy-tramp-file-name key))
344 (setf (tramp-file-name-localname key) nil 366 (setf (tramp-file-name-localname key) nil
345 (tramp-file-name-hop key) nil)) 367 (tramp-file-name-hop key) nil))
346 (remhash property (tramp-get-hash-table key)) 368 (when-let ((hash (tramp-get-hash-table key)))
347 (setq tramp-cache-data-changed t) 369 (remhash property hash))
370 (setq tramp-cache-data-changed
371 (or tramp-cache-data-changed (tramp-tramp-file-p key)))
348 (tramp-message key 7 "%s" property)) 372 (tramp-message key 7 "%s" property))
349 373
350;;;###tramp-autoload 374;;;###tramp-autoload
@@ -361,9 +385,10 @@ used to cache connection properties of the local machine."
361 (tramp-file-name-hop key) nil)) 385 (tramp-file-name-hop key) nil))
362 (tramp-message 386 (tramp-message
363 key 7 "%s %s" key 387 key 7 "%s %s" key
364 (let ((hash (gethash key tramp-cache-data))) 388 (when-let ((hash (gethash key tramp-cache-data)))
365 (when (hash-table-p hash) (hash-table-keys hash)))) 389 (hash-table-keys hash)))
366 (setq tramp-cache-data-changed t) 390 (setq tramp-cache-data-changed
391 (or tramp-cache-data-changed (tramp-tramp-file-p key)))
367 (remhash key tramp-cache-data)) 392 (remhash key tramp-cache-data))
368 393
369;;;###tramp-autoload 394;;;###tramp-autoload
@@ -414,7 +439,8 @@ used to cache connection properties of the local machine."
414 (hash-table-keys tramp-cache-data))))) 439 (hash-table-keys tramp-cache-data)))))
415 440
416(defun tramp-dump-connection-properties () 441(defun tramp-dump-connection-properties ()
417 "Write persistent connection properties into file `tramp-persistency-file-name'." 442 "Write persistent connection properties into file \
443`tramp-persistency-file-name'."
418 ;; We shouldn't fail, otherwise Emacs might not be able to be closed. 444 ;; We shouldn't fail, otherwise Emacs might not be able to be closed.
419 (ignore-errors 445 (ignore-errors
420 (when (and (hash-table-p tramp-cache-data) 446 (when (and (hash-table-p tramp-cache-data)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index b4dca2321c1..7d353e262af 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -107,21 +107,19 @@ When called interactively, a Tramp connection has to be selected."
107 ;; suppressed. 107 ;; suppressed.
108 (setq tramp-current-connection nil) 108 (setq tramp-current-connection nil)
109 109
110 ;; Flush file cache.
111 (tramp-flush-directory-properties vec "")
112
113 ;; Flush connection cache.
114 (when (processp (tramp-get-connection-process vec))
115 (tramp-flush-connection-properties (tramp-get-connection-process vec))
116 (delete-process (tramp-get-connection-process vec)))
117 (tramp-flush-connection-properties vec)
118
119 ;; Cancel timer. 110 ;; Cancel timer.
120 (dolist (timer timer-list) 111 (dolist (timer timer-list)
121 (when (and (eq (timer--function timer) 'tramp-timeout-session) 112 (when (and (eq (timer--function timer) 'tramp-timeout-session)
122 (tramp-file-name-equal-p vec (car (timer--args timer)))) 113 (tramp-file-name-equal-p vec (car (timer--args timer))))
123 (cancel-timer timer))) 114 (cancel-timer timer)))
124 115
116 ;; Delete processes.
117 (dolist (key (hash-table-keys tramp-cache-data))
118 (when (and (processp key)
119 (tramp-file-name-equal-p (process-get key 'vector) vec))
120 (tramp-flush-connection-properties key)
121 (delete-process key)))
122
125 ;; Remove buffers. 123 ;; Remove buffers.
126 (dolist 124 (dolist
127 (buf (list (get-buffer (tramp-buffer-name vec)) 125 (buf (list (get-buffer (tramp-buffer-name vec))
@@ -130,6 +128,12 @@ When called interactively, a Tramp connection has to be selected."
130 (tramp-get-connection-property vec "process-buffer" nil))) 128 (tramp-get-connection-property vec "process-buffer" nil)))
131 (when (bufferp buf) (kill-buffer buf))) 129 (when (bufferp buf) (kill-buffer buf)))
132 130
131 ;; Flush file cache.
132 (tramp-flush-directory-properties vec "")
133
134 ;; Flush connection cache.
135 (tramp-flush-connection-properties vec)
136
133 ;; The end. 137 ;; The end.
134 (run-hook-with-args 'tramp-cleanup-connection-hook vec))) 138 (run-hook-with-args 'tramp-cleanup-connection-hook vec)))
135 139
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 85f28076168..526c564ee33 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1731,8 +1731,7 @@ a downcased host name only."
1731 (list 1731 (list
1732 t ;; handled. 1732 t ;; handled.
1733 nil ;; no abort of D-Bus. 1733 nil ;; no abort of D-Bus.
1734 (with-tramp-connection-property 1734 (with-tramp-connection-property (tramp-get-process v) message
1735 (tramp-get-connection-process v) message
1736 ;; In theory, there can be several choices. 1735 ;; In theory, there can be several choices.
1737 ;; Until now, there is only the question whether 1736 ;; Until now, there is only the question whether
1738 ;; to accept an unknown host signature or certificate. 1737 ;; to accept an unknown host signature or certificate.
@@ -1946,8 +1945,7 @@ a downcased host name only."
1946 (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec)))) 1945 (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
1947 (while (tramp-gvfs-connection-mounted-p vec) 1946 (while (tramp-gvfs-connection-mounted-p vec)
1948 (read-event nil nil 0.1)) 1947 (read-event nil nil 0.1))
1949 (tramp-flush-connection-properties vec) 1948 (tramp-cleanup-connection vec 'keep-debug 'keep-password))
1950 (tramp-flush-connection-properties (tramp-get-connection-process vec)))
1951 1949
1952(defun tramp-gvfs-mount-spec-entry (key value) 1950(defun tramp-gvfs-mount-spec-entry (key value)
1953 "Construct a mount-spec entry to be used in a mount_spec. 1951 "Construct a mount-spec entry to be used in a mount_spec.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 06dca312275..c770e3ce400 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1539,7 +1539,7 @@ of."
1539 1539
1540(defun tramp-remote-selinux-p (vec) 1540(defun tramp-remote-selinux-p (vec)
1541 "Check, whether SELINUX is enabled on the remote host." 1541 "Check, whether SELINUX is enabled on the remote host."
1542 (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p" 1542 (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
1543 (tramp-send-command-and-check vec "selinuxenabled"))) 1543 (tramp-send-command-and-check vec "selinuxenabled")))
1544 1544
1545(defun tramp-sh-handle-file-selinux-context (filename) 1545(defun tramp-sh-handle-file-selinux-context (filename)
@@ -1588,7 +1588,7 @@ of."
1588 1588
1589(defun tramp-remote-acl-p (vec) 1589(defun tramp-remote-acl-p (vec)
1590 "Check, whether ACL is enabled on the remote host." 1590 "Check, whether ACL is enabled on the remote host."
1591 (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p" 1591 (with-tramp-connection-property (tramp-get-process vec) "acl-p"
1592 (tramp-send-command-and-check vec "getfacl /"))) 1592 (tramp-send-command-and-check vec "getfacl /")))
1593 1593
1594(defun tramp-sh-handle-file-acl (filename) 1594(defun tramp-sh-handle-file-acl (filename)
@@ -3580,23 +3580,29 @@ STDERR can also be a file name."
3580 remote-file-name-inhibit-cache process-file-side-effects) 3580 remote-file-name-inhibit-cache process-file-side-effects)
3581 ;; Reduce `vc-handled-backends' in order to minimize 3581 ;; Reduce `vc-handled-backends' in order to minimize
3582 ;; process calls. 3582 ;; process calls.
3583 (when (and (memq 'Bzr vc-handled-backends) 3583 (when (and
3584 (boundp 'vc-bzr-program) 3584 (memq 'Bzr vc-handled-backends)
3585 (not (with-tramp-connection-property v vc-bzr-program 3585 (not (and
3586 (tramp-find-executable 3586 (bound-and-true-p vc-bzr-program)
3587 v vc-bzr-program (tramp-get-remote-path v))))) 3587 (with-tramp-connection-property v vc-bzr-program
3588 (tramp-find-executable
3589 v vc-bzr-program (tramp-get-remote-path v))))))
3588 (setq vc-handled-backends (remq 'Bzr vc-handled-backends))) 3590 (setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
3589 (when (and (memq 'Git vc-handled-backends) 3591 (when (and
3590 (boundp 'vc-git-program) 3592 (memq 'Git vc-handled-backends)
3591 (not (with-tramp-connection-property v vc-git-program 3593 (not (and
3592 (tramp-find-executable 3594 (bound-and-true-p vc-git-program)
3593 v vc-git-program (tramp-get-remote-path v))))) 3595 (with-tramp-connection-property v vc-git-program
3596 (tramp-find-executable
3597 v vc-git-program (tramp-get-remote-path v))))))
3594 (setq vc-handled-backends (remq 'Git vc-handled-backends))) 3598 (setq vc-handled-backends (remq 'Git vc-handled-backends)))
3595 (when (and (memq 'Hg vc-handled-backends) 3599 (when (and
3596 (boundp 'vc-hg-program) 3600 (memq 'Hg vc-handled-backends)
3597 (not (with-tramp-connection-property v vc-hg-program 3601 (not (and
3598 (tramp-find-executable 3602 (bound-and-true-p vc-hg-program)
3599 v vc-hg-program (tramp-get-remote-path v))))) 3603 (with-tramp-connection-property v vc-hg-program
3604 (tramp-find-executable
3605 v vc-hg-program (tramp-get-remote-path v))))))
3600 (setq vc-handled-backends (remq 'Hg vc-handled-backends))) 3606 (setq vc-handled-backends (remq 'Hg vc-handled-backends)))
3601 ;; Run. 3607 ;; Run.
3602 (tramp-with-demoted-errors 3608 (tramp-with-demoted-errors
@@ -4290,11 +4296,15 @@ process to set up. VEC specifies the connection."
4290 ;; connection properties. We start again with 4296 ;; connection properties. We start again with
4291 ;; `tramp-maybe-open-connection', it will be caught there. 4297 ;; `tramp-maybe-open-connection', it will be caught there.
4292 (tramp-message vec 5 "Checking system information") 4298 (tramp-message vec 5 "Checking system information")
4293 (let ((old-uname (tramp-get-connection-property vec "uname" nil)) 4299 (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
4294 (uname 4300 (uname
4295 (tramp-set-connection-property 4301 ;; If we are in `make-process', we don't need to recompute.
4296 vec "uname" 4302 (if (and old-uname
4297 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) 4303 (tramp-get-connection-property vec "process-name" nil))
4304 old-uname
4305 (tramp-set-connection-property
4306 vec "uname"
4307 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
4298 (when (and (stringp old-uname) (not (string-equal old-uname uname))) 4308 (when (and (stringp old-uname) (not (string-equal old-uname uname)))
4299 (tramp-message 4309 (tramp-message
4300 vec 3 4310 vec 3
@@ -5053,7 +5063,7 @@ connection if a previous connection has died for some reason."
5053 ;; we cannot use `tramp-get-connection-process'. 5063 ;; we cannot use `tramp-get-connection-process'.
5054 (tmpfile 5064 (tmpfile
5055 (with-tramp-connection-property 5065 (with-tramp-connection-property
5056 (get-process (tramp-buffer-name vec)) "temp-file" 5066 (tramp-get-process vec) "temp-file"
5057 (make-temp-name 5067 (make-temp-name
5058 (expand-file-name 5068 (expand-file-name
5059 tramp-temp-name-prefix 5069 tramp-temp-name-prefix
@@ -5426,7 +5436,7 @@ Nonexistent directories are removed from spec."
5426 ;; cache the result for the session only. Otherwise, the 5436 ;; cache the result for the session only. Otherwise, the
5427 ;; result is cached persistently. 5437 ;; result is cached persistently.
5428 (if (memq 'tramp-own-remote-path tramp-remote-path) 5438 (if (memq 'tramp-own-remote-path tramp-remote-path)
5429 (tramp-get-connection-process vec) 5439 (tramp-get-process vec)
5430 vec) 5440 vec)
5431 "remote-path" 5441 "remote-path"
5432 (let* ((remote-path (copy-tree tramp-remote-path)) 5442 (let* ((remote-path (copy-tree tramp-remote-path))
@@ -5945,10 +5955,9 @@ the length of the file to be compressed.
5945If no corresponding command is found, nil is returned." 5955If no corresponding command is found, nil is returned."
5946 (when (and (integerp tramp-inline-compress-start-size) 5956 (when (and (integerp tramp-inline-compress-start-size)
5947 (> size tramp-inline-compress-start-size)) 5957 (> size tramp-inline-compress-start-size))
5948 (with-tramp-connection-property (tramp-get-connection-process vec) prop 5958 (with-tramp-connection-property (tramp-get-process vec) prop
5949 (tramp-find-inline-compress vec) 5959 (tramp-find-inline-compress vec)
5950 (tramp-get-connection-property 5960 (tramp-get-connection-property (tramp-get-process vec) prop nil))))
5951 (tramp-get-connection-process vec) prop nil))))
5952 5961
5953(defun tramp-get-inline-coding (vec prop size) 5962(defun tramp-get-inline-coding (vec prop size)
5954 "Return the coding command related to PROP. 5963 "Return the coding command related to PROP.
@@ -5966,11 +5975,9 @@ function cell is returned to be applied on a buffer."
5966 ;; no inline coding is found. 5975 ;; no inline coding is found.
5967 (ignore-errors 5976 (ignore-errors
5968 (let ((coding 5977 (let ((coding
5969 (with-tramp-connection-property 5978 (with-tramp-connection-property (tramp-get-process vec) prop
5970 (tramp-get-connection-process vec) prop
5971 (tramp-find-inline-encoding vec) 5979 (tramp-find-inline-encoding vec)
5972 (tramp-get-connection-property 5980 (tramp-get-connection-property (tramp-get-process vec) prop nil)))
5973 (tramp-get-connection-process vec) prop nil)))
5974 (prop1 (if (string-match-p "encoding" prop) 5981 (prop1 (if (string-match-p "encoding" prop)
5975 "inline-compress" "inline-decompress")) 5982 "inline-compress" "inline-decompress"))
5976 compress) 5983 compress)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index effac333dad..d361db483a1 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1557,9 +1557,6 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
1557 (format "File %s exists; overwrite anyway? " filename))))) 1557 (format "File %s exists; overwrite anyway? " filename)))))
1558 (tramp-error v 'file-already-exists filename)) 1558 (tramp-error v 'file-already-exists filename))
1559 1559
1560 ;; We must also flush the cache of the directory, because
1561 ;; `file-attributes' reads the values from there.
1562 (tramp-flush-file-properties v localname)
1563 (let ((curbuf (current-buffer)) 1560 (let ((curbuf (current-buffer))
1564 (tmpfile (tramp-compat-make-temp-file filename))) 1561 (tmpfile (tramp-compat-make-temp-file filename)))
1565 (when (and append (file-exists-p filename)) 1562 (when (and append (file-exists-p filename))
@@ -1579,6 +1576,10 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
1579 (tramp-error v 'file-error "Cannot write `%s'" filename)) 1576 (tramp-error v 'file-error "Cannot write `%s'" filename))
1580 (delete-file tmpfile))) 1577 (delete-file tmpfile)))
1581 1578
1579 ;; We must also flush the cache of the directory, because
1580 ;; `file-attributes' reads the values from there.
1581 (tramp-flush-file-properties v localname)
1582
1582 (unless (equal curbuf (current-buffer)) 1583 (unless (equal curbuf (current-buffer))
1583 (tramp-error 1584 (tramp-error
1584 v 'file-error 1585 v 'file-error
@@ -1844,7 +1845,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
1844 (if (and (process-live-p (tramp-get-connection-process vec)) 1845 (if (and (process-live-p (tramp-get-connection-process vec))
1845 (tramp-get-connection-property vec "posix" t)) 1846 (tramp-get-connection-property vec "posix" t))
1846 (with-tramp-connection-property 1847 (with-tramp-connection-property
1847 (tramp-get-connection-process vec) "cifs-capabilities" 1848 (tramp-get-process vec) "cifs-capabilities"
1848 (save-match-data 1849 (save-match-data
1849 (when (tramp-smb-send-command vec "posix") 1850 (when (tramp-smb-send-command vec "posix")
1850 (with-current-buffer (tramp-get-connection-buffer vec) 1851 (with-current-buffer (tramp-get-connection-buffer vec)
@@ -1861,8 +1862,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
1861 ;; When we are not logged in yet, we return nil. 1862 ;; When we are not logged in yet, we return nil.
1862 (if (and (tramp-smb-get-share vec) 1863 (if (and (tramp-smb-get-share vec)
1863 (process-live-p (tramp-get-connection-process vec))) 1864 (process-live-p (tramp-get-connection-process vec)))
1864 (with-tramp-connection-property 1865 (with-tramp-connection-property (tramp-get-process vec) "stat-capability"
1865 (tramp-get-connection-process vec) "stat-capability"
1866 (tramp-smb-send-command vec "stat \"/\"")))) 1866 (tramp-smb-send-command vec "stat \"/\""))))
1867 1867
1868 1868
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index b6861ba7882..68e68a242c9 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -373,7 +373,7 @@ the result will be a local, non-Tramp, file name."
373 373
374(defun tramp-sudoedit-remote-acl-p (vec) 374(defun tramp-sudoedit-remote-acl-p (vec)
375 "Check, whether ACL is enabled on the remote host." 375 "Check, whether ACL is enabled on the remote host."
376 (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p" 376 (with-tramp-connection-property (tramp-get-process vec) "acl-p"
377 (zerop (tramp-call-process vec "getfacl" nil nil nil "/")))) 377 (zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
378 378
379(defun tramp-sudoedit-handle-file-acl (filename) 379(defun tramp-sudoedit-handle-file-acl (filename)
@@ -478,7 +478,7 @@ the result will be a local, non-Tramp, file name."
478 478
479(defun tramp-sudoedit-remote-selinux-p (vec) 479(defun tramp-sudoedit-remote-selinux-p (vec)
480 "Check, whether SELINUX is enabled on the remote host." 480 "Check, whether SELINUX is enabled on the remote host."
481 (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p" 481 (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
482 (zerop (tramp-call-process vec "selinuxenabled")))) 482 (zerop (tramp-call-process vec "selinuxenabled"))))
483 483
484(defun tramp-sudoedit-handle-file-selinux-context (filename) 484(defun tramp-sudoedit-handle-file-selinux-context (filename)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3ce2225cb84..e30f27fd338 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -37,7 +37,7 @@
37;; For more detailed instructions, please see the info file. 37;; For more detailed instructions, please see the info file.
38;; 38;;
39;; Notes: 39;; Notes:
40;; ----- 40;; ------
41;; 41;;
42;; Also see the todo list at the bottom of this file. 42;; Also see the todo list at the bottom of this file.
43;; 43;;
@@ -46,6 +46,7 @@
46;; 46;;
47;; There's a mailing list for this, as well. Its name is: 47;; There's a mailing list for this, as well. Its name is:
48;; tramp-devel@gnu.org 48;; tramp-devel@gnu.org
49
49;; You can use the Web to subscribe, under the following URL: 50;; You can use the Web to subscribe, under the following URL:
50;; https://lists.gnu.org/mailman/listinfo/tramp-devel 51;; https://lists.gnu.org/mailman/listinfo/tramp-devel
51;; 52;;
@@ -1631,6 +1632,15 @@ from the default one."
1631 (or (tramp-get-connection-property vec "process-name" nil) 1632 (or (tramp-get-connection-property vec "process-name" nil)
1632 (tramp-buffer-name vec))) 1633 (tramp-buffer-name vec)))
1633 1634
1635(defun tramp-get-process (vec-or-proc)
1636 "Get the default connection process to be used for VEC-OR-PROC.
1637Return `tramp-cache-undefined' in case it doesn't exist."
1638 (or (and (tramp-file-name-p vec-or-proc)
1639 (get-buffer-process (tramp-buffer-name vec-or-proc)))
1640 (and (processp vec-or-proc)
1641 (tramp-get-process (process-get vec-or-proc 'vector)))
1642 tramp-cache-undefined))
1643
1634(defun tramp-get-connection-process (vec) 1644(defun tramp-get-connection-process (vec)
1635 "Get the connection process to be used for VEC. 1645 "Get the connection process to be used for VEC.
1636In case a second asynchronous communication has been started, it is different 1646In case a second asynchronous communication has been started, it is different
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 455f181f501..e5878b28f96 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -646,6 +646,16 @@ matched file names, and weeding out false positives."
646 :link `(file-link :tag "example file" 646 :link `(file-link :tag "example file"
647 ,(expand-file-name "compilation.txt" data-directory))) 647 ,(expand-file-name "compilation.txt" data-directory)))
648 648
649(defvar compilation-error-case-fold-search nil
650 "If non-nil, use case-insensitive matching of compilation errors
651by the regexps of `compilation-error-regexp-alist' and
652`compilation-error-regexp-alist-alist'.
653If nil, matching is case-sensitive.
654
655This variable should only be set for backward compatibility as a temporary
656measure. The proper solution is to use a regexp that matches the
657messages without case-folding.")
658
649;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp) 659;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
650(defvar compilation-directory nil 660(defvar compilation-directory nil
651 "Directory to restore to when doing `recompile'.") 661 "Directory to restore to when doing `recompile'.")
@@ -1435,7 +1445,8 @@ to `compilation-error-regexp-alist' if RULES is nil."
1435 (if (symbolp item) 1445 (if (symbolp item)
1436 (setq item (cdr (assq item 1446 (setq item (cdr (assq item
1437 compilation-error-regexp-alist-alist)))) 1447 compilation-error-regexp-alist-alist))))
1438 (let ((file (nth 1 item)) 1448 (let ((case-fold-search compilation-error-case-fold-search)
1449 (file (nth 1 item))
1439 (line (nth 2 item)) 1450 (line (nth 2 item))
1440 (col (nth 3 item)) 1451 (col (nth 3 item))
1441 (type (nth 4 item)) 1452 (type (nth 4 item))
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index bb780259333..1c9e805f039 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -34,6 +34,7 @@
34;;; Code: 34;;; Code:
35 35
36(require 'cl-lib) 36(require 'cl-lib)
37(require 'seq)
37(require 'easymenu) 38(require 'easymenu)
38(require 'view) 39(require 'view)
39(require 'ebuff-menu) 40(require 'ebuff-menu)
@@ -52,32 +53,27 @@
52 "List of directories to search for source files in a class tree. 53 "List of directories to search for source files in a class tree.
53Elements should be directory names; nil as an element means to try 54Elements should be directory names; nil as an element means to try
54to find source files relative to the location of the BROWSE file loaded." 55to find source files relative to the location of the BROWSE file loaded."
55 :group 'ebrowse
56 :type '(repeat (choice (const :tag "Default" nil) 56 :type '(repeat (choice (const :tag "Default" nil)
57 (string :tag "Directory")))) 57 (string :tag "Directory"))))
58 58
59 59
60(defcustom ebrowse-view/find-hook nil 60(defcustom ebrowse-view/find-hook nil
61 "Hooks run after finding or viewing a member or class." 61 "Hooks run after finding or viewing a member or class."
62 :group 'ebrowse
63 :type 'hook) 62 :type 'hook)
64 63
65 64
66(defcustom ebrowse-not-found-hook nil 65(defcustom ebrowse-not-found-hook nil
67 "Hooks run when finding or viewing a member or class was not successful." 66 "Hooks run when finding or viewing a member or class was not successful."
68 :group 'ebrowse
69 :type 'hook) 67 :type 'hook)
70 68
71 69
72(defcustom ebrowse-electric-list-mode-hook nil 70(defcustom ebrowse-electric-list-mode-hook nil
73 "Hook called by `ebrowse-electric-position-mode'." 71 "Hook called by `ebrowse-electric-position-mode'."
74 :group 'ebrowse
75 :type 'hook) 72 :type 'hook)
76 73
77 74
78(defcustom ebrowse-max-positions 50 75(defcustom ebrowse-max-positions 50
79 "Number of markers saved on electric position stack." 76 "Number of markers saved on electric position stack."
80 :group 'ebrowse
81 :type 'integer) 77 :type 'integer)
82 78
83 79
@@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded."
89 85
90(defcustom ebrowse-tree-mode-hook nil 86(defcustom ebrowse-tree-mode-hook nil
91 "Hook run in each new tree buffer." 87 "Hook run in each new tree buffer."
92 :group 'ebrowse-tree
93 :type 'hook) 88 :type 'hook)
94 89
95 90
96(defcustom ebrowse-tree-buffer-name "*Tree*" 91(defcustom ebrowse-tree-buffer-name "*Tree*"
97 "The default name of class tree buffers." 92 "The default name of class tree buffers."
98 :group 'ebrowse-tree
99 :type 'string) 93 :type 'string)
100 94
101 95
102(defcustom ebrowse--indentation 4 96(defcustom ebrowse--indentation 4
103 "The amount by which subclasses are indented in the tree." 97 "The amount by which subclasses are indented in the tree."
104 :group 'ebrowse-tree
105 :type 'integer) 98 :type 'integer)
106 99
107 100
108(defcustom ebrowse-source-file-column 40 101(defcustom ebrowse-source-file-column 40
109 "The column in which source file names are displayed in the tree." 102 "The column in which source file names are displayed in the tree."
110 :group 'ebrowse-tree
111 :type 'integer) 103 :type 'integer)
112 104
113 105
114(defcustom ebrowse-tree-left-margin 2 106(defcustom ebrowse-tree-left-margin 2
115 "Amount of space left at the left side of the tree display. 107 "Amount of space left at the left side of the tree display.
116This space is used to display markers." 108This space is used to display markers."
117 :group 'ebrowse-tree
118 :type 'integer) 109 :type 'integer)
119 110
120 111
@@ -126,25 +117,21 @@ This space is used to display markers."
126 117
127(defcustom ebrowse-default-declaration-column 25 118(defcustom ebrowse-default-declaration-column 25
128 "The column in which member declarations are displayed in member buffers." 119 "The column in which member declarations are displayed in member buffers."
129 :group 'ebrowse-member
130 :type 'integer) 120 :type 'integer)
131 121
132 122
133(defcustom ebrowse-default-column-width 25 123(defcustom ebrowse-default-column-width 25
134 "The width of the columns in member buffers (short display form)." 124 "The width of the columns in member buffers (short display form)."
135 :group 'ebrowse-member
136 :type 'integer) 125 :type 'integer)
137 126
138 127
139(defcustom ebrowse-member-buffer-name "*Members*" 128(defcustom ebrowse-member-buffer-name "*Members*"
140 "The name of the buffer for member display." 129 "The name of the buffer for member display."
141 :group 'ebrowse-member
142 :type 'string) 130 :type 'string)
143 131
144 132
145(defcustom ebrowse-member-mode-hook nil 133(defcustom ebrowse-member-mode-hook nil
146 "Run in each new member buffer." 134 "Run in each new member buffer."
147 :group 'ebrowse-member
148 :type 'hook) 135 :type 'hook)
149 136
150 137
@@ -156,81 +143,47 @@ This space is used to display markers."
156(defface ebrowse-tree-mark 143(defface ebrowse-tree-mark
157 '((((min-colors 88)) :foreground "red1") 144 '((((min-colors 88)) :foreground "red1")
158 (t :foreground "red")) 145 (t :foreground "red"))
159 "Face for the mark character in the Ebrowse tree." 146 "Face for the mark character in the Ebrowse tree.")
160 :group 'ebrowse-faces)
161 147
162(defface ebrowse-root-class 148(defface ebrowse-root-class
163 '((((min-colors 88)) :weight bold :foreground "blue1") 149 '((((min-colors 88)) :weight bold :foreground "blue1")
164 (t :weight bold :foreground "blue")) 150 (t :weight bold :foreground "blue"))
165 "Face for root classes in the Ebrowse tree." 151 "Face for root classes in the Ebrowse tree.")
166 :group 'ebrowse-faces)
167 152
168(defface ebrowse-file-name '((t :slant italic)) 153(defface ebrowse-file-name '((t :slant italic))
169 "Face for filenames in the Ebrowse tree." 154 "Face for filenames in the Ebrowse tree.")
170 :group 'ebrowse-faces)
171 155
172(defface ebrowse-default '((t)) 156(defface ebrowse-default '((t))
173 "Face for items in the Ebrowse tree which do not have other faces." 157 "Face for items in the Ebrowse tree which do not have other faces.")
174 :group 'ebrowse-faces)
175 158
176(defface ebrowse-member-attribute 159(defface ebrowse-member-attribute
177 '((((min-colors 88)) :foreground "red1") 160 '((((min-colors 88)) :foreground "red1")
178 (t :foreground "red")) 161 (t :foreground "red"))
179 "Face for member attributes." 162 "Face for member attributes.")
180 :group 'ebrowse-faces)
181 163
182(defface ebrowse-member-class 164(defface ebrowse-member-class
183 '((t :foreground "purple")) 165 '((t :foreground "purple"))
184 "Face used to display the class title in member buffers." 166 "Face used to display the class title in member buffers.")
185 :group 'ebrowse-faces)
186 167
187(defface ebrowse-progress 168(defface ebrowse-progress
188 '((((min-colors 88)) :background "blue1") 169 '((((min-colors 88)) :background "blue1")
189 (t :background "blue")) 170 (t :background "blue"))
190 "Face for progress indicator." 171 "Face for progress indicator.")
191 :group 'ebrowse-faces)
192 172
193 173
194;;; Utilities. 174;;; Utilities.
195 175
196(defun ebrowse-some (predicate vector) 176(define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1")
197 "Return true if PREDICATE is true of some element of VECTOR.
198If so, return the value returned by PREDICATE."
199 (let ((length (length vector))
200 (i 0)
201 result)
202 (while (and (< i length) (not result))
203 (setq result (funcall predicate (aref vector i))
204 i (1+ i)))
205 result))
206 177
207 178
208(defun ebrowse-every (predicate vector) 179(define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1")
209 "Return true if PREDICATE is true of every element of VECTOR."
210 (let ((length (length vector))
211 (i 0)
212 (result t))
213 (while (and (< i length) result)
214 (setq result (funcall predicate (aref vector i))
215 i (1+ i)))
216 result))
217 180
218 181
219(defun ebrowse-position (item list &optional test) 182(defun ebrowse-position (item list &optional test)
220 "Return the position of ITEM in LIST or nil if not found. 183 "Return the position of ITEM in LIST or nil if not found.
221Compare items with `eq' or TEST if specified." 184Compare items with `eq' or TEST if specified."
222 (let ((i 0) found) 185 (declare (obsolete seq-position "28.1"))
223 (cond (test 186 (seq-position list item (or test #'eql)))
224 (while list
225 (when (funcall test item (car list))
226 (setq found i list nil))
227 (setq list (cdr list) i (1+ i))))
228 (t
229 (while list
230 (when (eq item (car list))
231 (setq found i list nil))
232 (setq list (cdr list) i (1+ i)))))
233 found))
234 187
235 188
236(defmacro ebrowse-ignoring-completion-case (&rest body) 189(defmacro ebrowse-ignoring-completion-case (&rest body)
@@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified."
242(defmacro ebrowse-for-all-trees (spec &rest body) 195(defmacro ebrowse-for-all-trees (spec &rest body)
243 "For all trees in SPEC, eval BODY." 196 "For all trees in SPEC, eval BODY."
244 (declare (indent 1) (debug ((sexp form) body))) 197 (declare (indent 1) (debug ((sexp form) body)))
245 (let ((var (make-symbol "var")) 198 (let ((spec-var (car spec))
246 (spec-var (car spec))
247 (array (cadr spec))) 199 (array (cadr spec)))
248 `(cl-loop for ,var being the symbols of ,array 200 `(maphash (lambda (_k ,spec-var)
249 as ,spec-var = (get ,var 'ebrowse-root) do 201 (when ,spec-var
250 (when (vectorp ,spec-var) 202 (cl-assert (cl-typep ,spec-var 'ebrowse-ts))
251 ,@body)))) 203 ,@body))
252 204 ,array)))
253;;; Set indentation for macros above.
254
255
256 205
257(defsubst ebrowse-set-face (start end face) 206(defsubst ebrowse-set-face (start end face)
258 "Set face of a region START END to FACE." 207 "Set face of a region START END to FACE."
@@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified."
264Case is ignored in completions. 213Case is ignored in completions.
265 214
266PROMPT is a string to prompt with; normally it ends in a colon and a space. 215PROMPT is a string to prompt with; normally it ends in a colon and a space.
267TABLE is an alist whose elements' cars are strings, or an obarray. 216TABLE is a completion table.
268TABLE can also be a function to do the completion itself.
269If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. 217If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
270If it is (STRING . POSITION), the initial input 218If it is (STRING . POSITION), the initial input
271is STRING, but point is placed POSITION characters into the string." 219is STRING, but point is placed POSITION characters into the string."
@@ -304,6 +252,9 @@ otherwise use the current frame's width."
304 252
305;;; Structure definitions 253;;; Structure definitions
306 254
255;; Note: These use `(:type vector) :named' in order to match the
256;; format used in src/BROWSE.
257
307(cl-defstruct (ebrowse-hs (:type vector) :named) 258(cl-defstruct (ebrowse-hs (:type vector) :named)
308 "Header structure found at the head of BROWSE files." 259 "Header structure found at the head of BROWSE files."
309 ;; A version string that is compared against the version number of 260 ;; A version string that is compared against the version number of
@@ -457,19 +408,17 @@ members."
457This must be the same that `ebrowse' uses.") 408This must be the same that `ebrowse' uses.")
458 409
459 410
460(defvar ebrowse--last-regexp nil 411(defvar-local ebrowse--last-regexp nil
461 "Last regular expression searched for in tree and member buffers. 412 "Last regular expression searched for in tree and member buffers.
462Each tree and member buffer maintains its own search history.") 413Each tree and member buffer maintains its own search history.")
463(make-variable-buffer-local 'ebrowse--last-regexp)
464
465 414
466(defconst ebrowse-member-list-accessors 415(defconst ebrowse-member-list-accessors
467 '(ebrowse-ts-member-variables 416 (list #'ebrowse-ts-member-variables
468 ebrowse-ts-member-functions 417 #'ebrowse-ts-member-functions
469 ebrowse-ts-static-variables 418 #'ebrowse-ts-static-variables
470 ebrowse-ts-static-functions 419 #'ebrowse-ts-static-functions
471 ebrowse-ts-friends 420 #'ebrowse-ts-friends
472 ebrowse-ts-types) 421 #'ebrowse-ts-types)
473 "List of accessors for member lists. 422 "List of accessors for member lists.
474Each element is the symbol of an accessor function. 423Each element is the symbol of an accessor function.
475The nth element must be the accessor for the nth member list 424The nth element must be the accessor for the nth member list
@@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.")
478 427
479;;; FIXME: Add more doc strings for the buffer-local variables below. 428;;; FIXME: Add more doc strings for the buffer-local variables below.
480 429
481(defvar ebrowse--tree-obarray nil 430(defvar ebrowse--tree-table nil
482 "Obarray holding all `ebrowse-ts' structures of a class tree. 431 "Hash-table holding all `ebrowse-ts' structures of a class tree.
483Buffer-local in Ebrowse buffers.") 432Buffer-local in Ebrowse buffers.")
484 433
485 434
@@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.")
637;;; Operations on `ebrowse-ts' structures 586;;; Operations on `ebrowse-ts' structures
638 587
639(defun ebrowse-files-table (&optional marked-only) 588(defun ebrowse-files-table (&optional marked-only)
640 "Return an obarray containing all files mentioned in the current tree. 589 "Return a hash table containing all files mentioned in the current tree.
641The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. 590The tree is expected in the buffer-local variable `ebrowse--tree-table'.
642MARKED-ONLY non-nil means include marked classes only." 591MARKED-ONLY non-nil means include marked classes only."
643 (let ((files (make-hash-table :test 'equal)) 592 (let ((files (make-hash-table :test 'equal))
644 (i -1)) 593 (i -1))
645 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 594 (ebrowse-for-all-trees (tree ebrowse--tree-table)
646 (when (or (not marked-only) (ebrowse-ts-mark tree)) 595 (when (or (not marked-only) (ebrowse-ts-mark tree))
647 (let ((class (ebrowse-ts-class tree))) 596 (let ((class (ebrowse-ts-class tree)))
648 (when (zerop (% (cl-incf i) 20)) 597 (when (zerop (% (cl-incf i) 20))
@@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only."
677 626
678(cl-defun ebrowse-marked-classes-p () 627(cl-defun ebrowse-marked-classes-p ()
679 "Value is non-nil if any class in the current class tree is marked." 628 "Value is non-nil if any class in the current class tree is marked."
680 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 629 (ebrowse-for-all-trees (tree ebrowse--tree-table)
681 (when (ebrowse-ts-mark tree) 630 (when (ebrowse-ts-mark tree)
682 (cl-return-from ebrowse-marked-classes-p tree)))) 631 (cl-return-from ebrowse-marked-classes-p tree))))
683 632
@@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only."
695 (ebrowse-cs-name class))) 644 (ebrowse-cs-name class)))
696 645
697 646
698(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) 647(defun ebrowse-tree-table-as-alist (&optional qualified-names-p)
699 "Return an alist describing all classes in a tree. 648 "Return an alist describing all classes in a tree.
700Each elements in the list has the form (CLASS-NAME . TREE). 649Each elements in the list has the form (CLASS-NAME . TREE).
701CLASS-NAME is the name of the class. TREE is the 650CLASS-NAME is the name of the class. TREE is the
702class tree whose root is QUALIFIED-CLASS-NAME. 651class tree whose root is QUALIFIED-CLASS-NAME.
703QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. 652QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
704The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." 653The class tree is found in the buffer-local variable `ebrowse--tree-table'."
705 (let (alist) 654 (let (alist)
706 (if qualified-names-p 655 (if qualified-names-p
707 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 656 (ebrowse-for-all-trees (tree ebrowse--tree-table)
708 (setq alist 657 (setq alist
709 (cl-acons (ebrowse-qualified-class-name 658 (cl-acons (ebrowse-qualified-class-name
710 (ebrowse-ts-class tree)) 659 (ebrowse-ts-class tree))
711 tree alist))) 660 tree alist)))
712 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 661 (ebrowse-for-all-trees (tree ebrowse--tree-table)
713 (setq alist 662 (setq alist
714 (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) 663 (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
715 tree alist)))) 664 tree alist))))
@@ -751,7 +700,7 @@ computes this information lazily."
751 with result = nil 700 with result = nil
752 as search = (pop to-search) 701 as search = (pop to-search)
753 while search finally return result 702 while search finally return result
754 do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) 703 do (ebrowse-for-all-trees (ti ebrowse--tree-table)
755 (when (memq search (ebrowse-ts-subclasses ti)) 704 (when (memq search (ebrowse-ts-subclasses ti))
756 (unless (memq ti result) 705 (unless (memq ti result)
757 (setq result (nconc result (list ti)))) 706 (setq result (nconc result (list ti))))
@@ -875,7 +824,7 @@ NOCONFIRM."
875 "Create a new tree buffer for tree TREE. 824 "Create a new tree buffer for tree TREE.
876The tree was loaded from file TAGS-FILE. 825The tree was loaded from file TAGS-FILE.
877HEADER is the header structure of the file. 826HEADER is the header structure of the file.
878CLASSES is an obarray with a symbol for each class in the tree. 827CLASSES is a hash-table with an entry for each class in the tree.
879POP non-nil means popup the buffer up at the end. 828POP non-nil means popup the buffer up at the end.
880Return the buffer created." 829Return the buffer created."
881 (let ((name ebrowse-tree-buffer-name)) 830 (let ((name ebrowse-tree-buffer-name))
@@ -883,7 +832,7 @@ Return the buffer created."
883 (ebrowse-tree-mode) 832 (ebrowse-tree-mode)
884 (setq ebrowse--tree tree 833 (setq ebrowse--tree tree
885 ebrowse--tags-file-name tags-file 834 ebrowse--tags-file-name tags-file
886 ebrowse--tree-obarray classes 835 ebrowse--tree-table classes
887 ebrowse--header header 836 ebrowse--header header
888 ebrowse--frozen-flag nil) 837 ebrowse--frozen-flag nil)
889 (ebrowse-redraw-tree) 838 (ebrowse-redraw-tree)
@@ -895,13 +844,13 @@ Return the buffer created."
895 844
896 845
897 846
898;;; Operations for member obarrays 847;;; Operations for member tables
899 848
900(defun ebrowse-fill-member-table () 849(defun ebrowse-fill-member-table ()
901 "Return an obarray holding all members of all classes in the current tree. 850 "Return a hash table holding all members of all classes in the current tree.
902 851
903For each member, a symbol is added to the obarray. Members are 852For each member, a symbol is added to the table. Members are
904extracted from the buffer-local tree `ebrowse--tree-obarray'. 853extracted from the buffer-local tree `ebrowse--tree-table'.
905 854
906Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST 855Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
907MEMBER) where TREE is the tree in which the member is defined, 856MEMBER) where TREE is the tree in which the member is defined,
@@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member
909is found, and MEMBER is a MEMBER structure describing the member. 858is found, and MEMBER is a MEMBER structure describing the member.
910 859
911The slot `member-table' of the buffer-local header structure of 860The slot `member-table' of the buffer-local header structure of
912type `ebrowse-hs' is set to the resulting obarray." 861type `ebrowse-hs' is set to the resulting table."
913 (let ((members (make-hash-table :test 'equal)) 862 (let ((members (make-hash-table :test 'equal))
914 (i -1)) 863 (i -1))
915 (setf (ebrowse-hs-member-table ebrowse--header) nil) 864 (setf (ebrowse-hs-member-table ebrowse--header) nil)
916 (garbage-collect) 865 (garbage-collect)
917 ;; For all classes... 866 ;; For all classes...
918 (ebrowse-for-all-trees (c ebrowse--tree-obarray) 867 (ebrowse-for-all-trees (c ebrowse--tree-table)
919 (when (zerop (% (cl-incf i) 10)) 868 (when (zerop (% (cl-incf i) 10))
920 (ebrowse-show-progress "Preparing member lookup" (zerop i))) 869 (ebrowse-show-progress "Preparing member lookup" (zerop i)))
921 (dolist (f ebrowse-member-list-accessors) 870 (dolist (f ebrowse-member-list-accessors)
922 (dolist (m (funcall f c)) 871 (dolist (m (funcall f c))
923 (let* ((member-name (ebrowse-ms-name m)) 872 (push (list c f m) (gethash (ebrowse-ms-name m) members)))))
924 (value (gethash member-name members)))
925 (push (list c f m) value)
926 (puthash member-name value members)))))
927 (setf (ebrowse-hs-member-table ebrowse--header) members))) 873 (setf (ebrowse-hs-member-table ebrowse--header) members)))
928 874
929 875
930(defun ebrowse-member-table (header) 876(defun ebrowse-member-table (header)
931 "Return the member obarray. Build it if it hasn't been set up yet. 877 "Return the member table. Build it if it hasn't been set up yet.
932HEADER is the tree header structure of the class tree." 878HEADER is the tree header structure of the class tree."
933 (when (null (ebrowse-hs-member-table header)) 879 (when (null (ebrowse-hs-member-table header))
934 (cl-loop for buffer in (ebrowse-browser-buffer-list) 880 (cl-loop for buffer in (ebrowse-browser-buffer-list)
@@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree."
940 886
941 887
942 888
943;;; Operations on TREE obarrays 889;;; Operations on TREE tables
944 890
945(defun ebrowse-build-tree-obarray (tree) 891(defun ebrowse-build-tree-table (tree)
946 "Make sure every class in TREE is represented by a unique object. 892 "Make sure every class in TREE is represented by a unique object.
947Build obarray of all classes in TREE." 893Build hash table of all classes in TREE."
948 (let ((classes (make-vector 127 0))) 894 (let ((classes (make-hash-table :test #'equal)))
949 ;; Add root classes... 895 ;; Add root classes...
950 (cl-loop for root in tree 896 (cl-loop for root in tree
951 as sym = 897 do (let ((name (ebrowse-qualified-class-name
952 (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) 898 (ebrowse-ts-class root))))
953 classes) 899 (unless (gethash name classes)
954 do (unless (get sym 'ebrowse-root) 900 (setf (gethash name classes) root))))
955 (setf (get sym 'ebrowse-root) root)))
956 ;; Process subclasses 901 ;; Process subclasses
957 (ebrowse-insert-supers tree classes) 902 (ebrowse-insert-supers tree classes)
958 classes)) 903 classes))
@@ -962,7 +907,7 @@ Build obarray of all classes in TREE."
962 "Build base class lists in class tree TREE. 907 "Build base class lists in class tree TREE.
963CLASSES is an obarray used to collect classes. 908CLASSES is an obarray used to collect classes.
964 909
965Helper function for `ebrowse-build-tree-obarray'. Base classes should 910Helper function for `ebrowse-build-tree-table'. Base classes should
966be ordered so that immediate base classes come first, then the base 911be ordered so that immediate base classes come first, then the base
967class of the immediate base class and so on. This means that we must 912class of the immediate base class and so on. This means that we must
968construct the base-class list top down with adding each level at the 913construct the base-class list top down with adding each level at the
@@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph."
974 as subclasses = (ebrowse-ts-subclasses class) do 919 as subclasses = (ebrowse-ts-subclasses class) do
975 ;; Make sure every class is represented by a unique object 920 ;; Make sure every class is represented by a unique object
976 (cl-loop for subclass on subclasses 921 (cl-loop for subclass on subclasses
977 as sym = (intern
978 (ebrowse-qualified-class-name
979 (ebrowse-ts-class (car subclass)))
980 classes)
981 do 922 do
982 ;; Replace the subclass tree with the one found in 923 (let ((name (ebrowse-qualified-class-name
983 ;; CLASSES if there is already an entry for that class 924 (ebrowse-ts-class (car subclass)))))
984 ;; in it. Otherwise make a new entry. 925 ;; Replace the subclass tree with the one found in
985 ;; 926 ;; CLASSES if there is already an entry for that class
986 ;; CAVEAT: If by some means (e.g., use of the 927 ;; in it. Otherwise make a new entry.
987 ;; preprocessor in class declarations, a name is marked 928 ;;
988 ;; as a subclass of itself on some path, we would end up 929 ;; CAVEAT: If by some means (e.g., use of the
989 ;; in an endless loop. We have to omit subclasses from 930 ;; preprocessor in class declarations, a name is marked
990 ;; the recursion that already have been processed. 931 ;; as a subclass of itself on some path, we would end up
991 (if (get sym 'ebrowse-root) 932 ;; in an endless loop. We have to omit subclasses from
992 (setf (car subclass) (get sym 'ebrowse-root)) 933 ;; the recursion that already have been processed.
993 (setf (get sym 'ebrowse-root) (car subclass)))) 934 (if (gethash name classes)
935 (setf (car subclass) (gethash name classes))
936 (setf (gethash name classes) (car subclass)))))
994 ;; Process subclasses 937 ;; Process subclasses
995 (ebrowse-insert-supers subclasses classes))) 938 (ebrowse-insert-supers subclasses classes)))
996 939
@@ -1072,20 +1015,17 @@ Tree mode key bindings:
1072 (erase-buffer) 1015 (erase-buffer)
1073 (message nil)) 1016 (message nil))
1074 1017
1075 (set (make-local-variable 'ebrowse--show-file-names-flag) nil) 1018 (setq-local ebrowse--show-file-names-flag nil)
1076 (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0)) 1019 (setq-local ebrowse--frozen-flag nil)
1077 (set (make-local-variable 'ebrowse--frozen-flag) nil)
1078 (setq mode-line-buffer-identification ident) 1020 (setq mode-line-buffer-identification ident)
1079 (setq buffer-read-only t) 1021 (setq buffer-read-only t)
1080 (add-to-invisibility-spec '(ebrowse . t)) 1022 (add-to-invisibility-spec '(ebrowse . t))
1081 (set (make-local-variable 'revert-buffer-function) 1023 (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file)
1082 #'ebrowse-revert-tree-buffer-from-file) 1024 (setq-local ebrowse--header header)
1083 (set (make-local-variable 'ebrowse--header) header) 1025 (setq-local ebrowse--tree tree)
1084 (set (make-local-variable 'ebrowse--tree) tree) 1026 (setq-local ebrowse--tags-file-name buffer-file-name)
1085 (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name) 1027 (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree)))
1086 (set (make-local-variable 'ebrowse--tree-obarray) 1028 (setq-local ebrowse--frozen-flag nil)
1087 (and tree (ebrowse-build-tree-obarray tree)))
1088 (set (make-local-variable 'ebrowse--frozen-flag) nil)
1089 1029
1090 (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t) 1030 (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t)
1091 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) 1031 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
@@ -1110,18 +1050,18 @@ Tree mode key bindings:
1110(defun ebrowse-remove-class-and-kill-member-buffers (tree class) 1050(defun ebrowse-remove-class-and-kill-member-buffers (tree class)
1111 "Remove from TREE class CLASS. 1051 "Remove from TREE class CLASS.
1112Kill all member buffers still containing a reference to the class." 1052Kill all member buffers still containing a reference to the class."
1113 (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) 1053 (setf tree (delq class tree)
1114 ebrowse--tree-obarray))) 1054 (gethash (ebrowse-cs-name (ebrowse-ts-class class))
1115 (setf tree (delq class tree) 1055 ebrowse--tree-table)
1116 (get sym 'ebrowse-root) nil) 1056 nil)
1117 (dolist (root tree) 1057 (dolist (root tree)
1118 (setf (ebrowse-ts-subclasses root) 1058 (setf (ebrowse-ts-subclasses root)
1119 (delq class (ebrowse-ts-subclasses root)) 1059 (delq class (ebrowse-ts-subclasses root))
1120 (ebrowse-ts-base-classes root) nil) 1060 (ebrowse-ts-base-classes root) nil)
1121 (ebrowse-remove-class-and-kill-member-buffers 1061 (ebrowse-remove-class-and-kill-member-buffers
1122 (ebrowse-ts-subclasses root) class)) 1062 (ebrowse-ts-subclasses root) class))
1123 (ebrowse-kill-member-buffers-displaying class) 1063 (ebrowse-kill-member-buffers-displaying class)
1124 tree)) 1064 tree)
1125 1065
1126 1066
1127(defun ebrowse-remove-class-at-point (forced) 1067(defun ebrowse-remove-class-at-point (forced)
@@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes."
1184(defun ebrowse-mark-all-classes (prefix) 1124(defun ebrowse-mark-all-classes (prefix)
1185 "Unmark, with PREFIX mark, all classes in the tree." 1125 "Unmark, with PREFIX mark, all classes in the tree."
1186 (interactive "P") 1126 (interactive "P")
1187 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 1127 (ebrowse-for-all-trees (tree ebrowse--tree-table)
1188 (setf (ebrowse-ts-mark tree) prefix)) 1128 (setf (ebrowse-ts-mark tree) prefix))
1189 (ebrowse-redraw-marks (point-min) (point-max))) 1129 (ebrowse-redraw-marks (point-min) (point-max)))
1190 1130
@@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames."
1277 1217
1278(defun ebrowse-browser-buffer-list () 1218(defun ebrowse-browser-buffer-list ()
1279 "Return a list of all tree or member buffers." 1219 "Return a list of all tree or member buffers."
1280 (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) 1220 (cl-delete-if-not #'ebrowse-buffer-p (buffer-list)))
1281 1221
1282 1222
1283(defun ebrowse-member-buffer-list () 1223(defun ebrowse-member-buffer-list ()
1284 "Return a list of all member buffers." 1224 "Return a list of all member buffers."
1285 (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) 1225 (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list)))
1286 1226
1287 1227
1288(defun ebrowse-tree-buffer-list () 1228(defun ebrowse-tree-buffer-list ()
1289 "Return a list of all tree buffers." 1229 "Return a list of all tree buffers."
1290 (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) 1230 (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list)))
1291 1231
1292 1232
1293(defun ebrowse-known-class-trees-buffer-list () 1233(defun ebrowse-known-class-trees-buffer-list ()
@@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
1396 "): ") 1336 "): ")
1397 nil nil ebrowse--indentation)))) 1337 nil nil ebrowse--indentation))))
1398 (when (cl-plusp width) 1338 (when (cl-plusp width)
1399 (set (make-local-variable 'ebrowse--indentation) width) 1339 (setq-local ebrowse--indentation width)
1400 (ebrowse-redraw-tree)))) 1340 (ebrowse-redraw-tree))))
1401 1341
1402 1342
@@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil."
1409 (unless class 1349 (unless class
1410 (setf class 1350 (setf class
1411 (completing-read "Goto class: " 1351 (completing-read "Goto class: "
1412 (ebrowse-tree-obarray-as-alist) nil t))) 1352 (ebrowse-tree-table-as-alist) nil t)))
1413 (goto-char (point-min)) 1353 (goto-char (point-min))
1414 (widen) 1354 (widen)
1415 (setq ebrowse--last-regexp (concat "\\b" class "\\b")) 1355 (setq ebrowse--last-regexp (concat "\\b" class "\\b"))
@@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil."
1426(defun ebrowse-tree-command:show-member-variables (arg) 1366(defun ebrowse-tree-command:show-member-variables (arg)
1427 "Display member variables; with prefix ARG in frozen member buffer." 1367 "Display member variables; with prefix ARG in frozen member buffer."
1428 (interactive "P") 1368 (interactive "P")
1429 (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) 1369 (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg))
1430 1370
1431 1371
1432(defun ebrowse-tree-command:show-member-functions (&optional arg) 1372(defun ebrowse-tree-command:show-member-functions (&optional arg)
1433 "Display member functions; with prefix ARG in frozen member buffer." 1373 "Display member functions; with prefix ARG in frozen member buffer."
1434 (interactive "P") 1374 (interactive "P")
1435 (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) 1375 (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg))
1436 1376
1437 1377
1438(defun ebrowse-tree-command:show-static-member-variables (arg) 1378(defun ebrowse-tree-command:show-static-member-variables (arg)
1439 "Display static member variables; with prefix ARG in frozen member buffer." 1379 "Display static member variables; with prefix ARG in frozen member buffer."
1440 (interactive "P") 1380 (interactive "P")
1441 (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) 1381 (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg))
1442 1382
1443 1383
1444(defun ebrowse-tree-command:show-static-member-functions (arg) 1384(defun ebrowse-tree-command:show-static-member-functions (arg)
1445 "Display static member functions; with prefix ARG in frozen member buffer." 1385 "Display static member functions; with prefix ARG in frozen member buffer."
1446 (interactive "P") 1386 (interactive "P")
1447 (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) 1387 (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg))
1448 1388
1449 1389
1450(defun ebrowse-tree-command:show-friends (arg) 1390(defun ebrowse-tree-command:show-friends (arg)
1451 "Display friend functions; with prefix ARG in frozen member buffer." 1391 "Display friend functions; with prefix ARG in frozen member buffer."
1452 (interactive "P") 1392 (interactive "P")
1453 (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) 1393 (ebrowse-display-member-buffer #'ebrowse-ts-friends arg))
1454 1394
1455 1395
1456(defun ebrowse-tree-command:show-types (arg) 1396(defun ebrowse-tree-command:show-types (arg)
1457 "Display types defined in a class; with prefix ARG in frozen member buffer." 1397 "Display types defined in a class; with prefix ARG in frozen member buffer."
1458 (interactive "P") 1398 (interactive "P")
1459 (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) 1399 (ebrowse-display-member-buffer #'ebrowse-ts-types arg))
1460 1400
1461 1401
1462 1402
@@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame."
1562 (had-a-buf (get-file-buffer file)) 1502 (had-a-buf (get-file-buffer file))
1563 (buf-to-view (find-file-noselect file))) 1503 (buf-to-view (find-file-noselect file)))
1564 (switch-to-buffer-other-frame buf-to-view) 1504 (switch-to-buffer-other-frame buf-to-view)
1565 (set (make-local-variable 'ebrowse--frame-configuration) 1505 (setq-local ebrowse--frame-configuration
1566 old-frame-configuration) 1506 old-frame-configuration)
1567 (set (make-local-variable 'ebrowse--view-exit-action) 1507 (setq-local ebrowse--view-exit-action
1568 (and (not had-a-buf) 1508 (and (not had-a-buf)
1569 (not (buffer-modified-p buf-to-view)) 1509 (not (buffer-modified-p buf-to-view))
1570 'kill-buffer)) 1510 #'kill-buffer))
1571 (view-mode-enter (cons (selected-window) (cons (selected-window) t)) 1511 (view-mode-enter (cons (selected-window) (cons (selected-window) t))
1572 'ebrowse-view-exit-fn))) 1512 'ebrowse-view-exit-fn)))
1573 1513
@@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch."
1934 (when (memq 'mode-name mode-line-format) 1874 (when (memq 'mode-name mode-line-format)
1935 (setq mode-line-format (copy-sequence mode-line-format)) 1875 (setq mode-line-format (copy-sequence mode-line-format))
1936 (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) 1876 (setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
1937 (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") 1877 (setq-local Helper-return-blurb "return to buffer editing")
1938 (setq truncate-lines t 1878 (setq truncate-lines t
1939 buffer-read-only t)) 1879 buffer-read-only t))
1940 1880
@@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION."
2145(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" 2085(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members"
2146 "Major mode for Ebrowse member buffers." 2086 "Major mode for Ebrowse member buffers."
2147 (mapc #'make-local-variable 2087 (mapc #'make-local-variable
2148 '(ebrowse--decl-column ;display column 2088 '(ebrowse--n-columns ;number of short columns
2149 ebrowse--n-columns ;number of short columns
2150 ebrowse--column-width ;width of columns above
2151 ebrowse--show-inherited-flag ;include inherited members?
2152 ebrowse--filters ;public, protected, private
2153 ebrowse--accessor ;vars, functions, friends 2089 ebrowse--accessor ;vars, functions, friends
2154 ebrowse--displayed-class ;class displayed 2090 ebrowse--displayed-class ;class displayed
2155 ebrowse--long-display-flag ;display with regexps?
2156 ebrowse--source-regexp-flag ;show source regexp?
2157 ebrowse--attributes-flag ;show `virtual' and `inline'
2158 ebrowse--member-list ;list of members displayed 2091 ebrowse--member-list ;list of members displayed
2159 ebrowse--tree ;the class tree 2092 ebrowse--tree ;the class tree
2160 ebrowse--member-mode-strings ;part of mode line 2093 ebrowse--member-mode-strings ;part of mode line
2161 ebrowse--tags-file-name ; 2094 ebrowse--tags-file-name ;
2162 ebrowse--header 2095 ebrowse--header
2163 ebrowse--tree-obarray 2096 ebrowse--tree-table
2164 ebrowse--virtual-display-flag
2165 ebrowse--inline-display-flag
2166 ebrowse--const-display-flag
2167 ebrowse--pure-display-flag
2168 ebrowse--frozen-flag)) ;buffer not automagically reused 2097 ebrowse--frozen-flag)) ;buffer not automagically reused
2169 (setq mode-line-buffer-identification 2098 (setq-local
2170 (propertized-buffer-identification "C++ Members") 2099 mode-line-buffer-identification
2171 buffer-read-only t 2100 (propertized-buffer-identification "C++ Members")
2172 ebrowse--long-display-flag nil 2101 buffer-read-only t
2173 ebrowse--attributes-flag t 2102 ebrowse--long-display-flag nil ;display with regexps?
2174 ebrowse--show-inherited-flag t 2103 ebrowse--attributes-flag t ;show `virtual' and `inline'
2175 ebrowse--source-regexp-flag nil 2104 ebrowse--show-inherited-flag t ;include inherited members?
2176 ebrowse--filters [0 1 2] 2105 ebrowse--source-regexp-flag nil ;show source regexp?
2177 ebrowse--decl-column ebrowse-default-declaration-column 2106 ebrowse--filters [0 1 2] ;public, protected, private
2178 ebrowse--column-width ebrowse-default-column-width 2107 ebrowse--decl-column ebrowse-default-declaration-column ;display column
2179 ebrowse--virtual-display-flag nil 2108 ebrowse--column-width ebrowse-default-column-width ;width of columns above
2180 ebrowse--inline-display-flag nil 2109 ebrowse--virtual-display-flag nil
2181 ebrowse--const-display-flag nil 2110 ebrowse--inline-display-flag nil
2182 ebrowse--pure-display-flag nil) 2111 ebrowse--const-display-flag nil
2112 ebrowse--pure-display-flag nil)
2183 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) 2113 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))))
2184 2114
2185 2115
@@ -2257,10 +2187,10 @@ make one."
2257 (ebrowse-create-tree-buffer ebrowse--tree 2187 (ebrowse-create-tree-buffer ebrowse--tree
2258 ebrowse--tags-file-name 2188 ebrowse--tags-file-name
2259 ebrowse--header 2189 ebrowse--header
2260 ebrowse--tree-obarray 2190 ebrowse--tree-table
2261 'pop)))) 2191 'pop))))
2262 (and buf 2192 (and buf
2263 (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) 2193 (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf))
2264 buf)) 2194 buf))
2265 2195
2266 2196
@@ -2276,8 +2206,9 @@ make one."
2276 2206
2277(defun ebrowse-cyclic-display-next/previous-member-list (incr) 2207(defun ebrowse-cyclic-display-next/previous-member-list (incr)
2278 "Switch buffer to INCR'th next/previous list of members." 2208 "Switch buffer to INCR'th next/previous list of members."
2279 (let ((index (ebrowse-position ebrowse--accessor 2209 (let ((index (seq-position ebrowse-member-list-accessors
2280 ebrowse-member-list-accessors))) 2210 ebrowse--accessor
2211 #'eql)))
2281 (setf ebrowse--accessor 2212 (setf ebrowse--accessor
2282 (cond ((cl-plusp incr) 2213 (cond ((cl-plusp incr)
2283 (or (nth (1+ index) 2214 (or (nth (1+ index)
@@ -2306,37 +2237,37 @@ make one."
2306(defun ebrowse-display-function-member-list () 2237(defun ebrowse-display-function-member-list ()
2307 "Display the list of member functions." 2238 "Display the list of member functions."
2308 (interactive) 2239 (interactive)
2309 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) 2240 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions))
2310 2241
2311 2242
2312(defun ebrowse-display-variables-member-list () 2243(defun ebrowse-display-variables-member-list ()
2313 "Display the list of member variables." 2244 "Display the list of member variables."
2314 (interactive) 2245 (interactive)
2315 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) 2246 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables))
2316 2247
2317 2248
2318(defun ebrowse-display-static-variables-member-list () 2249(defun ebrowse-display-static-variables-member-list ()
2319 "Display the list of static member variables." 2250 "Display the list of static member variables."
2320 (interactive) 2251 (interactive)
2321 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) 2252 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables))
2322 2253
2323 2254
2324(defun ebrowse-display-static-functions-member-list () 2255(defun ebrowse-display-static-functions-member-list ()
2325 "Display the list of static member functions." 2256 "Display the list of static member functions."
2326 (interactive) 2257 (interactive)
2327 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) 2258 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions))
2328 2259
2329 2260
2330(defun ebrowse-display-friends-member-list () 2261(defun ebrowse-display-friends-member-list ()
2331 "Display the list of friends." 2262 "Display the list of friends."
2332 (interactive) 2263 (interactive)
2333 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) 2264 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends))
2334 2265
2335 2266
2336(defun ebrowse-display-types-member-list () 2267(defun ebrowse-display-types-member-list ()
2337 "Display the list of types." 2268 "Display the list of types."
2338 (interactive) 2269 (interactive)
2339 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) 2270 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types))
2340 2271
2341 2272
2342 2273
@@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file."
2565 "Force buffer redisplay." 2496 "Force buffer redisplay."
2566 (interactive) 2497 (interactive)
2567 (let ((display-fn (if ebrowse--long-display-flag 2498 (let ((display-fn (if ebrowse--long-display-flag
2568 'ebrowse-draw-member-long-fn 2499 #'ebrowse-draw-member-long-fn
2569 'ebrowse-draw-member-short-fn))) 2500 #'ebrowse-draw-member-short-fn)))
2570 (with-silent-modifications 2501 (with-silent-modifications
2571 (erase-buffer) 2502 (erase-buffer)
2572 ;; Show this class 2503 ;; Show this class
@@ -2610,7 +2541,7 @@ the class cursor is on."
2610 "Start point for member buffer creation. 2541 "Start point for member buffer creation.
2611LIST is the member list to display. STAND-ALONE non-nil 2542LIST is the member list to display. STAND-ALONE non-nil
2612means the member buffer is standalone. CLASS is its class." 2543means the member buffer is standalone. CLASS is its class."
2613 (let* ((classes ebrowse--tree-obarray) 2544 (let* ((classes ebrowse--tree-table)
2614 (tree ebrowse--tree) 2545 (tree ebrowse--tree)
2615 (tags-file ebrowse--tags-file-name) 2546 (tags-file ebrowse--tags-file-name)
2616 (header ebrowse--header) 2547 (header ebrowse--header)
@@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class."
2630 (setq ebrowse--member-list (funcall list class) 2561 (setq ebrowse--member-list (funcall list class)
2631 ebrowse--displayed-class class 2562 ebrowse--displayed-class class
2632 ebrowse--accessor list 2563 ebrowse--accessor list
2633 ebrowse--tree-obarray classes 2564 ebrowse--tree-table classes
2634 ebrowse--frozen-flag stand-alone 2565 ebrowse--frozen-flag stand-alone
2635 ebrowse--tags-file-name tags-file 2566 ebrowse--tags-file-name tags-file
2636 ebrowse--header header 2567 ebrowse--header header
@@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times."
2842 2773
2843 2774
2844(cl-defun ebrowse-move-point-to-member (name &optional count &aux member) 2775(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
2845 "Set point on member NAME in the member buffer 2776 "Set point on member NAME in the member buffer.
2846COUNT, if specified, says search the COUNT'th member with the same name." 2777COUNT, if specified, says search the COUNT'th member with the same name."
2847 (goto-char (point-min)) 2778 (goto-char (point-min))
2848 (widen) 2779 (widen)
@@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use."
2867 (class (or (ebrowse-completing-read-value title compl-list initial) 2798 (class (or (ebrowse-completing-read-value title compl-list initial)
2868 (error "Not found")))) 2799 (error "Not found"))))
2869 (setf ebrowse--displayed-class class 2800 (setf ebrowse--displayed-class class
2870 ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) 2801 ebrowse--member-list (funcall ebrowse--accessor
2802 ebrowse--displayed-class))
2871 (ebrowse-redisplay-member-buffer))) 2803 (ebrowse-redisplay-member-buffer)))
2872 2804
2873 2805
@@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use."
2875 "Switch member buffer to a class read from the minibuffer." 2807 "Switch member buffer to a class read from the minibuffer."
2876 (interactive) 2808 (interactive)
2877 (ebrowse-switch-member-buffer-to-other-class 2809 (ebrowse-switch-member-buffer-to-other-class
2878 "Goto class: " (ebrowse-tree-obarray-as-alist))) 2810 "Goto class: "
2811 ;; FIXME: Why not use the hash-table as-is?
2812 (ebrowse-tree-table-as-alist)))
2879 2813
2880 2814
2881(defun ebrowse-switch-member-buffer-to-base-class (arg) 2815(defun ebrowse-switch-member-buffer-to-base-class (arg)
@@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one."
2927 (cl-first supers)))) 2861 (cl-first supers))))
2928 (unless tree (error "Not found")) 2862 (unless tree (error "Not found"))
2929 (setq containing-list (ebrowse-ts-subclasses tree))))) 2863 (setq containing-list (ebrowse-ts-subclasses tree)))))
2930 (setq index (+ inc (ebrowse-position ebrowse--displayed-class 2864 (setq index (+ inc (seq-position containing-list
2931 containing-list))) 2865 ebrowse--displayed-class
2866 #'eql)))
2932 (cond ((cl-minusp index) (message "No previous class")) 2867 (cond ((cl-minusp index) (message "No previous class"))
2933 ((null (nth index containing-list)) (message "No next class"))) 2868 ((null (nth index containing-list)) (message "No next class")))
2934 (setq index (max 0 (min index (1- (length containing-list))))) 2869 (setq index (max 0 (min index (1- (length containing-list)))))
@@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one."
2943Prefix arg ARG says which class should be displayed. Default is 2878Prefix arg ARG says which class should be displayed. Default is
2944the first derived class." 2879the first derived class."
2945 (interactive "P") 2880 (interactive "P")
2946 (cl-flet ((ebrowse-tree-obarray-as-alist () 2881 (cl-flet ((ebrowse-tree-table-as-alist ()
2947 (cl-loop for s in (ebrowse-ts-subclasses 2882 (cl-loop for s in (ebrowse-ts-subclasses
2948 ebrowse--displayed-class) 2883 ebrowse--displayed-class)
2949 collect (cons (ebrowse-cs-name 2884 collect (cons (ebrowse-cs-name (ebrowse-ts-class s))
2950 (ebrowse-ts-class s)) s)))) 2885 s))))
2951 (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) 2886 (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
2952 (error "No derived classes")))) 2887 (error "No derived classes"))))
2953 (if (and arg (cl-second subs)) 2888 (if (and arg (cl-second subs))
2954 (ebrowse-switch-member-buffer-to-other-class 2889 (ebrowse-switch-member-buffer-to-other-class
2955 "Goto derived class: " (ebrowse-tree-obarray-as-alist)) 2890 "Goto derived class: " (ebrowse-tree-table-as-alist))
2956 (setq ebrowse--displayed-class (cl-first subs) 2891 (setq ebrowse--displayed-class (cl-first subs)
2957 ebrowse--member-list 2892 ebrowse--member-list
2958 (funcall ebrowse--accessor ebrowse--displayed-class)) 2893 (funcall ebrowse--accessor ebrowse--displayed-class))
@@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)."
3403 (switch-to-buffer buffer) 3338 (switch-to-buffer buffer)
3404 (setq ebrowse--displayed-class (cl-first info) 3339 (setq ebrowse--displayed-class (cl-first info)
3405 ebrowse--accessor (cl-second info) 3340 ebrowse--accessor (cl-second info)
3406 ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) 3341 ebrowse--member-list (funcall ebrowse--accessor
3342 ebrowse--displayed-class))
3407 (ebrowse-redisplay-member-buffer))) 3343 (ebrowse-redisplay-member-buffer)))
3408 (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) 3344 (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
3409 3345
@@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer."
3513 (_ "unknown")) 3449 (_ "unknown"))
3514 "\n"))) 3450 "\n")))
3515 3451
3516(defvar ebrowse-last-completion nil 3452(defvar-local ebrowse-last-completion nil
3517 "Text inserted by the last completion operation.") 3453 "Text inserted by the last completion operation.")
3518 3454
3519 3455
3520(defvar ebrowse-last-completion-start nil 3456(defvar-local ebrowse-last-completion-start nil
3521 "String which was the basis for the last completion operation.") 3457 "String which was the basis for the last completion operation.")
3522 3458
3523 3459
3524(defvar ebrowse-last-completion-location nil 3460(defvar-local ebrowse-last-completion-location nil
3525 "Buffer position at which the last completion operation was initiated.") 3461 "Buffer position at which the last completion operation was initiated.")
3526 3462
3527 3463
3528(defvar ebrowse-last-completion-obarray nil 3464(defvar-local ebrowse-last-completion-table nil
3529 "Member used in last completion operation.") 3465 "Member used in last completion operation.")
3530
3531
3532(make-variable-buffer-local 'ebrowse-last-completion-obarray)
3533(make-variable-buffer-local 'ebrowse-last-completion-location)
3534(make-variable-buffer-local 'ebrowse-last-completion)
3535(make-variable-buffer-local 'ebrowse-last-completion-start)
3536
3537
3538 3466
3539(defun ebrowse-some-member-table () 3467(defun ebrowse-some-member-table ()
3540 "Return a hash table containing all members of a tree. 3468 "Return a hash table containing all members of a tree.
@@ -3552,7 +3480,7 @@ use choose a tree."
3552(defun ebrowse-cyclic-successor-in-string-list (string list) 3480(defun ebrowse-cyclic-successor-in-string-list (string list)
3553 "Return the item following STRING in LIST. 3481 "Return the item following STRING in LIST.
3554If STRING is the last element, return the first element as successor." 3482If STRING is the last element, return the first element as successor."
3555 (or (nth (1+ (ebrowse-position string list 'string=)) list) 3483 (or (nth (1+ (seq-position list string #'string=)) list)
3556 (cl-first list))) 3484 (cl-first list)))
3557 3485
3558 3486
@@ -3583,7 +3511,7 @@ completion."
3583 ;; expansion ended, insert the next expansion. 3511 ;; expansion ended, insert the next expansion.
3584 ((eq (point) ebrowse-last-completion-location) 3512 ((eq (point) ebrowse-last-completion-location)
3585 (setf list (all-completions ebrowse-last-completion-start 3513 (setf list (all-completions ebrowse-last-completion-start
3586 ebrowse-last-completion-obarray) 3514 ebrowse-last-completion-table)
3587 completion (ebrowse-cyclic-successor-in-string-list 3515 completion (ebrowse-cyclic-successor-in-string-list
3588 ebrowse-last-completion list)) 3516 ebrowse-last-completion list))
3589 (cond ((null completion) 3517 (cond ((null completion)
@@ -3599,7 +3527,7 @@ completion."
3599 ;; buffer: Start new completion. 3527 ;; buffer: Start new completion.
3600 (t 3528 (t
3601 (let* ((members (ebrowse-some-member-table)) 3529 (let* ((members (ebrowse-some-member-table))
3602 (completion (cl-first (all-completions pattern members nil)))) 3530 (completion (cl-first (all-completions pattern members))))
3603 (cond ((eq completion t)) 3531 (cond ((eq completion t))
3604 ((null completion) 3532 ((null completion)
3605 (error "Can't find completion for `%s'" pattern)) 3533 (error "Can't find completion for `%s'" pattern))
@@ -3610,14 +3538,14 @@ completion."
3610 (setf ebrowse-last-completion-location (point) 3538 (setf ebrowse-last-completion-location (point)
3611 ebrowse-last-completion-start pattern 3539 ebrowse-last-completion-start pattern
3612 ebrowse-last-completion completion 3540 ebrowse-last-completion completion
3613 ebrowse-last-completion-obarray members)))))))) 3541 ebrowse-last-completion-table members))))))))
3614 3542
3615 3543
3616;;; Tags query replace & search 3544;;; Tags query replace & search
3617 3545
3618(defvar ebrowse-tags-loop-form () 3546(defvar ebrowse-tags-loop-call '(ignore)
3619 "Form for `ebrowse-loop-continue'. 3547 "Function call for `ebrowse-loop-continue'.
3620Evaluated for each file in the tree. If it returns nil, proceed 3548Passed to `apply' for each file in the tree. If it returns nil, proceed
3621with the next file.") 3549with the next file.")
3622 3550
3623(defvar ebrowse-tags-next-file-list () 3551(defvar ebrowse-tags-next-file-list ()
@@ -3684,7 +3612,7 @@ TREE-BUFFER if indirectly specifies which files to loop over."
3684 (when first-time 3612 (when first-time
3685 (ebrowse-tags-next-file first-time tree-buffer) 3613 (ebrowse-tags-next-file first-time tree-buffer)
3686 (goto-char (point-min))) 3614 (goto-char (point-min)))
3687 (while (not (eval ebrowse-tags-loop-form)) 3615 (while (not (apply ebrowse-tags-loop-call))
3688 (ebrowse-tags-next-file) 3616 (ebrowse-tags-next-file)
3689 (message "Scanning file `%s'..." buffer-file-name) 3617 (message "Scanning file `%s'..." buffer-file-name)
3690 (goto-char (point-min)))) 3618 (goto-char (point-min))))
@@ -3697,9 +3625,9 @@ If marked classes exist, process marked classes, only.
3697If regular expression is nil, repeat last search." 3625If regular expression is nil, repeat last search."
3698 (interactive "sTree search (regexp): ") 3626 (interactive "sTree search (regexp): ")
3699 (if (and (string= regexp "") 3627 (if (and (string= regexp "")
3700 (eq (car ebrowse-tags-loop-form) 're-search-forward)) 3628 (eq (car ebrowse-tags-loop-call) #'re-search-forward))
3701 (ebrowse-tags-loop-continue) 3629 (ebrowse-tags-loop-continue)
3702 (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) 3630 (setq ebrowse-tags-loop-call `(re-search-forward ,regexp nil t))
3703 (ebrowse-tags-loop-continue 'first-time))) 3631 (ebrowse-tags-loop-continue 'first-time)))
3704 3632
3705 3633
@@ -3709,10 +3637,11 @@ If regular expression is nil, repeat last search."
3709With prefix arg, process files of marked classes only." 3637With prefix arg, process files of marked classes only."
3710 (interactive 3638 (interactive
3711 "sTree query replace (regexp): \nsTree query replace %s by: ") 3639 "sTree query replace (regexp): \nsTree query replace %s by: ")
3712 (setq ebrowse-tags-loop-form 3640 (setq ebrowse-tags-loop-call
3713 (list 'and (list 'save-excursion 3641 (list (lambda ()
3714 (list 're-search-forward from nil t)) 3642 (and (save-excursion
3715 (list 'not (list 'perform-replace from to t t nil)))) 3643 (re-search-forward from nil t))
3644 (not (perform-replace from to t t nil))))))
3716 (ebrowse-tags-loop-continue 'first-time)) 3645 (ebrowse-tags-loop-continue 'first-time))
3717 3646
3718 3647
@@ -3737,7 +3666,7 @@ looks like a function call to the member."
3737 (cl-values-list (ebrowse-tags-read-name header "Find calls of: ")))) 3666 (cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
3738 ;; Set tags loop form to search for member and begin loop. 3667 ;; Set tags loop form to search for member and begin loop.
3739 (setq regexp (concat "\\<" name "[ \t]*(") 3668 (setq regexp (concat "\\<" name "[ \t]*(")
3740 ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) 3669 ebrowse-tags-loop-call `(re-search-forward ,regexp nil t))
3741 (ebrowse-tags-loop-continue 'first-time tree-buffer)))) 3670 (ebrowse-tags-loop-continue 'first-time tree-buffer))))
3742 3671
3743 3672
@@ -3746,7 +3675,7 @@ looks like a function call to the member."
3746 3675
3747;;; Structures of this kind are the elements of the position stack. 3676;;; Structures of this kind are the elements of the position stack.
3748 3677
3749(cl-defstruct (ebrowse-position (:type vector) :named) 3678(cl-defstruct (ebrowse-position)
3750 file-name ; in which file 3679 file-name ; in which file
3751 point ; point in file 3680 point ; point in file
3752 target ; t if target of a jump 3681 target ; t if target of a jump
@@ -3839,18 +3768,10 @@ Prefix arg ARG says how much."
3839 3768
3840;;; Electric position list 3769;;; Electric position list
3841 3770
3842(defvar ebrowse-electric-position-mode-map () 3771(defvar ebrowse-electric-position-mode-map
3843 "Keymap used in electric position stack window.")
3844
3845
3846(defvar ebrowse-electric-position-mode-hook nil
3847 "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
3848
3849
3850(unless ebrowse-electric-position-mode-map
3851 (let ((map (make-keymap)) 3772 (let ((map (make-keymap))
3852 (submap (make-keymap))) 3773 (submap (make-keymap)))
3853 (setq ebrowse-electric-position-mode-map map) 3774 ;; FIXME: Yuck!
3854 (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) 3775 (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined)
3855 (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) 3776 (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined)
3856 (define-key map "\e" submap) 3777 (define-key map "\e" submap)
@@ -3873,14 +3794,19 @@ Prefix arg ARG says how much."
3873 (define-key map "\e\C-v" 'scroll-other-window) 3794 (define-key map "\e\C-v" 'scroll-other-window)
3874 (define-key map "\e>" 'end-of-buffer) 3795 (define-key map "\e>" 'end-of-buffer)
3875 (define-key map "\e<" 'beginning-of-buffer) 3796 (define-key map "\e<" 'beginning-of-buffer)
3876 (define-key map "\e>" 'end-of-buffer))) 3797 (define-key map "\e>" 'end-of-buffer)
3798 map)
3799 "Keymap used in electric position stack window.")
3800
3801
3802(defvar ebrowse-electric-position-mode-hook nil
3803 "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
3877 3804
3878(put 'ebrowse-electric-position-mode 'mode-class 'special)
3879(put 'ebrowse-electric-position-undefined 'suppress-keymap t) 3805(put 'ebrowse-electric-position-undefined 'suppress-keymap t)
3880 3806
3881 3807
3882(define-derived-mode ebrowse-electric-position-mode 3808(define-derived-mode ebrowse-electric-position-mode
3883 fundamental-mode "Electric Position Menu" 3809 special-mode "Electric Position Menu"
3884 "Mode for electric position buffers. 3810 "Mode for electric position buffers.
3885Runs the hook `ebrowse-electric-position-mode-hook'." 3811Runs the hook `ebrowse-electric-position-mode-hook'."
3886 (setq mode-line-buffer-identification "Electric Position Menu") 3812 (setq mode-line-buffer-identification "Electric Position Menu")
@@ -3888,7 +3814,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'."
3888 (setq mode-line-format (copy-sequence mode-line-format)) 3814 (setq mode-line-format (copy-sequence mode-line-format))
3889 ;; FIXME: Why not set `mode-name' to "Positions"? 3815 ;; FIXME: Why not set `mode-name' to "Positions"?
3890 (setcar (memq 'mode-name mode-line-format) "Positions")) 3816 (setcar (memq 'mode-name mode-line-format) "Positions"))
3891 (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") 3817 (setq-local Helper-return-blurb "return to buffer editing")
3892 (setq truncate-lines t 3818 (setq truncate-lines t
3893 buffer-read-only t)) 3819 buffer-read-only t))
3894 3820
@@ -4101,7 +4027,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
4101NUMBER-OF-STATIC-VARIABLES:" 4027NUMBER-OF-STATIC-VARIABLES:"
4102 (let ((classes 0) (member-functions 0) (member-variables 0) 4028 (let ((classes 0) (member-functions 0) (member-variables 0)
4103 (static-functions 0) (static-variables 0)) 4029 (static-functions 0) (static-variables 0))
4104 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 4030 (ebrowse-for-all-trees (tree ebrowse--tree-table)
4105 (cl-incf classes) 4031 (cl-incf classes)
4106 (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) 4032 (cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
4107 (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) 4033 (cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
@@ -4391,10 +4317,4 @@ EVENT is the mouse event."
4391 4317
4392 4318
4393(provide 'ebrowse) 4319(provide 'ebrowse)
4394
4395;; Local variables:
4396;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
4397;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
4398;; End:
4399
4400;;; ebrowse.el ends here 4320;;; ebrowse.el ends here
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index ea3b1b816a8..7fb36873918 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1729,25 +1729,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
1729 "Interrupt the program being debugged." 1729 "Interrupt the program being debugged."
1730 (interactive) 1730 (interactive)
1731 (interrupt-process 1731 (interrupt-process
1732 (get-buffer-process gud-comint-buffer) comint-ptyp)) 1732 (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
1733 1733
1734(defun gdb-io-quit () 1734(defun gdb-io-quit ()
1735 "Send quit signal to the program being debugged." 1735 "Send quit signal to the program being debugged."
1736 (interactive) 1736 (interactive)
1737 (quit-process 1737 (quit-process
1738 (get-buffer-process gud-comint-buffer) comint-ptyp)) 1738 (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
1739 1739
1740(defun gdb-io-stop () 1740(defun gdb-io-stop ()
1741 "Stop the program being debugged." 1741 "Stop the program being debugged."
1742 (interactive) 1742 (interactive)
1743 (stop-process 1743 (stop-process
1744 (get-buffer-process gud-comint-buffer) comint-ptyp)) 1744 (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
1745 1745
1746(defun gdb-io-eof () 1746(defun gdb-io-eof ()
1747 "Send end-of-file to the program being debugged." 1747 "Send end-of-file to the program being debugged."
1748 (interactive) 1748 (interactive)
1749 (process-send-eof 1749 (process-send-eof
1750 (get-buffer-process gud-comint-buffer))) 1750 (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io))))
1751 1751
1752(defun gdb-clear-inferior-io () 1752(defun gdb-clear-inferior-io ()
1753 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) 1753 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
diff --git a/lisp/subr.el b/lisp/subr.el
index 123557e736b..70f33ee5bdb 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1558,7 +1558,6 @@ be a list of the form returned by `event-start' and `event-end'."
1558 1558
1559;;;; Obsolescent names for functions. 1559;;;; Obsolescent names for functions.
1560 1560
1561(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
1562(make-obsolete 'buffer-has-markers-at nil "24.3") 1561(make-obsolete 'buffer-has-markers-at nil "24.3")
1563 1562
1564(make-obsolete 'invocation-directory "use the variable of the same name." 1563(make-obsolete 'invocation-directory "use the variable of the same name."
@@ -1580,6 +1579,11 @@ be a list of the form returned by `event-start' and `event-end'."
1580(make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") 1579(make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1")
1581(make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") 1580(make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1")
1582 1581
1582(defun forward-point (n)
1583 "Return buffer position N characters after (before if N negative) point."
1584 (declare (obsolete "use (+ (point) N) instead." "23.1"))
1585 (+ (point) n))
1586
1583(defun log10 (x) 1587(defun log10 (x)
1584 "Return (log X 10), the log base 10 of X." 1588 "Return (log X 10), the log base 10 of X."
1585 (declare (obsolete log "24.4")) 1589 (declare (obsolete log "24.4"))
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 79312757a2d..722fc0a3137 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -405,27 +405,31 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
405 405
406\\{conf-mode-map}" 406\\{conf-mode-map}"
407 407
408 ;; `conf-mode' plays two roles: it's the parent of several sub-modes 408 (setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil))
409 ;; but it's also the function that chooses between those submodes. 409 ;; Let newcomment.el decide this for itself.
410 ;; To tell the difference between those two cases where the function 410 ;; (setq-local comment-use-syntax t)
411 ;; might be called, we check `delay-mode-hooks'. 411 (setq-local parse-sexp-ignore-comments t)
412 ;; (adopted from tex-mode.el) 412 (setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
413 (if (not delay-mode-hooks) 413 (setq-local outline-heading-end-regexp "[\n}]")
414 (funcall (conf--guess-mode)) 414 (setq-local outline-level #'conf-outline-level)
415 415 (setq-local imenu-generic-expression
416 (setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil)) 416 '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
417 ;; Let newcomment.el decide this for itself. 417 ;; [section]
418 ;; (setq-local comment-use-syntax t) 418 (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
419 (setq-local parse-sexp-ignore-comments t) 419 ;; section { ... }
420 (setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)") 420 (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1))))
421 (setq-local outline-heading-end-regexp "[\n}]") 421
422 (setq-local outline-level #'conf-outline-level) 422;; `conf-mode' plays two roles: it's the parent of several sub-modes
423 (setq-local imenu-generic-expression 423;; but it's also the function that chooses between those submodes.
424 '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1) 424;; To tell the difference between those two cases where the function
425 ;; [section] 425;; might be called, we check `delay-mode-hooks'.
426 (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1) 426;; (inspired from tex-mode.el)
427 ;; section { ... } 427(advice-add 'conf-mode :around
428 (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1))))) 428 (lambda (orig-fun)
429 "Redirect to one of the submodes when called directly."
430 (funcall (if delay-mode-hooks orig-fun (conf--guess-mode)))))
431
432
429 433
430(defun conf-mode-initialize (comment &optional font-lock) 434(defun conf-mode-initialize (comment &optional font-lock)
431 "Initializations for sub-modes of `conf-mode'. 435 "Initializations for sub-modes of `conf-mode'.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index f95979e2fcb..1b302e34a73 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -224,7 +224,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on."
224 :group 'tex-view) 224 :group 'tex-view)
225 225
226;;;###autoload 226;;;###autoload
227(defcustom tex-default-mode 'latex-mode 227(defcustom tex-default-mode #'latex-mode
228 "Mode to enter for a new file that might be either TeX or LaTeX. 228 "Mode to enter for a new file that might be either TeX or LaTeX.
229This variable is used when it can't be determined whether the file 229This variable is used when it can't be determined whether the file
230is plain TeX or LaTeX or what because the file contains no commands. 230is plain TeX or LaTeX or what because the file contains no commands.
@@ -668,7 +668,9 @@ An alternative value is \" . \", if you use a font with a narrow period."
668 "Default expressions to highlight in TeX modes.") 668 "Default expressions to highlight in TeX modes.")
669 669
670(defvar tex-verbatim-environments 670(defvar tex-verbatim-environments
671 '("verbatim" "verbatim*")) 671 '("verbatim" "verbatim*"
672 "Verbatim" ;; From "fancyvrb"
673 ))
672(put 'tex-verbatim-environments 'safe-local-variable 674(put 'tex-verbatim-environments 'safe-local-variable
673 (lambda (x) (not (memq nil (mapcar #'stringp x))))) 675 (lambda (x) (not (memq nil (mapcar #'stringp x)))))
674 676
@@ -966,7 +968,7 @@ Inherits `shell-mode-map' with a few additions.")
966 968
967;; This would be a lot simpler if we just used a regexp search, 969;; This would be a lot simpler if we just used a regexp search,
968;; but then it would be too slow. 970;; but then it would be too slow.
969(defun tex-guess-mode () 971(defun tex--guess-mode ()
970 (let ((mode tex-default-mode) slash comment) 972 (let ((mode tex-default-mode) slash comment)
971 (save-excursion 973 (save-excursion
972 (goto-char (point-min)) 974 (goto-char (point-min))
@@ -983,52 +985,40 @@ Inherits `shell-mode-map' with a few additions.")
983 (regexp-opt '("documentstyle" "documentclass" 985 (regexp-opt '("documentstyle" "documentclass"
984 "begin" "subsection" "section" 986 "begin" "subsection" "section"
985 "part" "chapter" "newcommand" 987 "part" "chapter" "newcommand"
986 "renewcommand" "RequirePackage") 'words) 988 "renewcommand" "RequirePackage")
989 'words)
987 "\\|NeedsTeXFormat{LaTeX"))) 990 "\\|NeedsTeXFormat{LaTeX")))
988 (if (and (looking-at 991 (if (and (looking-at
989 "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}") 992 "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
990 ;; SliTeX is almost never used any more nowadays. 993 ;; SliTeX is almost never used any more nowadays.
991 (tex-executable-exists-p slitex-run-command)) 994 (tex-executable-exists-p slitex-run-command))
992 'slitex-mode 995 #'slitex-mode
993 'latex-mode) 996 #'latex-mode)
994 'plain-tex-mode)))) 997 #'plain-tex-mode))))
995 (funcall mode))) 998 mode))
996 999
997;; `tex-mode' plays two roles: it's the parent of several sub-modes 1000;; `tex-mode' plays two roles: it's the parent of several sub-modes
998;; but it's also the function that chooses between those submodes. 1001;; but it's also the function that chooses between those submodes.
999;; To tell the difference between those two cases where the function 1002;; To tell the difference between those two cases where the function
1000;; might be called, we check `delay-mode-hooks'. 1003;; might be called, we check `delay-mode-hooks'.
1001(define-derived-mode tex-mode text-mode "generic-TeX"
1002 (tex-common-initialization))
1003;; We now move the function and define it again. This gives a warning
1004;; in the byte-compiler :-( but it's difficult to avoid because
1005;; `define-derived-mode' will necessarily define the function once
1006;; and we need to define it a second time for `autoload' to get the
1007;; proper docstring.
1008(defalias 'tex-mode-internal (symbol-function 'tex-mode))
1009
1010;; Suppress the byte-compiler warning about multiple definitions.
1011;; This is a) ugly, and b) cheating, but this was the last
1012;; remaining warning from byte-compiling all of Emacs...
1013(eval-when-compile
1014 (if (boundp 'byte-compile-function-environment)
1015 (setq byte-compile-function-environment
1016 (delq (assq 'tex-mode byte-compile-function-environment)
1017 byte-compile-function-environment))))
1018
1019;;;###autoload 1004;;;###autoload
1020(defun tex-mode () 1005(define-derived-mode tex-mode text-mode "generic-TeX"
1021 "Major mode for editing files of input for TeX, LaTeX, or SliTeX. 1006 "Major mode for editing files of input for TeX, LaTeX, or SliTeX.
1007This is the shared parent mode of several submodes.
1022Tries to determine (by looking at the beginning of the file) whether 1008Tries to determine (by looking at the beginning of the file) whether
1023this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', 1009this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
1024`latex-mode', or `slitex-mode', respectively. If it cannot be determined, 1010`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
1025such as if there are no commands in the file, the value of `tex-default-mode' 1011such as if there are no commands in the file, the value of `tex-default-mode'
1026says which mode to use." 1012says which mode to use."
1027 (interactive) 1013 (tex-common-initialization))
1028 (if delay-mode-hooks 1014
1029 ;; We're called from one of the children already. 1015(advice-add 'tex-mode :around #'tex--redirect-to-submode)
1030 (tex-mode-internal) 1016(defun tex--redirect-to-submode (orig-fun)
1031 (tex-guess-mode))) 1017 "Redirect to one of the submodes when called directly."
1018 (funcall (if delay-mode-hooks
1019 ;; We're called from one of the children already.
1020 orig-fun
1021 (tex--guess-mode))))
1032 1022
1033;; The following three autoloaded aliases appear to conflict with 1023;; The following three autoloaded aliases appear to conflict with
1034;; AUCTeX. However, even though AUCTeX uses the mixed case variants 1024;; AUCTeX. However, even though AUCTeX uses the mixed case variants
@@ -1037,6 +1027,10 @@ says which mode to use."
1037;; AUCTeX to provide a fully functional user-level replacement. So 1027;; AUCTeX to provide a fully functional user-level replacement. So
1038;; these aliases should remain as they are, in particular since AUCTeX 1028;; these aliases should remain as they are, in particular since AUCTeX
1039;; users are likely to use them. 1029;; users are likely to use them.
1030;; Note from Stef: I don't understand the above explanation, the only
1031;; justification I can find to keep those confusing aliases is for those
1032;; users who may have files annotated with -*- LaTeX -*- (e.g. because they
1033;; received them from someone using AUCTeX).
1040 1034
1041;;;###autoload 1035;;;###autoload
1042(defalias 'TeX-mode 'tex-mode) 1036(defalias 'TeX-mode 'tex-mode)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8171a585158..da2d5ed50e4 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -2720,7 +2720,9 @@ hunk text is not found in the source file."
2720 ;; When initialization is requested, we should be in a brand new 2720 ;; When initialization is requested, we should be in a brand new
2721 ;; temp buffer. 2721 ;; temp buffer.
2722 (cl-assert (null buffer-file-name)) 2722 (cl-assert (null buffer-file-name))
2723 (let ((enable-local-variables :safe) ;; to find `mode:' 2723 ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because
2724 ;; Local Variables list might be incomplete when context is truncated.
2725 (let ((enable-local-variables (unless hunk-only :safe))
2724 (buffer-file-name file)) 2726 (buffer-file-name file))
2725 ;; Don't run hooks that might assume buffer-file-name 2727 ;; Don't run hooks that might assume buffer-file-name
2726 ;; really associates buffer with a file (bug#39190). 2728 ;; really associates buffer with a file (bug#39190).
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 38b4937e854..b760e170676 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1287,6 +1287,16 @@ state of item at point, if any."
1287 (list vc-dir-backend files only-files-list state model))) 1287 (list vc-dir-backend files only-files-list state model)))
1288 1288
1289;;;###autoload 1289;;;###autoload
1290(defun vc-dir-root ()
1291 "Run `vc-dir' in the repository root directory without prompt.
1292If the default directory of the current buffer is
1293not under version control, prompt for a directory."
1294 (interactive)
1295 (let ((root-dir (vc-root-dir)))
1296 (if root-dir (vc-dir root-dir)
1297 (call-interactively 'vc-dir))))
1298
1299;;;###autoload
1290(defun vc-dir (dir &optional backend) 1300(defun vc-dir (dir &optional backend)
1291 "Show the VC status for \"interesting\" files in and below DIR. 1301 "Show the VC status for \"interesting\" files in and below DIR.
1292This allows you to mark files and perform VC operations on them. 1302This allows you to mark files and perform VC operations on them.
@@ -1309,7 +1319,7 @@ These are the commands available for use in the file status buffer:
1309 ;; When you hit C-x v d in a visited VC file, 1319 ;; When you hit C-x v d in a visited VC file,
1310 ;; the *vc-dir* buffer visits the directory under its truename; 1320 ;; the *vc-dir* buffer visits the directory under its truename;
1311 ;; therefore it makes sense to always do that. 1321 ;; therefore it makes sense to always do that.
1312 ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d 1322 ;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d
1313 ;; you may get a new *vc-dir* buffer, different from the original 1323 ;; you may get a new *vc-dir* buffer, different from the original
1314 (file-truename (read-directory-name "VC status for directory: " 1324 (file-truename (read-directory-name "VC status for directory: "
1315 (vc-root-dir) nil t 1325 (vc-root-dir) nil t
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d3f1d..2ca9d3e620c 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -972,9 +972,9 @@ In the latter case, VC mode is deactivated for this buffer."
972 (bindings--define-key map [vc-ignore] 972 (bindings--define-key map [vc-ignore]
973 '(menu-item "Ignore File..." vc-ignore 973 '(menu-item "Ignore File..." vc-ignore
974 :help "Ignore a file under current version control system")) 974 :help "Ignore a file under current version control system"))
975 (bindings--define-key map [vc-dir] 975 (bindings--define-key map [vc-dir-root]
976 '(menu-item "VC Dir" vc-dir 976 '(menu-item "VC Dir" vc-dir-root
977 :help "Show the VC status of files in a directory")) 977 :help "Show the VC status of the repository"))
978 map)) 978 map))
979 979
980(defalias 'vc-menu-map vc-menu-map) 980(defalias 'vc-menu-map vc-menu-map)
diff --git a/m4/acl.m4 b/m4/acl.m4
index e459451ae31..a3dcf9357b9 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -1,5 +1,5 @@
1# acl.m4 - check for access control list (ACL) primitives 1# acl.m4 - check for access control list (ACL) primitives
2# serial 23 2# serial 24
3 3
4# Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc. 4# Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc.
5# This file is free software; the Free Software Foundation 5# This file is free software; the Free Software Foundation
@@ -139,7 +139,7 @@ int type = ACL_TYPE_EXTENDED;]])],
139 AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.]) 139 AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.])
140 fi 140 fi
141 fi 141 fi
142 test $gl_need_lib_has_acl && LIB_HAS_ACL=$LIB_ACL 142 test -n "$gl_need_lib_has_acl" && LIB_HAS_ACL=$LIB_ACL
143 AC_SUBST([LIB_ACL]) 143 AC_SUBST([LIB_ACL])
144 AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl], 144 AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl],
145 [Define to nonzero if you want access control list support.]) 145 [Define to nonzero if you want access control list support.])
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 3228aa42b57..d5faa9a1950 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -69,7 +69,6 @@ AC_DEFUN([gl_EARLY],
69 # Code from module diffseq: 69 # Code from module diffseq:
70 # Code from module dirent: 70 # Code from module dirent:
71 # Code from module dirfd: 71 # Code from module dirfd:
72 # Code from module dosname:
73 # Code from module double-slash-root: 72 # Code from module double-slash-root:
74 # Code from module dtoastr: 73 # Code from module dtoastr:
75 # Code from module dtotimespec: 74 # Code from module dtotimespec:
@@ -87,6 +86,7 @@ AC_DEFUN([gl_EARLY],
87 # Code from module fcntl-h: 86 # Code from module fcntl-h:
88 # Code from module fdopendir: 87 # Code from module fdopendir:
89 # Code from module filemode: 88 # Code from module filemode:
89 # Code from module filename:
90 # Code from module filevercmp: 90 # Code from module filevercmp:
91 # Code from module flexmember: 91 # Code from module flexmember:
92 # Code from module fpending: 92 # Code from module fpending:
@@ -961,7 +961,6 @@ AC_DEFUN([gl_FILE_LIST], [
961 lib/diffseq.h 961 lib/diffseq.h
962 lib/dirent.in.h 962 lib/dirent.in.h
963 lib/dirfd.c 963 lib/dirfd.c
964 lib/dosname.h
965 lib/dtoastr.c 964 lib/dtoastr.c
966 lib/dtotimespec.c 965 lib/dtotimespec.c
967 lib/dup2.c 966 lib/dup2.c
@@ -977,6 +976,7 @@ AC_DEFUN([gl_FILE_LIST], [
977 lib/fdopendir.c 976 lib/fdopendir.c
978 lib/filemode.c 977 lib/filemode.c
979 lib/filemode.h 978 lib/filemode.h
979 lib/filename.h
980 lib/filevercmp.c 980 lib/filevercmp.c
981 lib/filevercmp.h 981 lib/filevercmp.h
982 lib/flexmember.h 982 lib/flexmember.h
diff --git a/src/bignum.h b/src/bignum.h
index 0c2541a9dc7..ad9021f15fd 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -55,7 +55,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT)
55 ARG_NONNULL ((1, 2)); 55 ARG_NONNULL ((1, 2));
56extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) 56extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long)
57 ARG_NONNULL ((1, 2)); 57 ARG_NONNULL ((1, 2));
58extern double mpz_get_d_rounded (mpz_t const); 58extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST;
59 59
60INLINE_HEADER_BEGIN 60INLINE_HEADER_BEGIN
61 61
diff --git a/src/buffer.c b/src/buffer.c
index cc7d4e4817c..70598a7a22a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -131,6 +131,23 @@ CHECK_OVERLAY (Lisp_Object x)
131 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); 131 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
132} 132}
133 133
134/* Convert the position POS to an EMACS_INT that fits in a fixnum.
135 Yield POS's value if POS is already a fixnum, POS's marker position
136 if POS is a marker, and MOST_NEGATIVE_FIXNUM or
137 MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum.
138 Signal an error if POS is not of the proper form. */
139
140EMACS_INT
141fix_position (Lisp_Object pos)
142{
143 if (FIXNUMP (pos))
144 return XFIXNUM (pos);
145 if (MARKERP (pos))
146 return marker_position (pos);
147 CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos);
148 return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM;
149}
150
134/* These setters are used only in this file, so they can be private. 151/* These setters are used only in this file, so they can be private.
135 The public setters are inline functions defined in buffer.h. */ 152 The public setters are inline functions defined in buffer.h. */
136static void 153static void
@@ -2257,19 +2274,20 @@ so the buffer is truly empty after this. */)
2257} 2274}
2258 2275
2259void 2276void
2260validate_region (register Lisp_Object *b, register Lisp_Object *e) 2277validate_region (Lisp_Object *b, Lisp_Object *e)
2261{ 2278{
2262 CHECK_FIXNUM_COERCE_MARKER (*b); 2279 EMACS_INT beg = fix_position (*b), end = fix_position (*e);
2263 CHECK_FIXNUM_COERCE_MARKER (*e);
2264 2280
2265 if (XFIXNUM (*b) > XFIXNUM (*e)) 2281 if (end < beg)
2266 { 2282 {
2267 Lisp_Object tem; 2283 EMACS_INT tem = beg; beg = end; end = tem;
2268 tem = *b; *b = *e; *e = tem;
2269 } 2284 }
2270 2285
2271 if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV)) 2286 if (! (BEGV <= beg && end <= ZV))
2272 args_out_of_range_3 (Fcurrent_buffer (), *b, *e); 2287 args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
2288
2289 *b = make_fixnum (beg);
2290 *e = make_fixnum (end);
2273} 2291}
2274 2292
2275/* Advance BYTE_POS up to a character boundary 2293/* Advance BYTE_POS up to a character boundary
diff --git a/src/buffer.h b/src/buffer.h
index fd05fdd37de..31f497ea40a 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1150,6 +1150,8 @@ extern Lisp_Object interval_insert_behind_hooks;
1150extern Lisp_Object interval_insert_in_front_hooks; 1150extern Lisp_Object interval_insert_in_front_hooks;
1151 1151
1152 1152
1153extern EMACS_INT fix_position (Lisp_Object);
1154#define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x)))
1153extern void delete_all_overlays (struct buffer *); 1155extern void delete_all_overlays (struct buffer *);
1154extern void reset_buffer (struct buffer *); 1156extern void reset_buffer (struct buffer *);
1155extern void compact_buffer (struct buffer *); 1157extern void compact_buffer (struct buffer *);
diff --git a/src/character.c b/src/character.c
index 5d419a2e836..d71cb3f145c 100644
--- a/src/character.c
+++ b/src/character.c
@@ -931,10 +931,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
931 } 931 }
932 else 932 else
933 { 933 {
934 CHECK_FIXNUM_COERCE_MARKER (position); 934 EMACS_INT fixed_pos = fix_position (position);
935 if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV) 935 if (! (BEGV <= fixed_pos && fixed_pos < ZV))
936 args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); 936 args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
937 pos = XFIXNAT (position); 937 pos = fixed_pos;
938 p = CHAR_POS_ADDR (pos); 938 p = CHAR_POS_ADDR (pos);
939 } 939 }
940 if (NILP (BVAR (current_buffer, enable_multibyte_characters))) 940 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
diff --git a/src/cmds.c b/src/cmds.c
index 5d7a45e65f6..c342cd88bd8 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
31 31
32static int internal_self_insert (int, EMACS_INT); 32static int internal_self_insert (int, EMACS_INT);
33 33
34DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
35 doc: /* Return buffer position N characters after (before if N negative) point. */)
36 (Lisp_Object n)
37{
38 CHECK_FIXNUM (n);
39
40 return make_fixnum (PT + XFIXNUM (n));
41}
42
43/* Add N to point; or subtract N if FORWARD is false. N defaults to 1. 34/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
44 Validate the new location. Return nil. */ 35 Validate the new location. Return nil. */
45static Lisp_Object 36static Lisp_Object
@@ -460,7 +451,10 @@ internal_self_insert (int c, EMACS_INT n)
460 string = concat2 (string, tem); 451 string = concat2 (string, tem);
461 } 452 }
462 453
463 replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0); 454 ptrdiff_t to;
455 if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
456 to = PTRDIFF_MAX;
457 replace_range (PT, to, string, 1, 1, 1, 0);
464 Fforward_char (make_fixnum (n)); 458 Fforward_char (make_fixnum (n));
465 } 459 }
466 else if (n > 1) 460 else if (n > 1)
@@ -526,7 +520,6 @@ syms_of_cmds (void)
526This is run after inserting the character. */); 520This is run after inserting the character. */);
527 Vpost_self_insert_hook = Qnil; 521 Vpost_self_insert_hook = Qnil;
528 522
529 defsubr (&Sforward_point);
530 defsubr (&Sforward_char); 523 defsubr (&Sforward_char);
531 defsubr (&Sbackward_char); 524 defsubr (&Sbackward_char);
532 defsubr (&Sforward_line); 525 defsubr (&Sforward_line);
diff --git a/src/coding.c b/src/coding.c
index 8b54281c0bf..0bea2a0c2bc 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9023,23 +9023,23 @@ DEFUN ("find-coding-systems-region-internal",
9023 } 9023 }
9024 else 9024 else
9025 { 9025 {
9026 CHECK_FIXNUM_COERCE_MARKER (start); 9026 EMACS_INT s = fix_position (start);
9027 CHECK_FIXNUM_COERCE_MARKER (end); 9027 EMACS_INT e = fix_position (end);
9028 if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) 9028 if (! (BEG <= s && s <= e && e <= Z))
9029 args_out_of_range (start, end); 9029 args_out_of_range (start, end);
9030 if (NILP (BVAR (current_buffer, enable_multibyte_characters))) 9030 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
9031 return Qt; 9031 return Qt;
9032 start_byte = CHAR_TO_BYTE (XFIXNUM (start)); 9032 start_byte = CHAR_TO_BYTE (s);
9033 end_byte = CHAR_TO_BYTE (XFIXNUM (end)); 9033 end_byte = CHAR_TO_BYTE (e);
9034 if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) 9034 if (e - s == end_byte - start_byte)
9035 return Qt; 9035 return Qt;
9036 9036
9037 if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) 9037 if (s < GPT && GPT < e)
9038 { 9038 {
9039 if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) 9039 if (GPT - s < e - GPT)
9040 move_gap_both (XFIXNUM (start), start_byte); 9040 move_gap_both (s, start_byte);
9041 else 9041 else
9042 move_gap_both (XFIXNUM (end), end_byte); 9042 move_gap_both (e, end_byte);
9043 } 9043 }
9044 } 9044 }
9045 9045
@@ -9277,25 +9277,25 @@ is nil. */)
9277 } 9277 }
9278 else 9278 else
9279 { 9279 {
9280 CHECK_FIXNUM_COERCE_MARKER (start); 9280 EMACS_INT s = fix_position (start);
9281 CHECK_FIXNUM_COERCE_MARKER (end); 9281 EMACS_INT e = fix_position (end);
9282 if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) 9282 if (! (BEG <= s && s <= e && e <= Z))
9283 args_out_of_range (start, end); 9283 args_out_of_range (start, end);
9284 if (NILP (BVAR (current_buffer, enable_multibyte_characters))) 9284 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
9285 return Qnil; 9285 return Qnil;
9286 start_byte = CHAR_TO_BYTE (XFIXNUM (start)); 9286 start_byte = CHAR_TO_BYTE (s);
9287 end_byte = CHAR_TO_BYTE (XFIXNUM (end)); 9287 end_byte = CHAR_TO_BYTE (e);
9288 if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) 9288 if (e - s == end_byte - start_byte)
9289 return Qnil; 9289 return Qnil;
9290 9290
9291 if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) 9291 if (s < GPT && GPT < e)
9292 { 9292 {
9293 if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) 9293 if (GPT - s < e - GPT)
9294 move_gap_both (XFIXNUM (start), start_byte); 9294 move_gap_both (s, start_byte);
9295 else 9295 else
9296 move_gap_both (XFIXNUM (end), end_byte); 9296 move_gap_both (e, end_byte);
9297 } 9297 }
9298 pos = XFIXNUM (start); 9298 pos = s;
9299 } 9299 }
9300 9300
9301 list = Qnil; 9301 list = Qnil;
diff --git a/src/composite.c b/src/composite.c
index 84de334ce0d..a00a4541f5e 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1839,27 +1839,24 @@ See `find-composition' for more details. */)
1839 ptrdiff_t start, end, from, to; 1839 ptrdiff_t start, end, from, to;
1840 int id; 1840 int id;
1841 1841
1842 CHECK_FIXNUM_COERCE_MARKER (pos); 1842 EMACS_INT fixed_pos = fix_position (pos);
1843 if (!NILP (limit)) 1843 if (!NILP (limit))
1844 { 1844 to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV);
1845 CHECK_FIXNUM_COERCE_MARKER (limit);
1846 to = min (XFIXNUM (limit), ZV);
1847 }
1848 else 1845 else
1849 to = -1; 1846 to = -1;
1850 1847
1851 if (!NILP (string)) 1848 if (!NILP (string))
1852 { 1849 {
1853 CHECK_STRING (string); 1850 CHECK_STRING (string);
1854 if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string)) 1851 if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string)))
1855 args_out_of_range (string, pos); 1852 args_out_of_range (string, pos);
1856 } 1853 }
1857 else 1854 else
1858 { 1855 {
1859 if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV) 1856 if (! (BEGV <= fixed_pos && fixed_pos <= ZV))
1860 args_out_of_range (Fcurrent_buffer (), pos); 1857 args_out_of_range (Fcurrent_buffer (), pos);
1861 } 1858 }
1862 from = XFIXNUM (pos); 1859 from = fixed_pos;
1863 1860
1864 if (!find_composition (from, to, &start, &end, &prop, string)) 1861 if (!find_composition (from, to, &start, &end, &prop, string))
1865 { 1862 {
@@ -1870,12 +1867,12 @@ See `find-composition' for more details. */)
1870 return list3 (make_fixnum (start), make_fixnum (end), gstring); 1867 return list3 (make_fixnum (start), make_fixnum (end), gstring);
1871 return Qnil; 1868 return Qnil;
1872 } 1869 }
1873 if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos))) 1870 if (! (start <= fixed_pos && fixed_pos < end))
1874 { 1871 {
1875 ptrdiff_t s, e; 1872 ptrdiff_t s, e;
1876 1873
1877 if (find_automatic_composition (from, to, &s, &e, &gstring, string) 1874 if (find_automatic_composition (from, to, &s, &e, &gstring, string)
1878 && (e <= XFIXNUM (pos) ? e > end : s < start)) 1875 && (e <= fixed_pos ? e > end : s < start))
1879 return list3 (make_fixnum (s), make_fixnum (e), gstring); 1876 return list3 (make_fixnum (s), make_fixnum (e), gstring);
1880 } 1877 }
1881 if (!composition_valid_p (start, end, prop)) 1878 if (!composition_valid_p (start, end, prop))
diff --git a/src/data.c b/src/data.c
index 2820f647981..b53b8409b59 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2368,6 +2368,24 @@ bool-vector. IDX starts at 0. */)
2368 2368
2369/* Arithmetic functions */ 2369/* Arithmetic functions */
2370 2370
2371static Lisp_Object
2372check_integer_coerce_marker (Lisp_Object x)
2373{
2374 if (MARKERP (x))
2375 return make_fixnum (marker_position (x));
2376 CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x);
2377 return x;
2378}
2379
2380static Lisp_Object
2381check_number_coerce_marker (Lisp_Object x)
2382{
2383 if (MARKERP (x))
2384 return make_fixnum (marker_position (x));
2385 CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x);
2386 return x;
2387}
2388
2371Lisp_Object 2389Lisp_Object
2372arithcompare (Lisp_Object num1, Lisp_Object num2, 2390arithcompare (Lisp_Object num1, Lisp_Object num2,
2373 enum Arith_Comparison comparison) 2391 enum Arith_Comparison comparison)
@@ -2376,8 +2394,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2376 bool lt, eq = true, gt; 2394 bool lt, eq = true, gt;
2377 bool test; 2395 bool test;
2378 2396
2379 CHECK_NUMBER_COERCE_MARKER (num1); 2397 num1 = check_number_coerce_marker (num1);
2380 CHECK_NUMBER_COERCE_MARKER (num2); 2398 num2 = check_number_coerce_marker (num2);
2381 2399
2382 /* If the comparison is mostly done by comparing two doubles, 2400 /* If the comparison is mostly done by comparing two doubles,
2383 set LT, EQ, and GT to the <, ==, > results of that comparison, 2401 set LT, EQ, and GT to the <, ==, > results of that comparison,
@@ -2779,9 +2797,7 @@ floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
2779 argnum++; 2797 argnum++;
2780 if (argnum == nargs) 2798 if (argnum == nargs)
2781 return make_float (accum); 2799 return make_float (accum);
2782 Lisp_Object val = args[argnum]; 2800 next = XFLOATINT (check_number_coerce_marker (args[argnum]));
2783 CHECK_NUMBER_COERCE_MARKER (val);
2784 next = XFLOATINT (val);
2785 } 2801 }
2786} 2802}
2787 2803
@@ -2843,8 +2859,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
2843 argnum++; 2859 argnum++;
2844 if (argnum == nargs) 2860 if (argnum == nargs)
2845 return make_integer_mpz (); 2861 return make_integer_mpz ();
2846 val = args[argnum]; 2862 val = check_number_coerce_marker (args[argnum]);
2847 CHECK_NUMBER_COERCE_MARKER (val);
2848 if (FLOATP (val)) 2863 if (FLOATP (val))
2849 return float_arith_driver (code, nargs, args, argnum, 2864 return float_arith_driver (code, nargs, args, argnum,
2850 mpz_get_d_rounded (*accum), val); 2865 mpz_get_d_rounded (*accum), val);
@@ -2873,8 +2888,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
2873 argnum++; 2888 argnum++;
2874 if (argnum == nargs) 2889 if (argnum == nargs)
2875 return make_int (accum); 2890 return make_int (accum);
2876 val = args[argnum]; 2891 val = check_number_coerce_marker (args[argnum]);
2877 CHECK_NUMBER_COERCE_MARKER (val);
2878 2892
2879 /* Set NEXT to the next value if it fits, else exit the loop. */ 2893 /* Set NEXT to the next value if it fits, else exit the loop. */
2880 intmax_t next; 2894 intmax_t next;
@@ -2921,8 +2935,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */)
2921{ 2935{
2922 if (nargs == 0) 2936 if (nargs == 0)
2923 return make_fixnum (0); 2937 return make_fixnum (0);
2924 Lisp_Object a = args[0]; 2938 Lisp_Object a = check_number_coerce_marker (args[0]);
2925 CHECK_NUMBER_COERCE_MARKER (a);
2926 return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); 2939 return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a);
2927} 2940}
2928 2941
@@ -2935,8 +2948,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
2935{ 2948{
2936 if (nargs == 0) 2949 if (nargs == 0)
2937 return make_fixnum (0); 2950 return make_fixnum (0);
2938 Lisp_Object a = args[0]; 2951 Lisp_Object a = check_number_coerce_marker (args[0]);
2939 CHECK_NUMBER_COERCE_MARKER (a);
2940 if (nargs == 1) 2952 if (nargs == 1)
2941 { 2953 {
2942 if (FIXNUMP (a)) 2954 if (FIXNUMP (a))
@@ -2956,8 +2968,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
2956{ 2968{
2957 if (nargs == 0) 2969 if (nargs == 0)
2958 return make_fixnum (1); 2970 return make_fixnum (1);
2959 Lisp_Object a = args[0]; 2971 Lisp_Object a = check_number_coerce_marker (args[0]);
2960 CHECK_NUMBER_COERCE_MARKER (a);
2961 return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); 2972 return nargs == 1 ? a : arith_driver (Amult, nargs, args, a);
2962} 2973}
2963 2974
@@ -2969,8 +2980,7 @@ The arguments must be numbers or markers.
2969usage: (/ NUMBER &rest DIVISORS) */) 2980usage: (/ NUMBER &rest DIVISORS) */)
2970 (ptrdiff_t nargs, Lisp_Object *args) 2981 (ptrdiff_t nargs, Lisp_Object *args)
2971{ 2982{
2972 Lisp_Object a = args[0]; 2983 Lisp_Object a = check_number_coerce_marker (args[0]);
2973 CHECK_NUMBER_COERCE_MARKER (a);
2974 if (nargs == 1) 2984 if (nargs == 1)
2975 { 2985 {
2976 if (FIXNUMP (a)) 2986 if (FIXNUMP (a))
@@ -3052,10 +3062,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
3052DEFUN ("%", Frem, Srem, 2, 2, 0, 3062DEFUN ("%", Frem, Srem, 2, 2, 0,
3053 doc: /* Return remainder of X divided by Y. 3063 doc: /* Return remainder of X divided by Y.
3054Both must be integers or markers. */) 3064Both must be integers or markers. */)
3055 (register Lisp_Object x, Lisp_Object y) 3065 (Lisp_Object x, Lisp_Object y)
3056{ 3066{
3057 CHECK_INTEGER_COERCE_MARKER (x); 3067 x = check_integer_coerce_marker (x);
3058 CHECK_INTEGER_COERCE_MARKER (y); 3068 y = check_integer_coerce_marker (y);
3059 return integer_remainder (x, y, false); 3069 return integer_remainder (x, y, false);
3060} 3070}
3061 3071
@@ -3065,8 +3075,8 @@ The result falls between zero (inclusive) and Y (exclusive).
3065Both X and Y must be numbers or markers. */) 3075Both X and Y must be numbers or markers. */)
3066 (Lisp_Object x, Lisp_Object y) 3076 (Lisp_Object x, Lisp_Object y)
3067{ 3077{
3068 CHECK_NUMBER_COERCE_MARKER (x); 3078 x = check_number_coerce_marker (x);
3069 CHECK_NUMBER_COERCE_MARKER (y); 3079 y = check_number_coerce_marker (y);
3070 if (FLOATP (x) || FLOATP (y)) 3080 if (FLOATP (x) || FLOATP (y))
3071 return fmod_float (x, y); 3081 return fmod_float (x, y);
3072 return integer_remainder (x, y, true); 3082 return integer_remainder (x, y, true);
@@ -3076,12 +3086,10 @@ static Lisp_Object
3076minmax_driver (ptrdiff_t nargs, Lisp_Object *args, 3086minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
3077 enum Arith_Comparison comparison) 3087 enum Arith_Comparison comparison)
3078{ 3088{
3079 Lisp_Object accum = args[0]; 3089 Lisp_Object accum = check_number_coerce_marker (args[0]);
3080 CHECK_NUMBER_COERCE_MARKER (accum);
3081 for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) 3090 for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
3082 { 3091 {
3083 Lisp_Object val = args[argnum]; 3092 Lisp_Object val = check_number_coerce_marker (args[argnum]);
3084 CHECK_NUMBER_COERCE_MARKER (val);
3085 if (!NILP (arithcompare (val, accum, comparison))) 3093 if (!NILP (arithcompare (val, accum, comparison)))
3086 accum = val; 3094 accum = val;
3087 else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) 3095 else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
@@ -3116,8 +3124,7 @@ usage: (logand &rest INTS-OR-MARKERS) */)
3116{ 3124{
3117 if (nargs == 0) 3125 if (nargs == 0)
3118 return make_fixnum (-1); 3126 return make_fixnum (-1);
3119 Lisp_Object a = args[0]; 3127 Lisp_Object a = check_integer_coerce_marker (args[0]);
3120 CHECK_INTEGER_COERCE_MARKER (a);
3121 return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); 3128 return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a);
3122} 3129}
3123 3130
@@ -3129,8 +3136,7 @@ usage: (logior &rest INTS-OR-MARKERS) */)
3129{ 3136{
3130 if (nargs == 0) 3137 if (nargs == 0)
3131 return make_fixnum (0); 3138 return make_fixnum (0);
3132 Lisp_Object a = args[0]; 3139 Lisp_Object a = check_integer_coerce_marker (args[0]);
3133 CHECK_INTEGER_COERCE_MARKER (a);
3134 return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); 3140 return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a);
3135} 3141}
3136 3142
@@ -3142,8 +3148,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */)
3142{ 3148{
3143 if (nargs == 0) 3149 if (nargs == 0)
3144 return make_fixnum (0); 3150 return make_fixnum (0);
3145 Lisp_Object a = args[0]; 3151 Lisp_Object a = check_integer_coerce_marker (args[0]);
3146 CHECK_INTEGER_COERCE_MARKER (a);
3147 return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); 3152 return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a);
3148} 3153}
3149 3154
@@ -3262,9 +3267,9 @@ expt_integer (Lisp_Object x, Lisp_Object y)
3262DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, 3267DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
3263 doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. 3268 doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
3264Markers are converted to integers. */) 3269Markers are converted to integers. */)
3265 (register Lisp_Object number) 3270 (Lisp_Object number)
3266{ 3271{
3267 CHECK_NUMBER_COERCE_MARKER (number); 3272 number = check_number_coerce_marker (number);
3268 3273
3269 if (FIXNUMP (number)) 3274 if (FIXNUMP (number))
3270 return make_int (XFIXNUM (number) + 1); 3275 return make_int (XFIXNUM (number) + 1);
@@ -3277,9 +3282,9 @@ Markers are converted to integers. */)
3277DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, 3282DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
3278 doc: /* Return NUMBER minus one. NUMBER may be a number or a marker. 3283 doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
3279Markers are converted to integers. */) 3284Markers are converted to integers. */)
3280 (register Lisp_Object number) 3285 (Lisp_Object number)
3281{ 3286{
3282 CHECK_NUMBER_COERCE_MARKER (number); 3287 number = check_number_coerce_marker (number);
3283 3288
3284 if (FIXNUMP (number)) 3289 if (FIXNUMP (number))
3285 return make_int (XFIXNUM (number) - 1); 3290 return make_int (XFIXNUM (number) - 1);
diff --git a/src/editfns.c b/src/editfns.c
index eb15566fb48..90520d0dced 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -725,18 +725,23 @@ boundaries, bind `inhibit-field-text-motion' to t.
725This function does not move point. */) 725This function does not move point. */)
726 (Lisp_Object n) 726 (Lisp_Object n)
727{ 727{
728 ptrdiff_t charpos, bytepos; 728 ptrdiff_t charpos, bytepos, count;
729 729
730 if (NILP (n)) 730 if (NILP (n))
731 XSETFASTINT (n, 1); 731 count = 0;
732 else if (FIXNUMP (n))
733 count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX);
732 else 734 else
733 CHECK_FIXNUM (n); 735 {
736 CHECK_INTEGER (n);
737 count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
738 }
734 739
735 scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos); 740 scan_newline_from_point (count, &charpos, &bytepos);
736 741
737 /* Return END constrained to the current input field. */ 742 /* Return END constrained to the current input field. */
738 return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), 743 return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT),
739 XFIXNUM (n) != 1 ? Qt : Qnil, 744 count != 0 ? Qt : Qnil,
740 Qt, Qnil); 745 Qt, Qnil);
741} 746}
742 747
@@ -763,11 +768,14 @@ This function does not move point. */)
763 ptrdiff_t orig = PT; 768 ptrdiff_t orig = PT;
764 769
765 if (NILP (n)) 770 if (NILP (n))
766 XSETFASTINT (n, 1); 771 clipped_n = 1;
772 else if (FIXNUMP (n))
773 clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX);
767 else 774 else
768 CHECK_FIXNUM (n); 775 {
769 776 CHECK_INTEGER (n);
770 clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX); 777 clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
778 }
771 end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), 779 end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),
772 NULL); 780 NULL);
773 781
@@ -940,10 +948,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
940If POSITION is out of range, the value is nil. */) 948If POSITION is out of range, the value is nil. */)
941 (Lisp_Object position) 949 (Lisp_Object position)
942{ 950{
943 CHECK_FIXNUM_COERCE_MARKER (position); 951 EMACS_INT pos = fix_position (position);
944 if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z) 952 if (! (BEG <= pos && pos <= Z))
945 return Qnil; 953 return Qnil;
946 return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position))); 954 return make_fixnum (CHAR_TO_BYTE (pos));
947} 955}
948 956
949DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, 957DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0,
@@ -1060,11 +1068,11 @@ If POS is out of range, the value is nil. */)
1060 } 1068 }
1061 else 1069 else
1062 { 1070 {
1063 CHECK_FIXNUM_COERCE_MARKER (pos); 1071 EMACS_INT p = fix_position (pos);
1064 if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV) 1072 if (! (BEGV <= p && p < ZV))
1065 return Qnil; 1073 return Qnil;
1066 1074
1067 pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); 1075 pos_byte = CHAR_TO_BYTE (p);
1068 } 1076 }
1069 1077
1070 return make_fixnum (FETCH_CHAR (pos_byte)); 1078 return make_fixnum (FETCH_CHAR (pos_byte));
@@ -1094,12 +1102,12 @@ If POS is out of range, the value is nil. */)
1094 } 1102 }
1095 else 1103 else
1096 { 1104 {
1097 CHECK_FIXNUM_COERCE_MARKER (pos); 1105 EMACS_INT p = fix_position (pos);
1098 1106
1099 if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV) 1107 if (! (BEGV < p && p <= ZV))
1100 return Qnil; 1108 return Qnil;
1101 1109
1102 pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); 1110 pos_byte = CHAR_TO_BYTE (p);
1103 } 1111 }
1104 1112
1105 if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) 1113 if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
@@ -1718,21 +1726,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */)
1718 if (!BUFFER_LIVE_P (bp)) 1726 if (!BUFFER_LIVE_P (bp))
1719 error ("Selecting deleted buffer"); 1727 error ("Selecting deleted buffer");
1720 1728
1721 if (NILP (start)) 1729 b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp);
1722 b = BUF_BEGV (bp); 1730 e = !NILP (end) ? fix_position (end) : BUF_ZV (bp);
1723 else
1724 {
1725 CHECK_FIXNUM_COERCE_MARKER (start);
1726 b = XFIXNUM (start);
1727 }
1728 if (NILP (end))
1729 e = BUF_ZV (bp);
1730 else
1731 {
1732 CHECK_FIXNUM_COERCE_MARKER (end);
1733 e = XFIXNUM (end);
1734 }
1735
1736 if (b > e) 1731 if (b > e)
1737 temp = b, b = e, e = temp; 1732 temp = b, b = e, e = temp;
1738 1733
@@ -1786,21 +1781,8 @@ determines whether case is significant or ignored. */)
1786 error ("Selecting deleted buffer"); 1781 error ("Selecting deleted buffer");
1787 } 1782 }
1788 1783
1789 if (NILP (start1)) 1784 begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1);
1790 begp1 = BUF_BEGV (bp1); 1785 endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1);
1791 else
1792 {
1793 CHECK_FIXNUM_COERCE_MARKER (start1);
1794 begp1 = XFIXNUM (start1);
1795 }
1796 if (NILP (end1))
1797 endp1 = BUF_ZV (bp1);
1798 else
1799 {
1800 CHECK_FIXNUM_COERCE_MARKER (end1);
1801 endp1 = XFIXNUM (end1);
1802 }
1803
1804 if (begp1 > endp1) 1786 if (begp1 > endp1)
1805 temp = begp1, begp1 = endp1, endp1 = temp; 1787 temp = begp1, begp1 = endp1, endp1 = temp;
1806 1788
@@ -1824,21 +1806,8 @@ determines whether case is significant or ignored. */)
1824 error ("Selecting deleted buffer"); 1806 error ("Selecting deleted buffer");
1825 } 1807 }
1826 1808
1827 if (NILP (start2)) 1809 begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2);
1828 begp2 = BUF_BEGV (bp2); 1810 endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2);
1829 else
1830 {
1831 CHECK_FIXNUM_COERCE_MARKER (start2);
1832 begp2 = XFIXNUM (start2);
1833 }
1834 if (NILP (end2))
1835 endp2 = BUF_ZV (bp2);
1836 else
1837 {
1838 CHECK_FIXNUM_COERCE_MARKER (end2);
1839 endp2 = XFIXNUM (end2);
1840 }
1841
1842 if (begp2 > endp2) 1811 if (begp2 > endp2)
1843 temp = begp2, begp2 = endp2, endp2 = temp; 1812 temp = begp2, begp2 = endp2, endp2 = temp;
1844 1813
@@ -2692,29 +2661,27 @@ See also `save-restriction'.
2692When calling from Lisp, pass two arguments START and END: 2661When calling from Lisp, pass two arguments START and END:
2693positions (integers or markers) bounding the text that should 2662positions (integers or markers) bounding the text that should
2694remain visible. */) 2663remain visible. */)
2695 (register Lisp_Object start, Lisp_Object end) 2664 (Lisp_Object start, Lisp_Object end)
2696{ 2665{
2697 CHECK_FIXNUM_COERCE_MARKER (start); 2666 EMACS_INT s = fix_position (start), e = fix_position (end);
2698 CHECK_FIXNUM_COERCE_MARKER (end);
2699 2667
2700 if (XFIXNUM (start) > XFIXNUM (end)) 2668 if (e < s)
2701 { 2669 {
2702 Lisp_Object tem; 2670 EMACS_INT tem = s; s = e; e = tem;
2703 tem = start; start = end; end = tem;
2704 } 2671 }
2705 2672
2706 if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z)) 2673 if (!(BEG <= s && s <= e && e <= Z))
2707 args_out_of_range (start, end); 2674 args_out_of_range (start, end);
2708 2675
2709 if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end)) 2676 if (BEGV != s || ZV != e)
2710 current_buffer->clip_changed = 1; 2677 current_buffer->clip_changed = 1;
2711 2678
2712 SET_BUF_BEGV (current_buffer, XFIXNAT (start)); 2679 SET_BUF_BEGV (current_buffer, s);
2713 SET_BUF_ZV (current_buffer, XFIXNAT (end)); 2680 SET_BUF_ZV (current_buffer, e);
2714 if (PT < XFIXNAT (start)) 2681 if (PT < s)
2715 SET_PT (XFIXNAT (start)); 2682 SET_PT (s);
2716 if (PT > XFIXNAT (end)) 2683 if (e < PT)
2717 SET_PT (XFIXNAT (end)); 2684 SET_PT (e);
2718 /* Changing the buffer bounds invalidates any recorded current column. */ 2685 /* Changing the buffer bounds invalidates any recorded current column. */
2719 invalidate_current_column (); 2686 invalidate_current_column ();
2720 return Qnil; 2687 return Qnil;
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 60f16418efa..cdcbe061b53 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -88,6 +88,7 @@ To add a new module function, proceed as follows:
88#include "dynlib.h" 88#include "dynlib.h"
89#include "coding.h" 89#include "coding.h"
90#include "keyboard.h" 90#include "keyboard.h"
91#include "process.h"
91#include "syssignal.h" 92#include "syssignal.h"
92#include "sysstdio.h" 93#include "sysstdio.h"
93#include "thread.h" 94#include "thread.h"
@@ -977,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign,
977 return lisp_to_value (env, make_integer_mpz ()); 978 return lisp_to_value (env, make_integer_mpz ());
978} 979}
979 980
981static int
982module_open_channel (emacs_env *env, emacs_value pipe_process)
983{
984 MODULE_FUNCTION_BEGIN (-1);
985 return open_channel_for_module (value_to_lisp (pipe_process));
986}
987
980 988
981/* Subroutines. */ 989/* Subroutines. */
982 990
@@ -1391,6 +1399,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1391 env->make_big_integer = module_make_big_integer; 1399 env->make_big_integer = module_make_big_integer;
1392 env->get_function_finalizer = module_get_function_finalizer; 1400 env->get_function_finalizer = module_get_function_finalizer;
1393 env->set_function_finalizer = module_set_function_finalizer; 1401 env->set_function_finalizer = module_set_function_finalizer;
1402 env->open_channel = module_open_channel;
1394 Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); 1403 Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
1395 return env; 1404 return env;
1396} 1405}
diff --git a/src/fileio.c b/src/fileio.c
index ffe79559a3f..978a373d39b 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -96,7 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
96#include <acl.h> 96#include <acl.h>
97#include <allocator.h> 97#include <allocator.h>
98#include <careadlinkat.h> 98#include <careadlinkat.h>
99#include <dosname.h> 99#include <filename.h>
100#include <fsusage.h> 100#include <fsusage.h>
101#include <stat-time.h> 101#include <stat-time.h>
102#include <tempname.h> 102#include <tempname.h>
diff --git a/src/filelock.c b/src/filelock.c
index 2b734ee00d5..ee46e0e3e00 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -661,7 +661,7 @@ void
661lock_file (Lisp_Object fn) 661lock_file (Lisp_Object fn)
662{ 662{
663 Lisp_Object orig_fn, encoded_fn; 663 Lisp_Object orig_fn, encoded_fn;
664 char *lfname; 664 char *lfname = NULL;
665 lock_info_type lock_info; 665 lock_info_type lock_info;
666 USE_SAFE_ALLOCA; 666 USE_SAFE_ALLOCA;
667 667
@@ -686,21 +686,15 @@ lock_file (Lisp_Object fn)
686 686
687 /* See if this file is visited and has changed on disk since it was 687 /* See if this file is visited and has changed on disk since it was
688 visited. */ 688 visited. */
689 { 689 Lisp_Object subject_buf = get_truename_buffer (orig_fn);
690 register Lisp_Object subject_buf; 690 if (!NILP (subject_buf)
691 691 && NILP (Fverify_visited_file_modtime (subject_buf))
692 subject_buf = get_truename_buffer (orig_fn); 692 && !NILP (Ffile_exists_p (fn))
693 693 && !(lfname && current_lock_owner (NULL, lfname) == -2))
694 if (!NILP (subject_buf) 694 call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
695 && NILP (Fverify_visited_file_modtime (subject_buf))
696 && !NILP (Ffile_exists_p (fn))
697 && (!create_lockfiles || current_lock_owner (NULL, lfname) != -2))
698 call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
699
700 }
701 695
702 /* Don't do locking if the user has opted out. */ 696 /* Don't do locking if the user has opted out. */
703 if (create_lockfiles) 697 if (lfname)
704 { 698 {
705 /* Try to lock the lock. FIXME: This ignores errors when 699 /* Try to lock the lock. FIXME: This ignores errors when
706 lock_if_free returns a positive errno value. */ 700 lock_if_free returns a positive errno value. */
@@ -860,7 +854,7 @@ syms_of_filelock (void)
860The name of the (per-buffer) lockfile is constructed by prepending a 854The name of the (per-buffer) lockfile is constructed by prepending a
861'.#' to the name of the file being locked. See also `lock-buffer' and 855'.#' to the name of the file being locked. See also `lock-buffer' and
862Info node `(emacs)Interlocking'. */); 856Info node `(emacs)Interlocking'. */);
863 create_lockfiles = 1; 857 create_lockfiles = true;
864 858
865 defsubr (&Sunlock_buffer); 859 defsubr (&Sunlock_buffer);
866 defsubr (&Slock_buffer); 860 defsubr (&Slock_buffer);
diff --git a/src/fns.c b/src/fns.c
index 80012fa9d28..138082e07c8 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5187,22 +5187,8 @@ extract_data_from_object (Lisp_Object spec,
5187 struct buffer *bp = XBUFFER (object); 5187 struct buffer *bp = XBUFFER (object);
5188 set_buffer_internal (bp); 5188 set_buffer_internal (bp);
5189 5189
5190 if (NILP (start)) 5190 b = !NILP (start) ? fix_position (start) : BEGV;
5191 b = BEGV; 5191 e = !NILP (end) ? fix_position (end) : ZV;
5192 else
5193 {
5194 CHECK_FIXNUM_COERCE_MARKER (start);
5195 b = XFIXNUM (start);
5196 }
5197
5198 if (NILP (end))
5199 e = ZV;
5200 else
5201 {
5202 CHECK_FIXNUM_COERCE_MARKER (end);
5203 e = XFIXNUM (end);
5204 }
5205
5206 if (b > e) 5192 if (b > e)
5207 { 5193 {
5208 EMACS_INT temp = b; 5194 EMACS_INT temp = b;
diff --git a/src/font.c b/src/font.c
index 2a456300619..0c9e752e089 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4606,10 +4606,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
4606 Lisp_Object window; 4606 Lisp_Object window;
4607 struct window *w; 4607 struct window *w;
4608 4608
4609 CHECK_FIXNUM_COERCE_MARKER (position); 4609 EMACS_INT fixed_pos = fix_position (position);
4610 if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) 4610 if (! (BEGV <= fixed_pos && fixed_pos < ZV))
4611 args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); 4611 args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
4612 pos = XFIXNUM (position); 4612 pos = fixed_pos;
4613 pos_byte = CHAR_TO_BYTE (pos); 4613 pos_byte = CHAR_TO_BYTE (pos);
4614 if (NILP (ch)) 4614 if (NILP (ch))
4615 c = FETCH_CHAR (pos_byte); 4615 c = FETCH_CHAR (pos_byte);
@@ -5013,24 +5013,26 @@ character at index specified by POSITION. */)
5013 (Lisp_Object position, Lisp_Object window, Lisp_Object string) 5013 (Lisp_Object position, Lisp_Object window, Lisp_Object string)
5014{ 5014{
5015 struct window *w = decode_live_window (window); 5015 struct window *w = decode_live_window (window);
5016 EMACS_INT pos;
5016 5017
5017 if (NILP (string)) 5018 if (NILP (string))
5018 { 5019 {
5019 if (XBUFFER (w->contents) != current_buffer) 5020 if (XBUFFER (w->contents) != current_buffer)
5020 error ("Specified window is not displaying the current buffer"); 5021 error ("Specified window is not displaying the current buffer");
5021 CHECK_FIXNUM_COERCE_MARKER (position); 5022 pos = fix_position (position);
5022 if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) 5023 if (! (BEGV <= pos && pos < ZV))
5023 args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); 5024 args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
5024 } 5025 }
5025 else 5026 else
5026 { 5027 {
5027 CHECK_FIXNUM (position); 5028 CHECK_FIXNUM (position);
5028 CHECK_STRING (string); 5029 CHECK_STRING (string);
5029 if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string))) 5030 pos = XFIXNUM (position);
5031 if (! (0 <= pos && pos < SCHARS (string)))
5030 args_out_of_range (string, position); 5032 args_out_of_range (string, position);
5031 } 5033 }
5032 5034
5033 return font_at (-1, XFIXNUM (position), NULL, w, string); 5035 return font_at (-1, pos, NULL, w, string);
5034} 5036}
5035 5037
5036#if 0 5038#if 0
diff --git a/src/fringe.c b/src/fringe.c
index 2a46e3c34f2..d8d80bb3fe9 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -1675,10 +1675,10 @@ Return nil if POS is not visible in WINDOW. */)
1675 1675
1676 if (!NILP (pos)) 1676 if (!NILP (pos))
1677 { 1677 {
1678 CHECK_FIXNUM_COERCE_MARKER (pos); 1678 EMACS_INT p = fix_position (pos);
1679 if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV)) 1679 if (! (BEGV <= p && p <= ZV))
1680 args_out_of_range (window, pos); 1680 args_out_of_range (window, pos);
1681 textpos = XFIXNUM (pos); 1681 textpos = p;
1682 } 1682 }
1683 else if (w == XWINDOW (selected_window)) 1683 else if (w == XWINDOW (selected_window))
1684 textpos = PT; 1684 textpos = PT;
diff --git a/src/lisp.h b/src/lisp.h
index f86b4880f35..2f719b1f03e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -585,7 +585,7 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
585 Lisp_Object); 585 Lisp_Object);
586 586
587/* Defined in bignum.c. */ 587/* Defined in bignum.c. */
588extern double bignum_to_double (Lisp_Object); 588extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST;
589extern Lisp_Object make_bigint (intmax_t); 589extern Lisp_Object make_bigint (intmax_t);
590extern Lisp_Object make_biguint (uintmax_t); 590extern Lisp_Object make_biguint (uintmax_t);
591 591
@@ -3023,14 +3023,6 @@ CHECK_FIXNAT (Lisp_Object x)
3023 CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ 3023 CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
3024 } while (false) 3024 } while (false)
3025 3025
3026#define CHECK_FIXNUM_COERCE_MARKER(x) \
3027 do { \
3028 if (MARKERP ((x))) \
3029 XSETFASTINT (x, marker_position (x)); \
3030 else \
3031 CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \
3032 } while (false)
3033
3034INLINE double 3026INLINE double
3035XFLOATINT (Lisp_Object n) 3027XFLOATINT (Lisp_Object n)
3036{ 3028{
@@ -3050,22 +3042,6 @@ CHECK_INTEGER (Lisp_Object x)
3050{ 3042{
3051 CHECK_TYPE (INTEGERP (x), Qnumberp, x); 3043 CHECK_TYPE (INTEGERP (x), Qnumberp, x);
3052} 3044}
3053
3054#define CHECK_NUMBER_COERCE_MARKER(x) \
3055 do { \
3056 if (MARKERP (x)) \
3057 XSETFASTINT (x, marker_position (x)); \
3058 else \
3059 CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \
3060 } while (false)
3061
3062#define CHECK_INTEGER_COERCE_MARKER(x) \
3063 do { \
3064 if (MARKERP (x)) \
3065 XSETFASTINT (x, marker_position (x)); \
3066 else \
3067 CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \
3068 } while (false)
3069 3045
3070 3046
3071/* If we're not dumping using the legacy dumper and we might be using 3047/* If we're not dumping using the legacy dumper and we might be using
@@ -3519,9 +3495,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
3519 3495
3520/* Defined in bignum.c. This part of bignum.c's API does not require 3496/* Defined in bignum.c. This part of bignum.c's API does not require
3521 the caller to access bignum internals; see bignum.h for that. */ 3497 the caller to access bignum internals; see bignum.h for that. */
3522extern intmax_t bignum_to_intmax (Lisp_Object); 3498extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST;
3523extern uintmax_t bignum_to_uintmax (Lisp_Object); 3499extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST;
3524extern ptrdiff_t bignum_bufsize (Lisp_Object, int); 3500extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST;
3525extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); 3501extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
3526extern Lisp_Object bignum_to_string (Lisp_Object, int); 3502extern Lisp_Object bignum_to_string (Lisp_Object, int);
3527extern Lisp_Object make_bignum_str (char const *, int); 3503extern Lisp_Object make_bignum_str (char const *, int);
diff --git a/src/module-env-28.h b/src/module-env-28.h
index a2479a8f744..5d884c148c4 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -9,3 +9,6 @@
9 void (*set_function_finalizer) (emacs_env *env, emacs_value arg, 9 void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
10 void (*fin) (void *) EMACS_NOEXCEPT) 10 void (*fin) (void *) EMACS_NOEXCEPT)
11 EMACS_ATTRIBUTE_NONNULL (1); 11 EMACS_ATTRIBUTE_NONNULL (1);
12
13 int (*open_channel) (emacs_env *env, emacs_value pipe_process)
14 EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/src/process.c b/src/process.c
index e4e5e57aeee..07881d6c5d3 100644
--- a/src/process.c
+++ b/src/process.c
@@ -8200,6 +8200,17 @@ restore_nofile_limit (void)
8200#endif 8200#endif
8201} 8201}
8202 8202
8203int
8204open_channel_for_module (Lisp_Object process)
8205{
8206 CHECK_PROCESS (process);
8207 CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
8208 int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
8209 if (fd == -1)
8210 report_file_error ("Cannot duplicate file descriptor", Qnil);
8211 return fd;
8212}
8213
8203 8214
8204/* This is not called "init_process" because that is the name of a 8215/* This is not called "init_process" because that is the name of a
8205 Mach system call, so it would cause problems on Darwin systems. */ 8216 Mach system call, so it would cause problems on Darwin systems. */
@@ -8446,6 +8457,7 @@ amounts of data in one go. */);
8446 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); 8457 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8447 8458
8448 DEFSYM (Qnull, "null"); 8459 DEFSYM (Qnull, "null");
8460 DEFSYM (Qpipe_process_p, "pipe-process-p");
8449 8461
8450 defsubr (&Sprocessp); 8462 defsubr (&Sprocessp);
8451 defsubr (&Sget_process); 8463 defsubr (&Sget_process);
diff --git a/src/process.h b/src/process.h
index 7884efc5494..a783a31cb86 100644
--- a/src/process.h
+++ b/src/process.h
@@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object);
300extern void update_processes_for_thread_death (Lisp_Object); 300extern void update_processes_for_thread_death (Lisp_Object);
301extern void dissociate_controlling_tty (void); 301extern void dissociate_controlling_tty (void);
302 302
303extern int open_channel_for_module (Lisp_Object);
304
303INLINE_HEADER_END 305INLINE_HEADER_END
304 306
305#endif /* EMACS_PROCESS_H */ 307#endif /* EMACS_PROCESS_H */
diff --git a/src/search.c b/src/search.c
index 818bb4af246..7389fbef0ee 100644
--- a/src/search.c
+++ b/src/search.c
@@ -1028,8 +1028,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
1028 } 1028 }
1029 else 1029 else
1030 { 1030 {
1031 CHECK_FIXNUM_COERCE_MARKER (bound); 1031 lim = fix_position (bound);
1032 lim = XFIXNUM (bound);
1033 if (n > 0 ? lim < PT : lim > PT) 1032 if (n > 0 ? lim < PT : lim > PT)
1034 error ("Invalid search bound (wrong side of point)"); 1033 error ("Invalid search bound (wrong side of point)");
1035 if (lim > ZV) 1034 if (lim > ZV)
diff --git a/src/textprop.c b/src/textprop.c
index ee048336ac0..960dba3f8dc 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
131{ 131{
132 INTERVAL i; 132 INTERVAL i;
133 ptrdiff_t searchpos; 133 ptrdiff_t searchpos;
134 Lisp_Object begin0 = *begin, end0 = *end;
134 135
135 CHECK_STRING_OR_BUFFER (object); 136 CHECK_STRING_OR_BUFFER (object);
136 CHECK_FIXNUM_COERCE_MARKER (*begin); 137 CHECK_FIXNUM_COERCE_MARKER (*begin);
@@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
155 156
156 if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) 157 if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
157 && XFIXNUM (*end) <= BUF_ZV (b))) 158 && XFIXNUM (*end) <= BUF_ZV (b)))
158 args_out_of_range (*begin, *end); 159 args_out_of_range (begin0, end0);
159 i = buffer_intervals (b); 160 i = buffer_intervals (b);
160 161
161 /* If there's no text, there are no properties. */ 162 /* If there's no text, there are no properties. */
@@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
170 171
171 if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) 172 if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
172 && XFIXNUM (*end) <= len)) 173 && XFIXNUM (*end) <= len))
173 args_out_of_range (*begin, *end); 174 args_out_of_range (begin0, end0);
174 i = string_intervals (object); 175 i = string_intervals (object);
175 176
176 if (len == 0) 177 if (len == 0)
@@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
611{ 612{
612 struct window *w = 0; 613 struct window *w = 0;
613 614
614 CHECK_FIXNUM_COERCE_MARKER (position); 615 EMACS_INT pos = fix_position (position);
615 616
616 if (NILP (object)) 617 if (NILP (object))
617 XSETBUFFER (object, current_buffer); 618 XSETBUFFER (object, current_buffer);
@@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
628 Lisp_Object *overlay_vec; 629 Lisp_Object *overlay_vec;
629 struct buffer *obuf = current_buffer; 630 struct buffer *obuf = current_buffer;
630 631
631 if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object)) 632 if (! (BUF_BEGV (XBUFFER (object)) <= pos
632 || XFIXNUM (position) > BUF_ZV (XBUFFER (object))) 633 && pos <= BUF_ZV (XBUFFER (object))))
633 xsignal1 (Qargs_out_of_range, position); 634 xsignal1 (Qargs_out_of_range, position);
634 635
635 set_buffer_temp (XBUFFER (object)); 636 set_buffer_temp (XBUFFER (object));
636 637
637 USE_SAFE_ALLOCA; 638 USE_SAFE_ALLOCA;
638 GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false); 639 GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
639 noverlays = sort_overlays (overlay_vec, noverlays, w); 640 noverlays = sort_overlays (overlay_vec, noverlays, w);
640 641
641 set_buffer_temp (obuf); 642 set_buffer_temp (obuf);
@@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
662 663
663 /* Not a buffer, or no appropriate overlay, so fall through to the 664 /* Not a buffer, or no appropriate overlay, so fall through to the
664 simpler case. */ 665 simpler case. */
665 return Fget_text_property (position, prop, object); 666 return Fget_text_property (make_fixnum (pos), prop, object);
666} 667}
667 668
668DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, 669DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
diff --git a/src/window.c b/src/window.c
index 8cdad27b664..075fd4e550c 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number
1895 if (EQ (pos, Qt)) 1895 if (EQ (pos, Qt))
1896 posint = -1; 1896 posint = -1;
1897 else if (!NILP (pos)) 1897 else if (!NILP (pos))
1898 { 1898 posint = fix_position (pos);
1899 CHECK_FIXNUM_COERCE_MARKER (pos);
1900 posint = XFIXNUM (pos);
1901 }
1902 else if (w == XWINDOW (selected_window)) 1899 else if (w == XWINDOW (selected_window))
1903 posint = PT; 1900 posint = PT;
1904 else 1901 else
diff --git a/src/xdisp.c b/src/xdisp.c
index 04fc8aa3c45..61c798c59e8 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -815,11 +815,6 @@ static struct props it_props[] =
815 {0, 0, NULL} 815 {0, 0, NULL}
816}; 816};
817 817
818/* Value is the position described by X. If X is a marker, value is
819 the marker_position of X. Otherwise, value is X. */
820
821#define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X))
822
823/* Enumeration returned by some move_it_.* functions internally. */ 818/* Enumeration returned by some move_it_.* functions internally. */
824 819
825enum move_it_result 820enum move_it_result
@@ -10418,10 +10413,7 @@ include the height of both, if present, in the return value. */)
10418 start = pos; 10413 start = pos;
10419 } 10414 }
10420 else 10415 else
10421 { 10416 start = clip_to_bounds (BEGV, fix_position (from), ZV);
10422 CHECK_FIXNUM_COERCE_MARKER (from);
10423 start = min (max (XFIXNUM (from), BEGV), ZV);
10424 }
10425 10417
10426 if (NILP (to)) 10418 if (NILP (to))
10427 end = ZV; 10419 end = ZV;
@@ -10435,10 +10427,7 @@ include the height of both, if present, in the return value. */)
10435 end = pos; 10427 end = pos;
10436 } 10428 }
10437 else 10429 else
10438 { 10430 end = clip_to_bounds (start, fix_position (to), ZV);
10439 CHECK_FIXNUM_COERCE_MARKER (to);
10440 end = max (start, min (XFIXNUM (to), ZV));
10441 }
10442 10431
10443 if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) 10432 if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX))
10444 max_x = XFIXNUM (x_limit); 10433 max_x = XFIXNUM (x_limit);
@@ -14944,7 +14933,7 @@ overlay_arrows_changed_p (bool set_redisplay)
14944 val = find_symbol_value (var); 14933 val = find_symbol_value (var);
14945 if (!MARKERP (val)) 14934 if (!MARKERP (val))
14946 continue; 14935 continue;
14947 if (! EQ (COERCE_MARKER (val), 14936 if (! EQ (Fmarker_position (val),
14948 /* FIXME: Don't we have a problem, using such a global 14937 /* FIXME: Don't we have a problem, using such a global
14949 * "last-position" if the variable is buffer-local? */ 14938 * "last-position" if the variable is buffer-local? */
14950 Fget (var, Qlast_arrow_position)) 14939 Fget (var, Qlast_arrow_position))
@@ -14987,8 +14976,7 @@ update_overlay_arrows (int up_to_date)
14987 Lisp_Object val = find_symbol_value (var); 14976 Lisp_Object val = find_symbol_value (var);
14988 if (!MARKERP (val)) 14977 if (!MARKERP (val))
14989 continue; 14978 continue;
14990 Fput (var, Qlast_arrow_position, 14979 Fput (var, Qlast_arrow_position, Fmarker_position (val));
14991 COERCE_MARKER (val));
14992 Fput (var, Qlast_arrow_string, 14980 Fput (var, Qlast_arrow_string,
14993 overlay_arrow_string_or_property (var)); 14981 overlay_arrow_string_or_property (var));
14994 } 14982 }
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index ec6948921f2..5e3112f4471 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -30,6 +30,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
30#include <string.h> 30#include <string.h>
31#include <time.h> 31#include <time.h>
32 32
33#ifdef WINDOWSNT
34/* Cannot include <process.h> because of the local header by the same
35 name, sigh. */
36uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *);
37# if !defined __x86_64__
38# define ALIGN_STACK __attribute__((force_align_arg_pointer))
39# endif
40# include <windows.h> /* for Sleep */
41#else /* !WINDOWSNT */
42# include <pthread.h>
43# include <unistd.h>
44#endif
45
33#ifdef HAVE_GMP 46#ifdef HAVE_GMP
34#include <gmp.h> 47#include <gmp.h>
35#else 48#else
@@ -299,7 +312,7 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
299} 312}
300 313
301/* An invalid finalizer: Finalizers are run during garbage collection, 314/* An invalid finalizer: Finalizers are run during garbage collection,
302 where Lisp code cant be executed. -module-assertions tests for 315 where Lisp code can't be executed. -module-assertions tests for
303 this case. */ 316 this case. */
304 317
305static emacs_env *current_env; 318static emacs_env *current_env;
@@ -320,9 +333,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
320} 333}
321 334
322static void 335static void
323signal_errno (emacs_env *env, const char *function) 336signal_system_error (emacs_env *env, int error, const char *function)
324{ 337{
325 const char *message = strerror (errno); 338 const char *message = strerror (error);
326 emacs_value message_value = env->make_string (env, message, strlen (message)); 339 emacs_value message_value = env->make_string (env, message, strlen (message));
327 emacs_value symbol = env->intern (env, "file-error"); 340 emacs_value symbol = env->intern (env, "file-error");
328 emacs_value elements[2] 341 emacs_value elements[2]
@@ -331,6 +344,12 @@ signal_errno (emacs_env *env, const char *function)
331 env->non_local_exit_signal (env, symbol, data); 344 env->non_local_exit_signal (env, symbol, data);
332} 345}
333 346
347static void
348signal_errno (emacs_env *env, const char *function)
349{
350 signal_system_error (env, errno, function);
351}
352
334/* A long-running operation that occasionally calls `should_quit' or 353/* A long-running operation that occasionally calls `should_quit' or
335 `process_input'. */ 354 `process_input'. */
336 355
@@ -533,6 +552,73 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
533 return env->funcall (env, Flist, 2, list_args); 552 return env->funcall (env, Flist, 2, list_args);
534} 553}
535 554
555static void
556sleep_for_half_second (void)
557{
558 /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */
559#ifdef WINDOWSNT
560 Sleep (500);
561#else
562 const struct timespec sleep = {0, 500000000};
563 if (nanosleep (&sleep, NULL) != 0)
564 perror ("nanosleep");
565#endif
566}
567
568#ifdef WINDOWSNT
569static void ALIGN_STACK
570#else
571static void *
572#endif
573write_to_pipe (void *arg)
574{
575 /* We sleep a bit to test that writing to a pipe is indeed possible
576 if no environment is active. */
577 sleep_for_half_second ();
578 FILE *stream = arg;
579 /* The string below should be identical to the one we compare with
580 in emacs-module-tests.el:module/async-pipe. */
581 if (fputs ("data from thread", stream) < 0)
582 perror ("fputs");
583 if (fclose (stream) != 0)
584 perror ("close");
585#ifndef WINDOWSNT
586 return NULL;
587#endif
588}
589
590static emacs_value
591Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
592 void *data)
593{
594 assert (nargs == 1);
595 int fd = env->open_channel (env, args[0]);
596 if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
597 return NULL;
598 FILE *stream = fdopen (fd, "w");
599 if (stream == NULL)
600 {
601 signal_errno (env, "fdopen");
602 return NULL;
603 }
604#ifdef WINDOWSNT
605 uintptr_t thd = _beginthread (write_to_pipe, 0, stream);
606 int error = (thd == (uintptr_t)-1L) ? errno : 0;
607#else /* !WINDOWSNT */
608 pthread_t thread;
609 int error
610 = pthread_create (&thread, NULL, write_to_pipe, stream);
611#endif
612 if (error != 0)
613 {
614 signal_system_error (env, error, "thread create");
615 if (fclose (stream) != 0)
616 perror ("fclose");
617 return NULL;
618 }
619 return env->intern (env, "nil");
620}
621
536/* Lisp utilities for easier readability (simple wrappers). */ 622/* Lisp utilities for easier readability (simple wrappers). */
537 623
538/* Provide FEATURE to Emacs. */ 624/* Provide FEATURE to Emacs. */
@@ -614,6 +700,7 @@ emacs_module_init (struct emacs_runtime *ert)
614 Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); 700 Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
615 DEFUN ("mod-test-function-finalizer-calls", 701 DEFUN ("mod-test-function-finalizer-calls",
616 Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); 702 Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
703 DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
617 704
618#undef DEFUN 705#undef DEFUN
619 706
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
index e66b5c6803d..66098fa0116 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -67,6 +67,6 @@
67 (gravatar-force-default nil) 67 (gravatar-force-default nil)
68 (gravatar-size nil)) 68 (gravatar-size nil))
69 (should (equal (gravatar-build-url "foo") "\ 69 (should (equal (gravatar-build-url "foo") "\
70https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g")))) 70https://seccdn.libravatar.org/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
71 71
72;;; gravatar-tests.el ends here 72;;; gravatar-tests.el ends here
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 48d2e86a605..6851b890451 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -424,4 +424,21 @@ See Bug#36226."
424 ;; but at least one. 424 ;; but at least one.
425 (should (> valid-after valid-before))))) 425 (should (> valid-after valid-before)))))
426 426
427(ert-deftest module/async-pipe ()
428 "Check that writing data from another thread works."
429 (skip-unless (not (eq system-type 'windows-nt))) ; FIXME!
430 (with-temp-buffer
431 (let ((process (make-pipe-process :name "module/async-pipe"
432 :buffer (current-buffer)
433 :coding 'utf-8-unix
434 :noquery t)))
435 (unwind-protect
436 (progn
437 (mod-test-async-pipe process)
438 (should (accept-process-output process 1))
439 ;; The string below must be identical to what
440 ;; mod-test.c:write_to_pipe produces.
441 (should (equal (buffer-string) "data from thread")))
442 (delete-process process)))))
443
427;;; emacs-module-tests.el ends here 444;;; emacs-module-tests.el ends here