Merge remote-tracking branch 'savannah/master' into HEAD
This commit is contained in:
commit
00ee320a62
66 changed files with 1121 additions and 885 deletions
|
@ -31,10 +31,10 @@ GNULIB_MODULES='
|
|||
careadlinkat close-stream copy-file-range
|
||||
count-leading-zeros count-one-bits count-trailing-zeros
|
||||
crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer
|
||||
d-type diffseq dosname double-slash-root dtoastr dtotimespec dup2
|
||||
d-type diffseq double-slash-root dtoastr dtotimespec dup2
|
||||
environ execinfo explicit_bzero faccessat
|
||||
fchmodat fcntl fcntl-h fdopendir
|
||||
filemode filevercmp flexmember fpieee fstatat fsusage fsync futimens
|
||||
filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens
|
||||
getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog
|
||||
ieee754-h ignore-value intprops largefile lstat
|
||||
manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime
|
||||
|
|
|
@ -975,9 +975,27 @@ displays the following frame layout:
|
|||
@end group
|
||||
@end smallexample
|
||||
|
||||
@findex gdb-save-window-configuration
|
||||
@findex gdb-load-window-configuration
|
||||
@vindex gdb-default-window-configuration-file
|
||||
@vindex gdb-window-configuration-directory
|
||||
You can customize the window layout based on the one above and save
|
||||
that layout to a file using @code{gdb-save-window-configuration}.
|
||||
Then you can later load this layout back using
|
||||
@code{gdb-load-window-configuration}. (Internally, Emacs uses the
|
||||
term window configuration instead of window layout.) You can set your
|
||||
custom layout as the default one used by @code{gdb-many-windows} by
|
||||
customizing @code{gdb-default-window-configuration-file}. If it is
|
||||
not an absolute file name, GDB looks under
|
||||
@code{gdb-window-configuration-directory} for the file.
|
||||
@code{gdb-window-configuration-directory} defaults to
|
||||
@code{user-emacs-directory} (@pxref{Find Init}).
|
||||
|
||||
|
||||
@findex gdb-restore-windows
|
||||
@findex gdb-many-windows
|
||||
If you ever change the window layout, you can restore the many-windows
|
||||
@vindex gdb-restore-window-configuration-after-quit
|
||||
If you ever change the window layout, you can restore the default
|
||||
layout by typing @kbd{M-x gdb-restore-windows}. To toggle
|
||||
between the many windows layout and a simple layout with just the GUD
|
||||
interaction 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}.
|
|||
of windows on your original frame will not be affected. A separate
|
||||
frame for GDB sessions can come in especially handy if you work on a
|
||||
text-mode terminal, where the screen estate for windows could be at a
|
||||
premium.
|
||||
premium. If you choose to start GDB in the same frame, consider
|
||||
setting @code{gdb-restore-window-configuration-after-quit} to a
|
||||
non-@code{nil} value. Your original layout will then be restored
|
||||
after GDB quits. Use @code{t} to always restore; use
|
||||
@code{if-gdb-many-windows} to restore only when
|
||||
@code{gdb-many-windows} is non-@code{nil}; use @code{if-gdb-show-main}
|
||||
to restore only when @code{gdb-show-main} is non-@code{nil}.
|
||||
|
||||
You may also specify additional GDB-related buffers to display,
|
||||
either in the same frame or a different one. Select the buffers you
|
||||
|
|
|
@ -2022,6 +2022,20 @@ variable values and buffer content may have been modified in arbitrary
|
|||
ways.
|
||||
@end deftypefn
|
||||
|
||||
@anchor{open_channel}
|
||||
@deftypefun int open_channel (emacs_env *@var{env}, emacs_value @var{pipe_process})
|
||||
This function, which is available since Emacs 28, opens a channel to
|
||||
an existing pipe process. @var{pipe_process} must refer to an
|
||||
existing pipe process created by @code{make-pipe-process}. @ref{Pipe
|
||||
Processes}. If successful, the return value will be a new file
|
||||
descriptor that you can use to write to the pipe. Unlike all other
|
||||
module functions, you can use the returned file descriptor from
|
||||
arbitrary threads, even if no module environment is active. You can
|
||||
use the @code{write} function to write to the file descriptor. Once
|
||||
done, close the file descriptor using @code{close}. @ref{Low-Level
|
||||
I/O,,,libc}.
|
||||
@end deftypefun
|
||||
|
||||
@node Module Nonlocal
|
||||
@subsection Nonlocal Exits in Modules
|
||||
@cindex nonlocal exits, in modules
|
||||
|
|
|
@ -743,6 +743,7 @@ Some file name handlers may not support @code{make-process}. In such
|
|||
cases, this function does nothing and returns @code{nil}.
|
||||
@end defun
|
||||
|
||||
@anchor{Pipe Processes}
|
||||
@defun make-pipe-process &rest args
|
||||
This function creates a bidirectional pipe which can be attached to a
|
||||
child process. This is useful with the @code{:stderr} keyword of
|
||||
|
|
77
etc/NEWS
77
etc/NEWS
|
@ -38,7 +38,7 @@ when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz
|
|||
text shaping support, and 'ftcr' otherwise. You can determine this by
|
||||
checking 'system-configuration-features'. The 'ftcr' backend will
|
||||
still be available when HarfBuzz is supported, but will not be used by
|
||||
default. We strongly recommend building with HarBuzz support. 'x' is
|
||||
default. We strongly recommend building with HarBuzz support. 'x' is
|
||||
still a valid backend.
|
||||
|
||||
---
|
||||
|
@ -64,9 +64,9 @@ It was declared obsolete in Emacs 27.1.
|
|||
|
||||
* Changes in Emacs 28.1
|
||||
|
||||
** Support for '(box . SIZE)' cursor-type.
|
||||
** Support for '(box . SIZE)' 'cursor-type'.
|
||||
By default, 'box' cursor always has a filled box shape. But if you
|
||||
specify cursor-type to be '(box . SIZE)', the cursor becomes a hollow
|
||||
specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow
|
||||
box if the point is on an image larger than 'SIZE' pixels in any
|
||||
dimension.
|
||||
|
||||
|
@ -97,24 +97,33 @@ shows equivalent key bindings for all commands that have them.
|
|||
* Changes in Specialized Modes and Packages in Emacs 28.1
|
||||
|
||||
** Emacs-Lisp mode
|
||||
|
||||
*** The mode-line now indicates whether we're using lexical or dynamic scoping.
|
||||
|
||||
** Dired
|
||||
|
||||
*** New option 'dired-mark-region' affects all Dired commands that mark files.
|
||||
When non-nil and the region is active in Transient Mark mode,
|
||||
then Dired commands operate only on files in the active region.
|
||||
The values 'exclusive' and 'inclusive' of this option define
|
||||
the details of marking the last file at the end of the region.
|
||||
*** New user option 'dired-mark-region' affects all Dired commands
|
||||
that mark files. When non-nil and the region is active in Transient
|
||||
Mark mode, then Dired commands operate only on files in the active
|
||||
region. The values 'file' and 'line' of this user option define the
|
||||
details of marking the file at the end of the region.
|
||||
|
||||
*** State changing VC operations are supported in dired-mode on files
|
||||
*** State changing VC operations are supported in 'dired-mode' on files
|
||||
(but still not on directories).
|
||||
|
||||
** Change Logs and VC
|
||||
|
||||
*** New command 'vc-dir-root' uses the root directory without asking.
|
||||
|
||||
** Gnus
|
||||
|
||||
---
|
||||
*** Change to default value of 'message-draft-headers' option.
|
||||
No longer includes the Date header.
|
||||
*** Change to default value of 'message-draft-headers' user option.
|
||||
The 'Date' symbol has been removed from the default value, meaning that
|
||||
draft or delayed messages will get a date reflecting when the message
|
||||
was sent. To restore the original behavior of dating a message
|
||||
from when it is first saved or delayed, add the symbol 'Date' back to
|
||||
this user option.
|
||||
|
||||
** Help
|
||||
|
||||
|
@ -148,8 +157,8 @@ doc string functions. This makes the results of all doc string
|
|||
functions accessible to the user through the existing single function hook
|
||||
'eldoc-documentation-function'.
|
||||
|
||||
*** 'eldoc-documentation-function' is now a custom variable.
|
||||
Modes should use the new hook instead of this variable to register
|
||||
*** 'eldoc-documentation-function' is now a user option.
|
||||
Modes should use the new hook instead of this user option to register
|
||||
their backends.
|
||||
|
||||
** Tramp
|
||||
|
@ -171,6 +180,7 @@ effect.
|
|||
*** Pcase 'map' pattern added keyword symbols abbreviation.
|
||||
A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
|
||||
equivalent to '(map (:sym sym))'.
|
||||
|
||||
** Package
|
||||
|
||||
+++
|
||||
|
@ -186,17 +196,48 @@ key binding
|
|||
/ v package-menu-filter-by-version
|
||||
/ / package-menu-filter-clear
|
||||
|
||||
** gdb-mi
|
||||
|
||||
+++
|
||||
*** gdb-mi can now store and restore window configurations.
|
||||
Use 'gdb-save-window-configuration' to save window configuration to a
|
||||
file and 'gdb-load-window-configuration' to load from a file. These
|
||||
commands can also be accessed through the menu bar under 'Gud --
|
||||
GDB-Windows'. 'gdb-default-window-configuration-file', when non-nil,
|
||||
is loaded when GDB starts up.
|
||||
|
||||
+++
|
||||
*** gdb-mi can now restore window configuration after quit.
|
||||
Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs
|
||||
will remember the window configuration before GDB started and restore
|
||||
it after GDB quits. A toggle button is also provided under 'Gud --
|
||||
GDB-Windows'.
|
||||
|
||||
** Gravatar
|
||||
|
||||
---
|
||||
*** New user option 'gravatar-service' for host to query for gravatars.
|
||||
Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
|
||||
|
||||
** Compilation mode
|
||||
|
||||
*** Regexp matching of messages is now case-sensitive by default.
|
||||
The variable 'compilation-error-case-fold-search' can be set for
|
||||
case-insensitive matching of messages when the old behaviour is
|
||||
required, but the recommended solution is to use a correctly matching
|
||||
regexp instead.
|
||||
|
||||
|
||||
* New Modes and Packages in Emacs 28.1
|
||||
|
||||
|
||||
* Incompatible Editing Changes in Emacs 28.1
|
||||
|
||||
** In nroff mode, 'center-line' is now bound to 'M-o M-s'.
|
||||
** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'.
|
||||
The original key binding was 'M-s', which interfered with I-search,
|
||||
since the latter uses 'M-s' as a prefix key of the search prefix map.
|
||||
|
||||
** vc-print-branch-log shows the change log for BRANCH from its root
|
||||
** 'vc-print-branch-log' shows the change log for BRANCH from its root
|
||||
directory instead of the default directory.
|
||||
|
||||
|
||||
|
@ -228,7 +269,7 @@ This is no longer supported, and setting this variable has no effect.
|
|||
|
||||
* Lisp Changes in Emacs 28.1
|
||||
|
||||
** New macro 'dlet' to dynamically bind variables
|
||||
** New macro 'dlet' to dynamically bind variables.
|
||||
|
||||
** The variable 'force-new-style-backquotes' has been removed.
|
||||
This removes the final remaining trace of old-style backquotes.
|
||||
|
@ -242,6 +283,10 @@ called when the function object is garbage-collected. Use
|
|||
'set_function_finalizer' to set the finalizer and
|
||||
'get_function_finalizer' to retrieve it.
|
||||
|
||||
** Modules can now open a channel to an existing pipe process using
|
||||
the new module function 'open_channel'. Modules can use this
|
||||
functionality to asynchronously send data back to Emacs.
|
||||
|
||||
** 'file-modes', 'set-file-modes', and 'set-file-times' now have an
|
||||
optional argument specifying whether to follow symbolic links.
|
||||
|
||||
|
|
|
@ -80,7 +80,7 @@ char *w32_getenv (const char *);
|
|||
#include <sys/stat.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include <dosname.h>
|
||||
#include <filename.h>
|
||||
#include <intprops.h>
|
||||
#include <min-max.h>
|
||||
#include <pathmax.h>
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
|
||||
/* written by Jim Meyering */
|
||||
|
||||
#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
|
||||
#include "filename.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */
|
||||
|
||||
#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD
|
||||
# include <errno.h>
|
||||
|
|
|
@ -51,7 +51,7 @@
|
|||
# define __realpath realpath
|
||||
# include "pathmax.h"
|
||||
# include "malloca.h"
|
||||
# include "dosname.h"
|
||||
# include "filename.h"
|
||||
# if HAVE_GETCWD
|
||||
# if IN_RELOCWRAPPER
|
||||
/* When building the relocatable program wrapper, use the system's getcwd
|
||||
|
|
|
@ -1,52 +0,0 @@
|
|||
/* File names on MS-DOS/Windows systems.
|
||||
|
||||
Copyright (C) 2000-2001, 2004-2006, 2009-2020 Free Software Foundation, Inc.
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
From Paul Eggert and Jim Meyering. */
|
||||
|
||||
#ifndef _DOSNAME_H
|
||||
#define _DOSNAME_H
|
||||
|
||||
#if (defined _WIN32 || defined __CYGWIN__ \
|
||||
|| defined __EMX__ || defined __MSDOS__ || defined __DJGPP__)
|
||||
/* This internal macro assumes ASCII, but all hosts that support drive
|
||||
letters use ASCII. */
|
||||
# define _IS_DRIVE_LETTER(C) (((unsigned int) (C) | ('a' - 'A')) - 'a' \
|
||||
<= 'z' - 'a')
|
||||
# define FILE_SYSTEM_PREFIX_LEN(Filename) \
|
||||
(_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':' ? 2 : 0)
|
||||
# ifndef __CYGWIN__
|
||||
# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1
|
||||
# endif
|
||||
# define ISSLASH(C) ((C) == '/' || (C) == '\\')
|
||||
#else
|
||||
# define FILE_SYSTEM_PREFIX_LEN(Filename) 0
|
||||
# define ISSLASH(C) ((C) == '/')
|
||||
#endif
|
||||
|
||||
#ifndef FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
|
||||
# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
|
||||
#endif
|
||||
|
||||
#if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
|
||||
# define IS_ABSOLUTE_FILE_NAME(F) ISSLASH ((F)[FILE_SYSTEM_PREFIX_LEN (F)])
|
||||
# else
|
||||
# define IS_ABSOLUTE_FILE_NAME(F) \
|
||||
(ISSLASH ((F)[0]) || FILE_SYSTEM_PREFIX_LEN (F) != 0)
|
||||
#endif
|
||||
#define IS_RELATIVE_FILE_NAME(F) (! IS_ABSOLUTE_FILE_NAME (F))
|
||||
|
||||
#endif /* DOSNAME_H_ */
|
110
lib/filename.h
Normal file
110
lib/filename.h
Normal file
|
@ -0,0 +1,110 @@
|
|||
/* Basic filename support macros.
|
||||
Copyright (C) 2001-2004, 2007-2020 Free Software Foundation, Inc.
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>. */
|
||||
|
||||
/* From Paul Eggert and Jim Meyering. */
|
||||
|
||||
#ifndef _FILENAME_H
|
||||
#define _FILENAME_H
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
|
||||
/* Filename support.
|
||||
ISSLASH(C) tests whether C is a directory separator
|
||||
character.
|
||||
HAS_DEVICE(Filename) tests whether Filename contains a device
|
||||
specification.
|
||||
FILE_SYSTEM_PREFIX_LEN(Filename) length of the device specification
|
||||
at the beginning of Filename,
|
||||
index of the part consisting of
|
||||
alternating components and slashes.
|
||||
FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
|
||||
1 when a non-empty device specification
|
||||
can be followed by an empty or relative
|
||||
part,
|
||||
0 when a non-empty device specification
|
||||
must be followed by a slash,
|
||||
0 when device specification don't exist.
|
||||
IS_ABSOLUTE_FILE_NAME(Filename)
|
||||
tests whether Filename is independent of
|
||||
any notion of "current directory".
|
||||
IS_RELATIVE_FILE_NAME(Filename)
|
||||
tests whether Filename may be concatenated
|
||||
to a directory filename.
|
||||
Note: On native Windows, OS/2, DOS, "c:" is neither an absolute nor a
|
||||
relative file name!
|
||||
IS_FILE_NAME_WITH_DIR(Filename) tests whether Filename contains a device
|
||||
or directory specification.
|
||||
*/
|
||||
#if defined _WIN32 || defined __CYGWIN__ \
|
||||
|| defined __EMX__ || defined __MSDOS__ || defined __DJGPP__
|
||||
/* Native Windows, Cygwin, OS/2, DOS */
|
||||
# define ISSLASH(C) ((C) == '/' || (C) == '\\')
|
||||
/* Internal macro: Tests whether a character is a drive letter. */
|
||||
# define _IS_DRIVE_LETTER(C) \
|
||||
(((C) >= 'A' && (C) <= 'Z') || ((C) >= 'a' && (C) <= 'z'))
|
||||
/* Help the compiler optimizing it. This assumes ASCII. */
|
||||
# undef _IS_DRIVE_LETTER
|
||||
# define _IS_DRIVE_LETTER(C) \
|
||||
(((unsigned int) (C) | ('a' - 'A')) - 'a' <= 'z' - 'a')
|
||||
# define HAS_DEVICE(Filename) \
|
||||
(_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':')
|
||||
# define FILE_SYSTEM_PREFIX_LEN(Filename) (HAS_DEVICE (Filename) ? 2 : 0)
|
||||
# ifdef __CYGWIN__
|
||||
# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
|
||||
# else
|
||||
/* On native Windows, OS/2, DOS, the system has the notion of a
|
||||
"current directory" on each drive. */
|
||||
# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1
|
||||
# endif
|
||||
# if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
|
||||
# define IS_ABSOLUTE_FILE_NAME(Filename) \
|
||||
ISSLASH ((Filename)[FILE_SYSTEM_PREFIX_LEN (Filename)])
|
||||
# else
|
||||
# define IS_ABSOLUTE_FILE_NAME(Filename) \
|
||||
(ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename))
|
||||
# endif
|
||||
# define IS_RELATIVE_FILE_NAME(Filename) \
|
||||
(! (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename)))
|
||||
# define IS_FILE_NAME_WITH_DIR(Filename) \
|
||||
(strchr ((Filename), '/') != NULL || strchr ((Filename), '\\') != NULL \
|
||||
|| HAS_DEVICE (Filename))
|
||||
#else
|
||||
/* Unix */
|
||||
# define ISSLASH(C) ((C) == '/')
|
||||
# define HAS_DEVICE(Filename) ((void) (Filename), 0)
|
||||
# define FILE_SYSTEM_PREFIX_LEN(Filename) ((void) (Filename), 0)
|
||||
# define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0
|
||||
# define IS_ABSOLUTE_FILE_NAME(Filename) ISSLASH ((Filename)[0])
|
||||
# define IS_RELATIVE_FILE_NAME(Filename) (! ISSLASH ((Filename)[0]))
|
||||
# define IS_FILE_NAME_WITH_DIR(Filename) (strchr ((Filename), '/') != NULL)
|
||||
#endif
|
||||
|
||||
/* Deprecated macros. For backward compatibility with old users of the
|
||||
'filename' module. */
|
||||
#define IS_ABSOLUTE_PATH IS_ABSOLUTE_FILE_NAME
|
||||
#define IS_PATH_WITH_DIR IS_FILE_NAME_WITH_DIR
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif /* _FILENAME_H */
|
|
@ -48,6 +48,14 @@
|
|||
# define optind __GETOPT_ID (optind)
|
||||
# define optopt __GETOPT_ID (optopt)
|
||||
|
||||
/* Work around a a problem on macOS, which declares getopt with a
|
||||
trailing __DARWIN_ALIAS(getopt) that would expand to something like
|
||||
__asm("_" "rpl_getopt" "$UNIX2003") were it not for the following
|
||||
hack to suppress the macOS declaration <https://bugs.gnu.org/40205>. */
|
||||
# ifdef __APPLE__
|
||||
# define _GETOPT
|
||||
# endif
|
||||
|
||||
/* The system's getopt.h may have already included getopt-core.h to
|
||||
declare the unprefixed identifiers. Undef _GETOPT_CORE_H so that
|
||||
getopt-core.h declares them with prefixes. */
|
||||
|
|
|
@ -86,7 +86,6 @@
|
|||
# crypto/sha512-buffer \
|
||||
# d-type \
|
||||
# diffseq \
|
||||
# dosname \
|
||||
# double-slash-root \
|
||||
# dtoastr \
|
||||
# dtotimespec \
|
||||
|
@ -100,6 +99,7 @@
|
|||
# fcntl-h \
|
||||
# fdopendir \
|
||||
# filemode \
|
||||
# filename \
|
||||
# filevercmp \
|
||||
# flexmember \
|
||||
# fpieee \
|
||||
|
@ -1452,15 +1452,6 @@ EXTRA_libgnu_a_SOURCES += dirfd.c
|
|||
endif
|
||||
## end gnulib module dirfd
|
||||
|
||||
## begin gnulib module dosname
|
||||
ifeq (,$(OMIT_GNULIB_MODULE_dosname))
|
||||
|
||||
|
||||
EXTRA_DIST += dosname.h
|
||||
|
||||
endif
|
||||
## end gnulib module dosname
|
||||
|
||||
## begin gnulib module dtoastr
|
||||
ifeq (,$(OMIT_GNULIB_MODULE_dtoastr))
|
||||
|
||||
|
@ -1672,6 +1663,15 @@ EXTRA_DIST += filemode.h
|
|||
endif
|
||||
## end gnulib module filemode
|
||||
|
||||
## begin gnulib module filename
|
||||
ifeq (,$(OMIT_GNULIB_MODULE_filename))
|
||||
|
||||
|
||||
EXTRA_DIST += filename.h
|
||||
|
||||
endif
|
||||
## end gnulib module filename
|
||||
|
||||
## begin gnulib module filevercmp
|
||||
ifeq (,$(OMIT_GNULIB_MODULE_filevercmp))
|
||||
|
||||
|
|
|
@ -370,11 +370,7 @@ from which to start."
|
|||
(setq i (1+ i)))
|
||||
(when (> spaces 0)
|
||||
(push (char-fold--make-space-string spaces) out))
|
||||
(let ((regexp (apply #'concat (nreverse out))))
|
||||
;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'.
|
||||
(if (> (length regexp) 5000)
|
||||
(regexp-quote string)
|
||||
regexp))))
|
||||
(apply #'concat (nreverse out))))
|
||||
|
||||
|
||||
;;; Commands provided for completeness.
|
||||
|
|
|
@ -296,7 +296,7 @@ new Dired buffers."
|
|||
:version "26.1"
|
||||
:group 'dired)
|
||||
|
||||
(defcustom dired-mark-region 'exclusive
|
||||
(defcustom dired-mark-region 'file
|
||||
"Defines what commands that mark files do with the active region.
|
||||
|
||||
When 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
|
|||
that mark or unmark files will operate on all files in the region
|
||||
if the region is active in Transient Mark mode.
|
||||
|
||||
When `exclusive', don't mark the file if the end of the region is
|
||||
When `file', the region marking is based on the file name.
|
||||
This means don't mark the file if the end of the region is
|
||||
before the file name displayed on the Dired line, so the file name
|
||||
is visually outside the region. This behavior is consistent with
|
||||
marking 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
|
|||
used to select the region, e.g. `M-2 m' marks 2 files, and
|
||||
`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files.
|
||||
|
||||
When `inclusive', include the file into marking if the end of the region
|
||||
When `line', the region marking is based on Dired lines,
|
||||
so include the file into marking if the end of the region
|
||||
is anywhere on its Dired line, except the beginning of the line."
|
||||
:type '(choice
|
||||
(const :tag "Don't mark files in active region" nil)
|
||||
(const :tag "Exclude file name outside of region" exclusive)
|
||||
(const :tag "Include the file at region end line" inclusive))
|
||||
(const :tag "Exclude file name outside of region" file)
|
||||
(const :tag "Include the file at region end line" line))
|
||||
:group 'dired
|
||||
:version "28.1")
|
||||
|
||||
|
@ -646,16 +648,19 @@ of the region if `dired-mark-region' is non-nil. Otherwise, operate
|
|||
on the whole buffer.
|
||||
|
||||
Return value is the number of files marked, or nil if none were marked."
|
||||
`(let ((inhibit-read-only t) count
|
||||
(beg (if (and dired-mark-region (use-region-p))
|
||||
`(let* ((inhibit-read-only t) count
|
||||
(use-region-p (and dired-mark-region
|
||||
(region-active-p)
|
||||
(> (region-end) (region-beginning))))
|
||||
(beg (if use-region-p
|
||||
(save-excursion
|
||||
(goto-char (region-beginning))
|
||||
(line-beginning-position))
|
||||
(point-min)))
|
||||
(end (if (and dired-mark-region (use-region-p))
|
||||
(end (if use-region-p
|
||||
(save-excursion
|
||||
(goto-char (region-end))
|
||||
(if (if (eq dired-mark-region 'inclusive)
|
||||
(if (if (eq dired-mark-region 'line)
|
||||
(not (bolp))
|
||||
(get-text-property (1- (point)) 'dired-filename))
|
||||
(line-end-position)
|
||||
|
@ -673,7 +678,7 @@ Return value is the number of files marked, or nil if none were marked."
|
|||
(if (eq dired-del-marker dired-marker-char)
|
||||
" for deletion"
|
||||
"")
|
||||
(if (and dired-mark-region (use-region-p))
|
||||
(if use-region-p
|
||||
" in region"
|
||||
"")))
|
||||
(goto-char beg)
|
||||
|
@ -691,7 +696,7 @@ Return value is the number of files marked, or nil if none were marked."
|
|||
(if (eq dired-marker-char ?\s) "un" "")
|
||||
(if (eq dired-marker-char dired-del-marker)
|
||||
"flagged" "marked")
|
||||
(if (and dired-mark-region (use-region-p))
|
||||
(if use-region-p
|
||||
" in region"
|
||||
""))))
|
||||
(and (> count 0) count)))
|
||||
|
@ -3645,14 +3650,16 @@ this subdir."
|
|||
(interactive (list current-prefix-arg t))
|
||||
(cond
|
||||
;; Mark files in the active region.
|
||||
((and dired-mark-region interactive (use-region-p))
|
||||
((and interactive dired-mark-region
|
||||
(region-active-p)
|
||||
(> (region-end) (region-beginning)))
|
||||
(save-excursion
|
||||
(let ((beg (region-beginning))
|
||||
(end (region-end)))
|
||||
(dired-mark-files-in-region
|
||||
(progn (goto-char beg) (line-beginning-position))
|
||||
(progn (goto-char end)
|
||||
(if (if (eq dired-mark-region 'inclusive)
|
||||
(if (if (eq dired-mark-region 'line)
|
||||
(not (bolp))
|
||||
(get-text-property (1- (point)) 'dired-filename))
|
||||
(line-end-position)
|
||||
|
|
|
@ -2868,7 +2868,9 @@ Supported keywords for slots are:
|
|||
(append pred-form '(t))
|
||||
`(and ,pred-form t)))
|
||||
forms)
|
||||
(push `(put ',name 'cl-deftype-satisfies ',predicate) forms))
|
||||
(push `(eval-and-compile
|
||||
(put ',name 'cl-deftype-satisfies ',predicate))
|
||||
forms))
|
||||
(let ((pos 0) (descp descs))
|
||||
(while descp
|
||||
(let* ((desc (pop descp))
|
||||
|
@ -3138,6 +3140,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
|
|||
;; "Obvious" mappings.
|
||||
(string . stringp)
|
||||
(list . listp)
|
||||
(cons . consp)
|
||||
(symbol . symbolp)
|
||||
(function . functionp)
|
||||
(integer . integerp)
|
||||
|
|
|
@ -52,7 +52,7 @@
|
|||
(let ((repeat (aref timer 4)))
|
||||
(cond
|
||||
((numberp repeat)
|
||||
(format "%.2f" (/ repeat 60)))
|
||||
(format "%.1f" repeat))
|
||||
((null repeat)
|
||||
"-")
|
||||
(t
|
||||
|
@ -91,7 +91,18 @@
|
|||
(setq header-line-format
|
||||
(concat (propertize " " 'display '(space :align-to 0))
|
||||
(format "%4s %10s %8s %s"
|
||||
"Idle" "Next" "Repeat" "Function"))))
|
||||
(propertize "Idle"
|
||||
'mouse-face 'highlight
|
||||
'help-echo "* marks idle timers")
|
||||
(propertize "Next"
|
||||
'mouse-face 'highlight
|
||||
'help-echo "Time in sec till next invocation")
|
||||
(propertize "Repeat"
|
||||
'mouse-face 'highlight
|
||||
'help-echo "Symbol: repeat; number: repeat interval in sec")
|
||||
(propertize "Function"
|
||||
'mouse-face 'highlight
|
||||
'help-echo "Function called by timer")))))
|
||||
|
||||
(defun timer-list-cancel ()
|
||||
"Cancel the timer on the line under point."
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
;;; gnus-registry.el --- article registry for Gnus
|
||||
;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
@ -62,10 +62,10 @@
|
|||
|
||||
;; show the marks as single characters (see the :char property in
|
||||
;; `gnus-registry-marks'):
|
||||
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
|
||||
;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
|
||||
|
||||
;; show the marks by name (see `gnus-registry-marks'):
|
||||
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
|
||||
;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
|
||||
|
||||
;; TODO:
|
||||
|
||||
|
@ -588,7 +588,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
|
|||
subject
|
||||
(< gnus-registry-minimum-subject-length (length subject)))
|
||||
(let ((groups (apply
|
||||
'append
|
||||
#'append
|
||||
(mapcar
|
||||
(lambda (reference)
|
||||
(gnus-registry-get-id-key reference 'group))
|
||||
|
@ -615,7 +615,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
|
|||
sender
|
||||
gnus-registry-unfollowed-addresses)))
|
||||
(let ((groups (apply
|
||||
'append
|
||||
#'append
|
||||
(mapcar
|
||||
(lambda (reference)
|
||||
(gnus-registry-get-id-key reference 'group))
|
||||
|
@ -644,7 +644,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
|
|||
(not (gnus-grep-in-list
|
||||
recp
|
||||
gnus-registry-unfollowed-addresses)))
|
||||
(let ((groups (apply 'append
|
||||
(let ((groups (apply #'append
|
||||
(mapcar
|
||||
(lambda (reference)
|
||||
(gnus-registry-get-id-key reference 'group))
|
||||
|
@ -663,7 +663,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
|
|||
;; filter the found groups and return them
|
||||
;; the found groups are NOT the full groups
|
||||
(setq found (gnus-registry-post-process-groups
|
||||
"recipients" (mapconcat 'identity recipients ", ") found)))
|
||||
"recipients" (mapconcat #'identity recipients ", ") found)))
|
||||
|
||||
;; after the (cond) we extract the actual value safely
|
||||
(car-safe found)))
|
||||
|
@ -791,7 +791,8 @@ Consults `gnus-registry-ignored-groups' and
|
|||
((stringp g) g)
|
||||
((and (listp g) (nth 1 g))
|
||||
(nth 0 g))
|
||||
(t nil))) gnus-registry-ignored-groups)))
|
||||
(t nil)))
|
||||
gnus-registry-ignored-groups)))
|
||||
;; only use `gnus-parameter-registry-ignore' if
|
||||
;; `gnus-registry-ignored-groups' is a list of lists
|
||||
;; (it can be a list of regexes)
|
||||
|
@ -871,7 +872,7 @@ Addresses without a name will say \"noname\"."
|
|||
|
||||
(defun gnus-registry-sort-addresses (&rest addresses)
|
||||
"Return a normalized and sorted list of ADDRESSES."
|
||||
(sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp))
|
||||
(sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp))
|
||||
|
||||
(defun gnus-registry-simplify-subject (subject)
|
||||
(if (stringp subject)
|
||||
|
@ -961,16 +962,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
|
|||
(intern (format function-format variant-name)))
|
||||
(shortcut (format "%c" (if remove (upcase data) data))))
|
||||
(defalias function-name
|
||||
;; If it weren't for the function's docstring, we could
|
||||
;; use a closure, with lexical-let :-(
|
||||
`(lambda (&rest articles)
|
||||
,(format
|
||||
"%s the %s mark over process-marked ARTICLES."
|
||||
(upcase-initials variant-name)
|
||||
mark)
|
||||
(interactive
|
||||
(gnus-summary-work-articles current-prefix-arg))
|
||||
(gnus-registry--set/remove-mark ',mark ',remove articles)))
|
||||
(lambda (&rest articles)
|
||||
(:documentation
|
||||
(format
|
||||
"%s the %s mark over process-marked ARTICLES."
|
||||
(upcase-initials variant-name)
|
||||
mark))
|
||||
(interactive
|
||||
(gnus-summary-work-articles current-prefix-arg))
|
||||
(gnus-registry--set/remove-mark mark remove articles)))
|
||||
(push function-name keys-plist)
|
||||
(push shortcut keys-plist)
|
||||
(push (vector (format "%s %s"
|
||||
|
@ -990,14 +990,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
|
|||
nil
|
||||
(cons "Registry Marks" gnus-registry-misc-menus))))))
|
||||
|
||||
(make-obsolete 'gnus-registry-user-format-function-M
|
||||
'gnus-registry-article-marks-to-chars "24.1") ?
|
||||
|
||||
(defalias 'gnus-registry-user-format-function-M
|
||||
'gnus-registry-article-marks-to-chars)
|
||||
(define-obsolete-function-alias 'gnus-registry-user-format-function-M
|
||||
#'gnus-registry-article-marks-to-chars "24.1")
|
||||
|
||||
;; use like this:
|
||||
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
|
||||
;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
|
||||
(defun gnus-registry-article-marks-to-chars (headers)
|
||||
"Show the marks for an article by the :char property."
|
||||
(if gnus-registry-enabled
|
||||
|
@ -1013,20 +1010,20 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
|
|||
""))
|
||||
|
||||
;; use like this:
|
||||
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
|
||||
;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
|
||||
(defun gnus-registry-article-marks-to-names (headers)
|
||||
"Show the marks for an article by name."
|
||||
(if gnus-registry-enabled
|
||||
(let* ((id (mail-header-message-id headers))
|
||||
(marks (when id (gnus-registry-get-id-key id 'mark))))
|
||||
(mapconcat (lambda (mark) (symbol-name mark)) marks ","))
|
||||
(mapconcat #'symbol-name marks ","))
|
||||
""))
|
||||
|
||||
(defun gnus-registry-read-mark ()
|
||||
"Read a mark name from the user with completion."
|
||||
(let ((mark (gnus-completing-read
|
||||
"Label"
|
||||
(mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
|
||||
(mapcar #'symbol-name (mapcar #'car gnus-registry-marks))
|
||||
nil nil nil
|
||||
(symbol-name gnus-registry-default-mark))))
|
||||
(when (stringp mark)
|
||||
|
@ -1050,7 +1047,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
|
|||
show-message)
|
||||
"Apply or remove MARK across a list of ARTICLES."
|
||||
(let ((article-id-list
|
||||
(mapcar 'gnus-registry-fetch-message-id-fast articles)))
|
||||
(mapcar #'gnus-registry-fetch-message-id-fast articles)))
|
||||
(dolist (id article-id-list)
|
||||
(let* ((marks (delq mark (gnus-registry-get-id-key id 'mark)))
|
||||
(marks (if remove marks (cons mark marks))))
|
||||
|
@ -1173,34 +1170,34 @@ only the last one's marks are returned."
|
|||
(gnus-registry-install-shortcuts)
|
||||
(if (gnus-alive-p)
|
||||
(gnus-registry-load)
|
||||
(add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)))
|
||||
(add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)))
|
||||
|
||||
(defun gnus-registry-install-hooks ()
|
||||
"Install the registry hooks."
|
||||
(setq gnus-registry-enabled t)
|
||||
(add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
|
||||
(add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
|
||||
(add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
|
||||
(add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
|
||||
(add-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
|
||||
(add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
|
||||
(add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
|
||||
(add-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
|
||||
|
||||
(add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
|
||||
(add-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
|
||||
|
||||
(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
|
||||
(add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids))
|
||||
|
||||
(defun gnus-registry-unload-hook ()
|
||||
"Uninstall the registry hooks."
|
||||
(remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
|
||||
(remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
|
||||
(remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
|
||||
(remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
|
||||
(remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
|
||||
(remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
|
||||
(remove-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
|
||||
(remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
|
||||
|
||||
(remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
|
||||
(remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
|
||||
(remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
|
||||
(remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)
|
||||
|
||||
(remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
|
||||
(remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)
|
||||
(setq gnus-registry-enabled nil))
|
||||
|
||||
(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
|
||||
(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook)
|
||||
|
||||
(defun gnus-registry-install-p ()
|
||||
"Return non-nil if the registry is enabled (and maybe enable it first).
|
||||
|
@ -1234,7 +1231,7 @@ data stored in the registry."
|
|||
(seen-groups (list (gnus-group-group-name))))
|
||||
|
||||
(catch 'found
|
||||
(dolist (group (mapcar 'gnus-simplify-group-name groups))
|
||||
(dolist (group (mapcar #'gnus-simplify-group-name groups))
|
||||
|
||||
;; skip over any groups we really don't want to warp to.
|
||||
(unless (or (member group seen-groups)
|
||||
|
@ -1270,7 +1267,7 @@ EXTRA is a list of symbols. Valid symbols are those contained in
|
|||
the docs of `gnus-registry-track-extra'. This command is useful
|
||||
when you stop tracking some extra data and now want to purge it
|
||||
from your existing entries."
|
||||
(interactive (list (mapcar 'intern
|
||||
(interactive (list (mapcar #'intern
|
||||
(completing-read-multiple
|
||||
"Extra data: "
|
||||
'("subject" "sender" "recipient")))))
|
||||
|
|
|
@ -26,6 +26,7 @@
|
|||
|
||||
(require 'url)
|
||||
(require 'url-cache)
|
||||
(require 'dns)
|
||||
(eval-when-compile
|
||||
(require 'subr-x))
|
||||
|
||||
|
@ -118,9 +119,42 @@ a gravatar for a given email address."
|
|||
:version "27.1"
|
||||
:group 'gravatar)
|
||||
|
||||
(defconst gravatar-base-url
|
||||
"https://www.gravatar.com/avatar"
|
||||
"Base URL for getting gravatars.")
|
||||
(defconst gravatar-service-alist
|
||||
`((gravatar . ,(lambda (_addr) "https://www.gravatar.com/avatar"))
|
||||
(unicornify . ,(lambda (_addr) "https://unicornify.pictures/avatar/"))
|
||||
(libravatar . ,#'gravatar--service-libravatar))
|
||||
"Alist of supported gravatar services.")
|
||||
|
||||
(defcustom gravatar-service 'libravatar
|
||||
"Symbol denoting gravatar-like service to use.
|
||||
Note that certain services might ignore other options, such as
|
||||
`gravatar-default-image' or certain values as with
|
||||
`gravatar-rating'."
|
||||
:type `(choice ,@(mapcar (lambda (s) `(const ,(car s)))
|
||||
gravatar-service-alist))
|
||||
:version "28.1"
|
||||
:link '(url-link "https://www.libravatar.org/")
|
||||
:link '(url-link "https://unicornify.pictures/")
|
||||
:link '(url-link "https://gravatar.com/")
|
||||
:group 'gravatar)
|
||||
|
||||
(defun gravatar--service-libravatar (addr)
|
||||
"Find domain that hosts avatars for email address ADDR."
|
||||
;; implements https://wiki.libravatar.org/api/
|
||||
(save-match-data
|
||||
(if (not (string-match ".+@\\(.+\\)" addr))
|
||||
"https://seccdn.libravatar.org/avatar"
|
||||
(let ((domain (match-string 1 addr)))
|
||||
(catch 'found
|
||||
(dolist (record '(("_avatars-sec" . "https")
|
||||
("_avatars" . "http")))
|
||||
(let* ((query (concat (car record) "._tcp." domain))
|
||||
(result (dns-query query 'SRV)))
|
||||
(when result
|
||||
(throw 'found (format "%s://%s/avatar"
|
||||
(cdr record)
|
||||
result)))))
|
||||
"https://seccdn.libravatar.org/avatar")))))
|
||||
|
||||
(defun gravatar-hash (mail-address)
|
||||
"Return the Gravatar hash for MAIL-ADDRESS."
|
||||
|
@ -142,7 +176,8 @@ a gravatar for a given email address."
|
|||
"Return the URL of a gravatar for MAIL-ADDRESS."
|
||||
;; https://gravatar.com/site/implement/images/
|
||||
(format "%s/%s?%s"
|
||||
gravatar-base-url
|
||||
(funcall (alist-get gravatar-service gravatar-service-alist)
|
||||
mail-address)
|
||||
(gravatar-hash mail-address)
|
||||
(gravatar--query-string)))
|
||||
|
||||
|
|
|
@ -2011,15 +2011,16 @@ Turning on character-folding turns off regexp mode.")
|
|||
(defvar isearch-message-properties minibuffer-prompt-properties
|
||||
"Text properties that are added to the isearch prompt.")
|
||||
|
||||
(defun isearch--momentary-message (string)
|
||||
"Print STRING at the end of the isearch prompt for 1 second."
|
||||
(defun isearch--momentary-message (string &optional seconds)
|
||||
"Print STRING at the end of the isearch prompt for 1 second.
|
||||
The optional argument SECONDS overrides the number of seconds."
|
||||
(let ((message-log-max nil))
|
||||
(message "%s%s%s"
|
||||
(isearch-message-prefix nil isearch-nonincremental)
|
||||
isearch-message
|
||||
(apply #'propertize (format " [%s]" string)
|
||||
isearch-message-properties)))
|
||||
(sit-for 1))
|
||||
(sit-for (or seconds 1)))
|
||||
|
||||
(isearch-define-mode-toggle lax-whitespace " " nil
|
||||
"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).
|
|||
(string-match "\\`Regular expression too big" isearch-error))
|
||||
(cond
|
||||
(isearch-regexp-function
|
||||
(setq isearch-error "Too many words"))
|
||||
(setq isearch-error nil)
|
||||
(setq isearch-regexp-function nil)
|
||||
(isearch-search-and-update)
|
||||
(isearch--momentary-message "Too many words; switched to literal mode" 2))
|
||||
((and isearch-lax-whitespace search-whitespace-regexp)
|
||||
(setq isearch-error "Too many spaces for whitespace matching"))))))
|
||||
|
||||
|
|
|
@ -48,8 +48,7 @@ Preserves the `buffer-modified-p' state of the current buffer."
|
|||
"Jit-lock fontifies chunks of at most this many characters at a time.
|
||||
|
||||
This variable controls both display-time and stealth fontification."
|
||||
:type 'integer
|
||||
:group 'jit-lock)
|
||||
:type 'integer)
|
||||
|
||||
|
||||
(defcustom jit-lock-stealth-time nil
|
||||
|
@ -59,8 +58,7 @@ If nil, stealth fontification is never performed.
|
|||
|
||||
The value of this variable is used when JIT Lock mode is turned on."
|
||||
:type '(choice (const :tag "never" nil)
|
||||
(number :tag "seconds" :value 16))
|
||||
:group 'jit-lock)
|
||||
(number :tag "seconds" :value 16)))
|
||||
|
||||
|
||||
(defcustom jit-lock-stealth-nice 0.5
|
||||
|
@ -72,8 +70,7 @@ To reduce machine load during stealth fontification, at the cost of stealth
|
|||
taking longer to fontify, you could increase the value of this variable.
|
||||
See also `jit-lock-stealth-load'."
|
||||
:type '(choice (const :tag "never" nil)
|
||||
(number :tag "seconds"))
|
||||
:group 'jit-lock)
|
||||
(number :tag "seconds")))
|
||||
|
||||
|
||||
(defcustom jit-lock-stealth-load
|
||||
|
@ -89,14 +86,12 @@ See also `jit-lock-stealth-nice'."
|
|||
:type (if (condition-case nil (load-average) (error))
|
||||
'(choice (const :tag "never" nil)
|
||||
(integer :tag "load"))
|
||||
'(const :format "%t: unsupported\n" nil))
|
||||
:group 'jit-lock)
|
||||
'(const :format "%t: unsupported\n" nil)))
|
||||
|
||||
|
||||
(defcustom jit-lock-stealth-verbose nil
|
||||
"If non-nil, means stealth fontification should show status messages."
|
||||
:type 'boolean
|
||||
:group 'jit-lock)
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
(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.
|
|||
The value of this variable is used when JIT Lock mode is turned on."
|
||||
:type '(choice (const :tag "never" nil)
|
||||
(const :tag "always" t)
|
||||
(other :tag "syntax-driven" syntax-driven))
|
||||
:group 'jit-lock)
|
||||
(other :tag "syntax-driven" syntax-driven)))
|
||||
|
||||
(defcustom jit-lock-context-time 0.5
|
||||
"Idle time after which text is contextually refontified, if applicable."
|
||||
:type '(number :tag "seconds")
|
||||
:group 'jit-lock)
|
||||
:type '(number :tag "seconds"))
|
||||
|
||||
(defcustom jit-lock-antiblink-grace 2
|
||||
"Delay after which to refontify unterminated strings and comments.
|
||||
|
@ -134,14 +127,12 @@ and comments, the delay helps avoid unpleasant \"blinking\", between
|
|||
string/comment and non-string/non-comment fontification."
|
||||
:type '(choice (const :tag "never" nil)
|
||||
(number :tag "seconds"))
|
||||
:group 'jit-lock
|
||||
:version "27.1")
|
||||
|
||||
(defcustom jit-lock-defer-time nil ;; 0.25
|
||||
"Idle time after which deferred fontification should take place.
|
||||
If nil, fontification is not deferred.
|
||||
If 0, then fontification is only deferred while there is input pending."
|
||||
:group 'jit-lock
|
||||
:type '(choice (const :tag "never" nil)
|
||||
(number :tag "seconds")))
|
||||
|
||||
|
@ -262,7 +253,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
|
|||
|
||||
;; Setup our hooks.
|
||||
(add-hook 'after-change-functions 'jit-lock-after-change nil t)
|
||||
(add-hook 'fontification-functions 'jit-lock-function))
|
||||
(add-hook 'fontification-functions 'jit-lock-function nil t))
|
||||
|
||||
;; Turn Just-in-time Lock mode off.
|
||||
(t
|
||||
|
@ -294,7 +285,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
|
|||
When this minor mode is enabled, jit-lock runs as little code as possible
|
||||
during redisplay and moves the rest to a timer, where things
|
||||
like `debug-on-error' and Edebug can be used."
|
||||
:global t :group 'jit-lock
|
||||
:global t
|
||||
(when jit-lock-defer-timer
|
||||
(cancel-timer jit-lock-defer-timer)
|
||||
(setq jit-lock-defer-timer nil))
|
||||
|
@ -438,8 +429,8 @@ Defaults to the whole buffer. END can be out of bounds."
|
|||
(quit (put-text-property start next 'fontified nil)
|
||||
(signal (car err) (cdr err))))))
|
||||
|
||||
;; In case we fontified more than requested, take advantage of the
|
||||
;; good news.
|
||||
;; In case we fontified more than requested, take
|
||||
;; advantage of the good news.
|
||||
(when (or (< tight-beg start) (> tight-end next))
|
||||
(put-text-property tight-beg tight-end 'fontified t))
|
||||
|
||||
|
|
|
@ -435,9 +435,9 @@ not contain `d', so that a full listing is expected."
|
|||
;; text. But if the listing is empty, as e.g. in empty
|
||||
;; directories with -a removed from switches, point will be
|
||||
;; before the inserted text, and dired-insert-directory will
|
||||
;; not indent the listing correctly. Going to the end of the
|
||||
;; buffer fixes that.
|
||||
(unless files (goto-char (point-max)))
|
||||
;; not indent the listing correctly. Getting past the
|
||||
;; inserted text solves this.
|
||||
(unless (cdr total-line) (forward-line 2))
|
||||
(if (memq ?R switches)
|
||||
;; List the contents of all directories recursively.
|
||||
;; cadr of each element of `file-alist' is t for
|
||||
|
|
|
@ -629,9 +629,6 @@ But handle the case, if the \"test\" command is not available."
|
|||
(format "File %s exists; overwrite anyway? " filename)))))
|
||||
(tramp-error v 'file-already-exists filename))
|
||||
|
||||
;; We must also flush the cache of the directory, because
|
||||
;; `file-attributes' reads the values from there.
|
||||
(tramp-flush-file-properties v localname)
|
||||
(let* ((curbuf (current-buffer))
|
||||
(tmpfile (tramp-compat-make-temp-file filename)))
|
||||
(when (and append (file-exists-p filename))
|
||||
|
@ -648,6 +645,10 @@ But handle the case, if the \"test\" command is not available."
|
|||
(tramp-error v 'file-error "Cannot write: `%s'" filename))
|
||||
(delete-file tmpfile)))
|
||||
|
||||
;; We must also flush the cache of the directory, because
|
||||
;; `file-attributes' reads the values from there.
|
||||
(tramp-flush-file-properties v localname)
|
||||
|
||||
(unless (equal curbuf (current-buffer))
|
||||
(tramp-error
|
||||
v 'file-error
|
||||
|
@ -1096,7 +1097,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
|
|||
"Like `exec-path' for Tramp files."
|
||||
(append
|
||||
(with-parsed-tramp-file-name default-directory nil
|
||||
(with-tramp-connection-property v "remote-path"
|
||||
(with-tramp-connection-property (tramp-get-process v) "remote-path"
|
||||
(tramp-adb-send-command v "echo \\\"$PATH\\\"")
|
||||
(split-string
|
||||
(with-current-buffer (tramp-get-connection-buffer v)
|
||||
|
@ -1111,11 +1112,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
|
|||
"Return full host name from VEC to be used in shell execution.
|
||||
E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
|
||||
a host name \"R38273882DE\" returns \"R38273882DE\"."
|
||||
;; Sometimes this is called before there is a connection process
|
||||
;; yet. In order to work with the connection cache, we flush all
|
||||
;; unwanted entries first.
|
||||
(tramp-flush-connection-properties nil)
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) "device"
|
||||
(with-tramp-connection-property (tramp-get-process vec) "device"
|
||||
(let* ((host (tramp-file-name-host vec))
|
||||
(port (tramp-file-name-port-or-default vec))
|
||||
(devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
|
||||
|
|
|
@ -31,13 +31,13 @@
|
|||
;; a process, has a unique cache. We distinguish 4 kind of caches,
|
||||
;; depending on the key:
|
||||
;;
|
||||
;; - localname is NIL. This are reusable properties. Examples:
|
||||
;; - localname is nil. These are reusable properties. Examples:
|
||||
;; "remote-shell" identifies the POSIX shell to be called on the
|
||||
;; remote host, or "perl" is the command to be called on the remote
|
||||
;; host when starting a Perl script. These properties are saved in
|
||||
;; the file `tramp-persistency-file-name'.
|
||||
;;
|
||||
;; - localname is a string. This are temporary properties, which are
|
||||
;; - localname is a string. These are temporary properties, which are
|
||||
;; related to the file localname is referring to. Examples:
|
||||
;; "file-exists-p" is t or nil, depending on the file existence, or
|
||||
;; "file-attributes" caches the result of the function
|
||||
|
@ -45,21 +45,32 @@
|
|||
;; expire after `remote-file-name-inhibit-cache' seconds if this
|
||||
;; variable is set.
|
||||
;;
|
||||
;; - The key is a process. This are temporary properties related to
|
||||
;; - The key is a process. These are temporary properties related to
|
||||
;; an open connection. Examples: "scripts" keeps shell script
|
||||
;; definitions already sent to the remote shell, "last-cmd-time" is
|
||||
;; the time stamp a command has been sent to the remote process.
|
||||
;;
|
||||
;; - The key is nil. This are temporary properties related to the
|
||||
;; - The key is nil. These are temporary properties related to the
|
||||
;; local machine. Examples: "parse-passwd" and "parse-group" keep
|
||||
;; the results of parsing "/etc/passwd" and "/etc/group",
|
||||
;; "{uid,gid}-{integer,string}" are the local uid and gid, and
|
||||
;; "locale" is the used shell locale.
|
||||
;;
|
||||
;; - The key is `tramp-cache-undefined'. All functions return the
|
||||
;; expected values, but nothing is cached.
|
||||
|
||||
;; Some properties are handled special:
|
||||
;;
|
||||
;; - "process-name", "process-buffer" and "first-password-request" are
|
||||
;; not saved in the file `tramp-persistency-file-name'.
|
||||
;; not saved in the file `tramp-persistency-file-name', although
|
||||
;; being connection properties related to a `tramp-file-name'
|
||||
;; structure.
|
||||
;;
|
||||
;; - Reusable properties, which should not be saved, are kept in the
|
||||
;; process key retrieved by `tramp-get-process' (the main connection
|
||||
;; process). Other processes could reuse these properties, avoiding
|
||||
;; recomputation when a new asynchronous process is created by
|
||||
;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el).
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
@ -96,25 +107,31 @@ details see the info pages."
|
|||
(defvar tramp-cache-data-changed nil
|
||||
"Whether persistent cache data have been changed.")
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defconst tramp-cache-undefined 'undef
|
||||
"The symbol marking undefined hash keys and values.")
|
||||
|
||||
(defun tramp-get-hash-table (key)
|
||||
"Return the hash table for KEY.
|
||||
If it doesn't exist yet, it is created and initialized with
|
||||
matching entries of `tramp-connection-properties'."
|
||||
(or (gethash key tramp-cache-data)
|
||||
(let ((hash
|
||||
(puthash key (make-hash-table :test #'equal) tramp-cache-data)))
|
||||
(when (tramp-file-name-p key)
|
||||
(dolist (elt tramp-connection-properties)
|
||||
(when (string-match-p
|
||||
(or (nth 0 elt) "")
|
||||
(tramp-make-tramp-file-name key 'noloc 'nohop))
|
||||
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
|
||||
hash)))
|
||||
matching entries of `tramp-connection-properties'.
|
||||
If KEY is `tramp-cache-undefined', don't create anything, and return nil."
|
||||
(unless (eq key tramp-cache-undefined)
|
||||
(or (gethash key tramp-cache-data)
|
||||
(let ((hash
|
||||
(puthash key (make-hash-table :test #'equal) tramp-cache-data)))
|
||||
(when (tramp-file-name-p key)
|
||||
(dolist (elt tramp-connection-properties)
|
||||
(when (string-match-p
|
||||
(or (nth 0 elt) "")
|
||||
(tramp-make-tramp-file-name key 'noloc 'nohop))
|
||||
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
|
||||
hash))))
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defun tramp-get-file-property (key file property default)
|
||||
"Get the PROPERTY of FILE from the cache context of KEY.
|
||||
Returns DEFAULT if not set."
|
||||
Return DEFAULT if not set."
|
||||
;; Unify localname. Remove hop from `tramp-file-name' structure.
|
||||
(setq file (tramp-compat-file-name-unquote file)
|
||||
key (copy-tramp-file-name key))
|
||||
|
@ -152,7 +169,7 @@ Returns DEFAULT if not set."
|
|||
;;;###tramp-autoload
|
||||
(defun tramp-set-file-property (key file property value)
|
||||
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
|
||||
Returns VALUE."
|
||||
Return VALUE."
|
||||
;; Unify localname. Remove hop from `tramp-file-name' structure.
|
||||
(setq file (tramp-compat-file-name-unquote file)
|
||||
key (copy-tramp-file-name key))
|
||||
|
@ -283,8 +300,9 @@ This is suppressed for temporary buffers."
|
|||
"Get the named PROPERTY for the connection.
|
||||
KEY identifies the connection, it is either a process or a
|
||||
`tramp-file-name' structure. A special case is nil, which is
|
||||
used to cache connection properties of the local machine. If the
|
||||
value is not set for the connection, returns DEFAULT."
|
||||
used to cache connection properties of the local machine.
|
||||
If KEY is `tramp-cache-undefined', or if the value is not set for
|
||||
the connection, return DEFAULT."
|
||||
;; Unify key by removing localname and hop from `tramp-file-name'
|
||||
;; structure. Work with a copy in order to avoid side effects.
|
||||
(when (tramp-file-name-p key)
|
||||
|
@ -308,19 +326,22 @@ value is not set for the connection, returns DEFAULT."
|
|||
"Set the named PROPERTY of a connection to VALUE.
|
||||
KEY identifies the connection, it is either a process or a
|
||||
`tramp-file-name' structure. A special case is nil, which is
|
||||
used to cache connection properties of the local machine.
|
||||
PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
|
||||
used to cache connection properties of the local machine. If KEY
|
||||
is `tramp-cache-undefined', nothing is set.
|
||||
PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
|
||||
Return VALUE."
|
||||
;; Unify key by removing localname and hop from `tramp-file-name'
|
||||
;; structure. Work with a copy in order to avoid side effects.
|
||||
(when (tramp-file-name-p key)
|
||||
(setq key (copy-tramp-file-name key))
|
||||
(setf (tramp-file-name-localname key) nil
|
||||
(tramp-file-name-hop key) nil))
|
||||
(let ((hash (tramp-get-hash-table key)))
|
||||
(puthash property value hash)
|
||||
(setq tramp-cache-data-changed t)
|
||||
(tramp-message key 7 "%s %s" property value)
|
||||
value))
|
||||
(when-let ((hash (tramp-get-hash-table key)))
|
||||
(puthash property value hash))
|
||||
(setq tramp-cache-data-changed
|
||||
(or tramp-cache-data-changed (tramp-tramp-file-p key)))
|
||||
(tramp-message key 7 "%s %s" property value)
|
||||
value)
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defun tramp-connection-property-p (key property)
|
||||
|
@ -328,7 +349,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
|
|||
KEY identifies the connection, it is either a process or a
|
||||
`tramp-file-name' structure. A special case is nil, which is
|
||||
used to cache connection properties of the local machine."
|
||||
(not (eq (tramp-get-connection-property key property 'undef) 'undef)))
|
||||
(not (eq (tramp-get-connection-property key property tramp-cache-undefined)
|
||||
tramp-cache-undefined)))
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defun tramp-flush-connection-property (key property)
|
||||
|
@ -343,8 +365,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
|
|||
(setq key (copy-tramp-file-name key))
|
||||
(setf (tramp-file-name-localname key) nil
|
||||
(tramp-file-name-hop key) nil))
|
||||
(remhash property (tramp-get-hash-table key))
|
||||
(setq tramp-cache-data-changed t)
|
||||
(when-let ((hash (tramp-get-hash-table key)))
|
||||
(remhash property hash))
|
||||
(setq tramp-cache-data-changed
|
||||
(or tramp-cache-data-changed (tramp-tramp-file-p key)))
|
||||
(tramp-message key 7 "%s" property))
|
||||
|
||||
;;;###tramp-autoload
|
||||
|
@ -361,9 +385,10 @@ used to cache connection properties of the local machine."
|
|||
(tramp-file-name-hop key) nil))
|
||||
(tramp-message
|
||||
key 7 "%s %s" key
|
||||
(let ((hash (gethash key tramp-cache-data)))
|
||||
(when (hash-table-p hash) (hash-table-keys hash))))
|
||||
(setq tramp-cache-data-changed t)
|
||||
(when-let ((hash (gethash key tramp-cache-data)))
|
||||
(hash-table-keys hash)))
|
||||
(setq tramp-cache-data-changed
|
||||
(or tramp-cache-data-changed (tramp-tramp-file-p key)))
|
||||
(remhash key tramp-cache-data))
|
||||
|
||||
;;;###tramp-autoload
|
||||
|
@ -414,7 +439,8 @@ used to cache connection properties of the local machine."
|
|||
(hash-table-keys tramp-cache-data)))))
|
||||
|
||||
(defun tramp-dump-connection-properties ()
|
||||
"Write persistent connection properties into file `tramp-persistency-file-name'."
|
||||
"Write persistent connection properties into file \
|
||||
`tramp-persistency-file-name'."
|
||||
;; We shouldn't fail, otherwise Emacs might not be able to be closed.
|
||||
(ignore-errors
|
||||
(when (and (hash-table-p tramp-cache-data)
|
||||
|
|
|
@ -107,21 +107,19 @@ When called interactively, a Tramp connection has to be selected."
|
|||
;; suppressed.
|
||||
(setq tramp-current-connection nil)
|
||||
|
||||
;; Flush file cache.
|
||||
(tramp-flush-directory-properties vec "")
|
||||
|
||||
;; Flush connection cache.
|
||||
(when (processp (tramp-get-connection-process vec))
|
||||
(tramp-flush-connection-properties (tramp-get-connection-process vec))
|
||||
(delete-process (tramp-get-connection-process vec)))
|
||||
(tramp-flush-connection-properties vec)
|
||||
|
||||
;; Cancel timer.
|
||||
(dolist (timer timer-list)
|
||||
(when (and (eq (timer--function timer) 'tramp-timeout-session)
|
||||
(tramp-file-name-equal-p vec (car (timer--args timer))))
|
||||
(cancel-timer timer)))
|
||||
|
||||
;; Delete processes.
|
||||
(dolist (key (hash-table-keys tramp-cache-data))
|
||||
(when (and (processp key)
|
||||
(tramp-file-name-equal-p (process-get key 'vector) vec))
|
||||
(tramp-flush-connection-properties key)
|
||||
(delete-process key)))
|
||||
|
||||
;; Remove buffers.
|
||||
(dolist
|
||||
(buf (list (get-buffer (tramp-buffer-name vec))
|
||||
|
@ -130,6 +128,12 @@ When called interactively, a Tramp connection has to be selected."
|
|||
(tramp-get-connection-property vec "process-buffer" nil)))
|
||||
(when (bufferp buf) (kill-buffer buf)))
|
||||
|
||||
;; Flush file cache.
|
||||
(tramp-flush-directory-properties vec "")
|
||||
|
||||
;; Flush connection cache.
|
||||
(tramp-flush-connection-properties vec)
|
||||
|
||||
;; The end.
|
||||
(run-hook-with-args 'tramp-cleanup-connection-hook vec)))
|
||||
|
||||
|
|
|
@ -1731,8 +1731,7 @@ a downcased host name only."
|
|||
(list
|
||||
t ;; handled.
|
||||
nil ;; no abort of D-Bus.
|
||||
(with-tramp-connection-property
|
||||
(tramp-get-connection-process v) message
|
||||
(with-tramp-connection-property (tramp-get-process v) message
|
||||
;; In theory, there can be several choices.
|
||||
;; Until now, there is only the question whether
|
||||
;; to accept an unknown host signature or certificate.
|
||||
|
@ -1946,8 +1945,7 @@ a downcased host name only."
|
|||
(tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
|
||||
(while (tramp-gvfs-connection-mounted-p vec)
|
||||
(read-event nil nil 0.1))
|
||||
(tramp-flush-connection-properties vec)
|
||||
(tramp-flush-connection-properties (tramp-get-connection-process vec)))
|
||||
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
|
||||
|
||||
(defun tramp-gvfs-mount-spec-entry (key value)
|
||||
"Construct a mount-spec entry to be used in a mount_spec.
|
||||
|
|
|
@ -1539,7 +1539,7 @@ of."
|
|||
|
||||
(defun tramp-remote-selinux-p (vec)
|
||||
"Check, whether SELINUX is enabled on the remote host."
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
|
||||
(with-tramp-connection-property (tramp-get-process vec) "selinux-p"
|
||||
(tramp-send-command-and-check vec "selinuxenabled")))
|
||||
|
||||
(defun tramp-sh-handle-file-selinux-context (filename)
|
||||
|
@ -1588,7 +1588,7 @@ of."
|
|||
|
||||
(defun tramp-remote-acl-p (vec)
|
||||
"Check, whether ACL is enabled on the remote host."
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
|
||||
(with-tramp-connection-property (tramp-get-process vec) "acl-p"
|
||||
(tramp-send-command-and-check vec "getfacl /")))
|
||||
|
||||
(defun tramp-sh-handle-file-acl (filename)
|
||||
|
@ -3580,23 +3580,29 @@ STDERR can also be a file name."
|
|||
remote-file-name-inhibit-cache process-file-side-effects)
|
||||
;; Reduce `vc-handled-backends' in order to minimize
|
||||
;; process calls.
|
||||
(when (and (memq 'Bzr vc-handled-backends)
|
||||
(boundp 'vc-bzr-program)
|
||||
(not (with-tramp-connection-property v vc-bzr-program
|
||||
(tramp-find-executable
|
||||
v vc-bzr-program (tramp-get-remote-path v)))))
|
||||
(when (and
|
||||
(memq 'Bzr vc-handled-backends)
|
||||
(not (and
|
||||
(bound-and-true-p vc-bzr-program)
|
||||
(with-tramp-connection-property v vc-bzr-program
|
||||
(tramp-find-executable
|
||||
v vc-bzr-program (tramp-get-remote-path v))))))
|
||||
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
|
||||
(when (and (memq 'Git vc-handled-backends)
|
||||
(boundp 'vc-git-program)
|
||||
(not (with-tramp-connection-property v vc-git-program
|
||||
(tramp-find-executable
|
||||
v vc-git-program (tramp-get-remote-path v)))))
|
||||
(when (and
|
||||
(memq 'Git vc-handled-backends)
|
||||
(not (and
|
||||
(bound-and-true-p vc-git-program)
|
||||
(with-tramp-connection-property v vc-git-program
|
||||
(tramp-find-executable
|
||||
v vc-git-program (tramp-get-remote-path v))))))
|
||||
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
|
||||
(when (and (memq 'Hg vc-handled-backends)
|
||||
(boundp 'vc-hg-program)
|
||||
(not (with-tramp-connection-property v vc-hg-program
|
||||
(tramp-find-executable
|
||||
v vc-hg-program (tramp-get-remote-path v)))))
|
||||
(when (and
|
||||
(memq 'Hg vc-handled-backends)
|
||||
(not (and
|
||||
(bound-and-true-p vc-hg-program)
|
||||
(with-tramp-connection-property v vc-hg-program
|
||||
(tramp-find-executable
|
||||
v vc-hg-program (tramp-get-remote-path v))))))
|
||||
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
|
||||
;; Run.
|
||||
(tramp-with-demoted-errors
|
||||
|
@ -4290,11 +4296,15 @@ process to set up. VEC specifies the connection."
|
|||
;; connection properties. We start again with
|
||||
;; `tramp-maybe-open-connection', it will be caught there.
|
||||
(tramp-message vec 5 "Checking system information")
|
||||
(let ((old-uname (tramp-get-connection-property vec "uname" nil))
|
||||
(uname
|
||||
(tramp-set-connection-property
|
||||
vec "uname"
|
||||
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
|
||||
(let* ((old-uname (tramp-get-connection-property vec "uname" nil))
|
||||
(uname
|
||||
;; If we are in `make-process', we don't need to recompute.
|
||||
(if (and old-uname
|
||||
(tramp-get-connection-property vec "process-name" nil))
|
||||
old-uname
|
||||
(tramp-set-connection-property
|
||||
vec "uname"
|
||||
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
|
||||
(when (and (stringp old-uname) (not (string-equal old-uname uname)))
|
||||
(tramp-message
|
||||
vec 3
|
||||
|
@ -5053,7 +5063,7 @@ connection if a previous connection has died for some reason."
|
|||
;; we cannot use `tramp-get-connection-process'.
|
||||
(tmpfile
|
||||
(with-tramp-connection-property
|
||||
(get-process (tramp-buffer-name vec)) "temp-file"
|
||||
(tramp-get-process vec) "temp-file"
|
||||
(make-temp-name
|
||||
(expand-file-name
|
||||
tramp-temp-name-prefix
|
||||
|
@ -5426,7 +5436,7 @@ Nonexistent directories are removed from spec."
|
|||
;; cache the result for the session only. Otherwise, the
|
||||
;; result is cached persistently.
|
||||
(if (memq 'tramp-own-remote-path tramp-remote-path)
|
||||
(tramp-get-connection-process vec)
|
||||
(tramp-get-process vec)
|
||||
vec)
|
||||
"remote-path"
|
||||
(let* ((remote-path (copy-tree tramp-remote-path))
|
||||
|
@ -5945,10 +5955,9 @@ the length of the file to be compressed.
|
|||
If no corresponding command is found, nil is returned."
|
||||
(when (and (integerp tramp-inline-compress-start-size)
|
||||
(> size tramp-inline-compress-start-size))
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) prop
|
||||
(with-tramp-connection-property (tramp-get-process vec) prop
|
||||
(tramp-find-inline-compress vec)
|
||||
(tramp-get-connection-property
|
||||
(tramp-get-connection-process vec) prop nil))))
|
||||
(tramp-get-connection-property (tramp-get-process vec) prop nil))))
|
||||
|
||||
(defun tramp-get-inline-coding (vec prop size)
|
||||
"Return the coding command related to PROP.
|
||||
|
@ -5966,11 +5975,9 @@ function cell is returned to be applied on a buffer."
|
|||
;; no inline coding is found.
|
||||
(ignore-errors
|
||||
(let ((coding
|
||||
(with-tramp-connection-property
|
||||
(tramp-get-connection-process vec) prop
|
||||
(with-tramp-connection-property (tramp-get-process vec) prop
|
||||
(tramp-find-inline-encoding vec)
|
||||
(tramp-get-connection-property
|
||||
(tramp-get-connection-process vec) prop nil)))
|
||||
(tramp-get-connection-property (tramp-get-process vec) prop nil)))
|
||||
(prop1 (if (string-match-p "encoding" prop)
|
||||
"inline-compress" "inline-decompress"))
|
||||
compress)
|
||||
|
|
|
@ -1557,9 +1557,6 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
|
|||
(format "File %s exists; overwrite anyway? " filename)))))
|
||||
(tramp-error v 'file-already-exists filename))
|
||||
|
||||
;; We must also flush the cache of the directory, because
|
||||
;; `file-attributes' reads the values from there.
|
||||
(tramp-flush-file-properties v localname)
|
||||
(let ((curbuf (current-buffer))
|
||||
(tmpfile (tramp-compat-make-temp-file filename)))
|
||||
(when (and append (file-exists-p filename))
|
||||
|
@ -1579,6 +1576,10 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
|
|||
(tramp-error v 'file-error "Cannot write `%s'" filename))
|
||||
(delete-file tmpfile)))
|
||||
|
||||
;; We must also flush the cache of the directory, because
|
||||
;; `file-attributes' reads the values from there.
|
||||
(tramp-flush-file-properties v localname)
|
||||
|
||||
(unless (equal curbuf (current-buffer))
|
||||
(tramp-error
|
||||
v 'file-error
|
||||
|
@ -1844,7 +1845,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
|
|||
(if (and (process-live-p (tramp-get-connection-process vec))
|
||||
(tramp-get-connection-property vec "posix" t))
|
||||
(with-tramp-connection-property
|
||||
(tramp-get-connection-process vec) "cifs-capabilities"
|
||||
(tramp-get-process vec) "cifs-capabilities"
|
||||
(save-match-data
|
||||
(when (tramp-smb-send-command vec "posix")
|
||||
(with-current-buffer (tramp-get-connection-buffer vec)
|
||||
|
@ -1861,8 +1862,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
|
|||
;; When we are not logged in yet, we return nil.
|
||||
(if (and (tramp-smb-get-share vec)
|
||||
(process-live-p (tramp-get-connection-process vec)))
|
||||
(with-tramp-connection-property
|
||||
(tramp-get-connection-process vec) "stat-capability"
|
||||
(with-tramp-connection-property (tramp-get-process vec) "stat-capability"
|
||||
(tramp-smb-send-command vec "stat \"/\""))))
|
||||
|
||||
|
||||
|
|
|
@ -373,7 +373,7 @@ the result will be a local, non-Tramp, file name."
|
|||
|
||||
(defun tramp-sudoedit-remote-acl-p (vec)
|
||||
"Check, whether ACL is enabled on the remote host."
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
|
||||
(with-tramp-connection-property (tramp-get-process vec) "acl-p"
|
||||
(zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
|
||||
|
||||
(defun tramp-sudoedit-handle-file-acl (filename)
|
||||
|
@ -478,7 +478,7 @@ the result will be a local, non-Tramp, file name."
|
|||
|
||||
(defun tramp-sudoedit-remote-selinux-p (vec)
|
||||
"Check, whether SELINUX is enabled on the remote host."
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
|
||||
(with-tramp-connection-property (tramp-get-process vec) "selinux-p"
|
||||
(zerop (tramp-call-process vec "selinuxenabled"))))
|
||||
|
||||
(defun tramp-sudoedit-handle-file-selinux-context (filename)
|
||||
|
|
|
@ -37,7 +37,7 @@
|
|||
;; For more detailed instructions, please see the info file.
|
||||
;;
|
||||
;; Notes:
|
||||
;; -----
|
||||
;; ------
|
||||
;;
|
||||
;; Also see the todo list at the bottom of this file.
|
||||
;;
|
||||
|
@ -46,6 +46,7 @@
|
|||
;;
|
||||
;; There's a mailing list for this, as well. Its name is:
|
||||
;; tramp-devel@gnu.org
|
||||
|
||||
;; You can use the Web to subscribe, under the following URL:
|
||||
;; https://lists.gnu.org/mailman/listinfo/tramp-devel
|
||||
;;
|
||||
|
@ -1631,6 +1632,15 @@ from the default one."
|
|||
(or (tramp-get-connection-property vec "process-name" nil)
|
||||
(tramp-buffer-name vec)))
|
||||
|
||||
(defun tramp-get-process (vec-or-proc)
|
||||
"Get the default connection process to be used for VEC-OR-PROC.
|
||||
Return `tramp-cache-undefined' in case it doesn't exist."
|
||||
(or (and (tramp-file-name-p vec-or-proc)
|
||||
(get-buffer-process (tramp-buffer-name vec-or-proc)))
|
||||
(and (processp vec-or-proc)
|
||||
(tramp-get-process (process-get vec-or-proc 'vector)))
|
||||
tramp-cache-undefined))
|
||||
|
||||
(defun tramp-get-connection-process (vec)
|
||||
"Get the connection process to be used for VEC.
|
||||
In case a second asynchronous communication has been started, it is different
|
||||
|
|
|
@ -646,6 +646,16 @@ matched file names, and weeding out false positives."
|
|||
:link `(file-link :tag "example file"
|
||||
,(expand-file-name "compilation.txt" data-directory)))
|
||||
|
||||
(defvar compilation-error-case-fold-search nil
|
||||
"If non-nil, use case-insensitive matching of compilation errors
|
||||
by the regexps of `compilation-error-regexp-alist' and
|
||||
`compilation-error-regexp-alist-alist'.
|
||||
If nil, matching is case-sensitive.
|
||||
|
||||
This variable should only be set for backward compatibility as a temporary
|
||||
measure. The proper solution is to use a regexp that matches the
|
||||
messages without case-folding.")
|
||||
|
||||
;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
|
||||
(defvar compilation-directory nil
|
||||
"Directory to restore to when doing `recompile'.")
|
||||
|
@ -1435,7 +1445,8 @@ to `compilation-error-regexp-alist' if RULES is nil."
|
|||
(if (symbolp item)
|
||||
(setq item (cdr (assq item
|
||||
compilation-error-regexp-alist-alist))))
|
||||
(let ((file (nth 1 item))
|
||||
(let ((case-fold-search compilation-error-case-fold-search)
|
||||
(file (nth 1 item))
|
||||
(line (nth 2 item))
|
||||
(col (nth 3 item))
|
||||
(type (nth 4 item))
|
||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -1729,25 +1729,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
|
|||
"Interrupt the program being debugged."
|
||||
(interactive)
|
||||
(interrupt-process
|
||||
(get-buffer-process gud-comint-buffer) comint-ptyp))
|
||||
(get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
|
||||
|
||||
(defun gdb-io-quit ()
|
||||
"Send quit signal to the program being debugged."
|
||||
(interactive)
|
||||
(quit-process
|
||||
(get-buffer-process gud-comint-buffer) comint-ptyp))
|
||||
(get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
|
||||
|
||||
(defun gdb-io-stop ()
|
||||
"Stop the program being debugged."
|
||||
(interactive)
|
||||
(stop-process
|
||||
(get-buffer-process gud-comint-buffer) comint-ptyp))
|
||||
(get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
|
||||
|
||||
(defun gdb-io-eof ()
|
||||
"Send end-of-file to the program being debugged."
|
||||
(interactive)
|
||||
(process-send-eof
|
||||
(get-buffer-process gud-comint-buffer)))
|
||||
(get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io))))
|
||||
|
||||
(defun gdb-clear-inferior-io ()
|
||||
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
|
||||
|
|
|
@ -1558,7 +1558,6 @@ be a list of the form returned by `event-start' and `event-end'."
|
|||
|
||||
;;;; Obsolescent names for functions.
|
||||
|
||||
(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
|
||||
(make-obsolete 'buffer-has-markers-at nil "24.3")
|
||||
|
||||
(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'."
|
|||
(make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1")
|
||||
(make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1")
|
||||
|
||||
(defun forward-point (n)
|
||||
"Return buffer position N characters after (before if N negative) point."
|
||||
(declare (obsolete "use (+ (point) N) instead." "23.1"))
|
||||
(+ (point) n))
|
||||
|
||||
(defun log10 (x)
|
||||
"Return (log X 10), the log base 10 of X."
|
||||
(declare (obsolete log "24.4"))
|
||||
|
|
|
@ -405,27 +405,31 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
|
|||
|
||||
\\{conf-mode-map}"
|
||||
|
||||
;; `conf-mode' plays two roles: it's the parent of several sub-modes
|
||||
;; but it's also the function that chooses between those submodes.
|
||||
;; To tell the difference between those two cases where the function
|
||||
;; might be called, we check `delay-mode-hooks'.
|
||||
;; (adopted from tex-mode.el)
|
||||
(if (not delay-mode-hooks)
|
||||
(funcall (conf--guess-mode))
|
||||
(setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil))
|
||||
;; Let newcomment.el decide this for itself.
|
||||
;; (setq-local comment-use-syntax t)
|
||||
(setq-local parse-sexp-ignore-comments t)
|
||||
(setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
|
||||
(setq-local outline-heading-end-regexp "[\n}]")
|
||||
(setq-local outline-level #'conf-outline-level)
|
||||
(setq-local imenu-generic-expression
|
||||
'(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
|
||||
;; [section]
|
||||
(nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
|
||||
;; section { ... }
|
||||
(nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1))))
|
||||
|
||||
;; `conf-mode' plays two roles: it's the parent of several sub-modes
|
||||
;; but it's also the function that chooses between those submodes.
|
||||
;; To tell the difference between those two cases where the function
|
||||
;; might be called, we check `delay-mode-hooks'.
|
||||
;; (inspired from tex-mode.el)
|
||||
(advice-add 'conf-mode :around
|
||||
(lambda (orig-fun)
|
||||
"Redirect to one of the submodes when called directly."
|
||||
(funcall (if delay-mode-hooks orig-fun (conf--guess-mode)))))
|
||||
|
||||
|
||||
(setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil))
|
||||
;; Let newcomment.el decide this for itself.
|
||||
;; (setq-local comment-use-syntax t)
|
||||
(setq-local parse-sexp-ignore-comments t)
|
||||
(setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
|
||||
(setq-local outline-heading-end-regexp "[\n}]")
|
||||
(setq-local outline-level #'conf-outline-level)
|
||||
(setq-local imenu-generic-expression
|
||||
'(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
|
||||
;; [section]
|
||||
(nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
|
||||
;; section { ... }
|
||||
(nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1)))))
|
||||
|
||||
(defun conf-mode-initialize (comment &optional font-lock)
|
||||
"Initializations for sub-modes of `conf-mode'.
|
||||
|
|
|
@ -224,7 +224,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on."
|
|||
:group 'tex-view)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom tex-default-mode 'latex-mode
|
||||
(defcustom tex-default-mode #'latex-mode
|
||||
"Mode to enter for a new file that might be either TeX or LaTeX.
|
||||
This variable is used when it can't be determined whether the file
|
||||
is 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."
|
|||
"Default expressions to highlight in TeX modes.")
|
||||
|
||||
(defvar tex-verbatim-environments
|
||||
'("verbatim" "verbatim*"))
|
||||
'("verbatim" "verbatim*"
|
||||
"Verbatim" ;; From "fancyvrb"
|
||||
))
|
||||
(put 'tex-verbatim-environments 'safe-local-variable
|
||||
(lambda (x) (not (memq nil (mapcar #'stringp x)))))
|
||||
|
||||
|
@ -966,7 +968,7 @@ Inherits `shell-mode-map' with a few additions.")
|
|||
|
||||
;; This would be a lot simpler if we just used a regexp search,
|
||||
;; but then it would be too slow.
|
||||
(defun tex-guess-mode ()
|
||||
(defun tex--guess-mode ()
|
||||
(let ((mode tex-default-mode) slash comment)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
@ -983,52 +985,40 @@ Inherits `shell-mode-map' with a few additions.")
|
|||
(regexp-opt '("documentstyle" "documentclass"
|
||||
"begin" "subsection" "section"
|
||||
"part" "chapter" "newcommand"
|
||||
"renewcommand" "RequirePackage") 'words)
|
||||
"renewcommand" "RequirePackage")
|
||||
'words)
|
||||
"\\|NeedsTeXFormat{LaTeX")))
|
||||
(if (and (looking-at
|
||||
"document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
|
||||
;; SliTeX is almost never used any more nowadays.
|
||||
(tex-executable-exists-p slitex-run-command))
|
||||
'slitex-mode
|
||||
'latex-mode)
|
||||
'plain-tex-mode))))
|
||||
(funcall mode)))
|
||||
#'slitex-mode
|
||||
#'latex-mode)
|
||||
#'plain-tex-mode))))
|
||||
mode))
|
||||
|
||||
;; `tex-mode' plays two roles: it's the parent of several sub-modes
|
||||
;; but it's also the function that chooses between those submodes.
|
||||
;; To tell the difference between those two cases where the function
|
||||
;; might be called, we check `delay-mode-hooks'.
|
||||
(define-derived-mode tex-mode text-mode "generic-TeX"
|
||||
(tex-common-initialization))
|
||||
;; We now move the function and define it again. This gives a warning
|
||||
;; in the byte-compiler :-( but it's difficult to avoid because
|
||||
;; `define-derived-mode' will necessarily define the function once
|
||||
;; and we need to define it a second time for `autoload' to get the
|
||||
;; proper docstring.
|
||||
(defalias 'tex-mode-internal (symbol-function 'tex-mode))
|
||||
|
||||
;; Suppress the byte-compiler warning about multiple definitions.
|
||||
;; This is a) ugly, and b) cheating, but this was the last
|
||||
;; remaining warning from byte-compiling all of Emacs...
|
||||
(eval-when-compile
|
||||
(if (boundp 'byte-compile-function-environment)
|
||||
(setq byte-compile-function-environment
|
||||
(delq (assq 'tex-mode byte-compile-function-environment)
|
||||
byte-compile-function-environment))))
|
||||
|
||||
;;;###autoload
|
||||
(defun tex-mode ()
|
||||
(define-derived-mode tex-mode text-mode "generic-TeX"
|
||||
"Major mode for editing files of input for TeX, LaTeX, or SliTeX.
|
||||
This is the shared parent mode of several submodes.
|
||||
Tries to determine (by looking at the beginning of the file) whether
|
||||
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
|
||||
`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
|
||||
`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
|
||||
such as if there are no commands in the file, the value of `tex-default-mode'
|
||||
says which mode to use."
|
||||
(interactive)
|
||||
(if delay-mode-hooks
|
||||
;; We're called from one of the children already.
|
||||
(tex-mode-internal)
|
||||
(tex-guess-mode)))
|
||||
(tex-common-initialization))
|
||||
|
||||
(advice-add 'tex-mode :around #'tex--redirect-to-submode)
|
||||
(defun tex--redirect-to-submode (orig-fun)
|
||||
"Redirect to one of the submodes when called directly."
|
||||
(funcall (if delay-mode-hooks
|
||||
;; We're called from one of the children already.
|
||||
orig-fun
|
||||
(tex--guess-mode))))
|
||||
|
||||
;; The following three autoloaded aliases appear to conflict with
|
||||
;; AUCTeX. However, even though AUCTeX uses the mixed case variants
|
||||
|
@ -1037,6 +1027,10 @@ says which mode to use."
|
|||
;; AUCTeX to provide a fully functional user-level replacement. So
|
||||
;; these aliases should remain as they are, in particular since AUCTeX
|
||||
;; users are likely to use them.
|
||||
;; Note from Stef: I don't understand the above explanation, the only
|
||||
;; justification I can find to keep those confusing aliases is for those
|
||||
;; users who may have files annotated with -*- LaTeX -*- (e.g. because they
|
||||
;; received them from someone using AUCTeX).
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'TeX-mode 'tex-mode)
|
||||
|
|
|
@ -2720,7 +2720,9 @@ hunk text is not found in the source file."
|
|||
;; When initialization is requested, we should be in a brand new
|
||||
;; temp buffer.
|
||||
(cl-assert (null buffer-file-name))
|
||||
(let ((enable-local-variables :safe) ;; to find `mode:'
|
||||
;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because
|
||||
;; Local Variables list might be incomplete when context is truncated.
|
||||
(let ((enable-local-variables (unless hunk-only :safe))
|
||||
(buffer-file-name file))
|
||||
;; Don't run hooks that might assume buffer-file-name
|
||||
;; really associates buffer with a file (bug#39190).
|
||||
|
|
|
@ -1286,6 +1286,16 @@ state of item at point, if any."
|
|||
(setq model (vc-checkout-model vc-dir-backend only-files-list))))
|
||||
(list vc-dir-backend files only-files-list state model)))
|
||||
|
||||
;;;###autoload
|
||||
(defun vc-dir-root ()
|
||||
"Run `vc-dir' in the repository root directory without prompt.
|
||||
If the default directory of the current buffer is
|
||||
not under version control, prompt for a directory."
|
||||
(interactive)
|
||||
(let ((root-dir (vc-root-dir)))
|
||||
(if root-dir (vc-dir root-dir)
|
||||
(call-interactively 'vc-dir))))
|
||||
|
||||
;;;###autoload
|
||||
(defun vc-dir (dir &optional backend)
|
||||
"Show the VC status for \"interesting\" files in and below DIR.
|
||||
|
@ -1309,7 +1319,7 @@ These are the commands available for use in the file status buffer:
|
|||
;; When you hit C-x v d in a visited VC file,
|
||||
;; the *vc-dir* buffer visits the directory under its truename;
|
||||
;; therefore it makes sense to always do that.
|
||||
;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
|
||||
;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d
|
||||
;; you may get a new *vc-dir* buffer, different from the original
|
||||
(file-truename (read-directory-name "VC status for directory: "
|
||||
(vc-root-dir) nil t
|
||||
|
|
|
@ -972,9 +972,9 @@ In the latter case, VC mode is deactivated for this buffer."
|
|||
(bindings--define-key map [vc-ignore]
|
||||
'(menu-item "Ignore File..." vc-ignore
|
||||
:help "Ignore a file under current version control system"))
|
||||
(bindings--define-key map [vc-dir]
|
||||
'(menu-item "VC Dir" vc-dir
|
||||
:help "Show the VC status of files in a directory"))
|
||||
(bindings--define-key map [vc-dir-root]
|
||||
'(menu-item "VC Dir" vc-dir-root
|
||||
:help "Show the VC status of the repository"))
|
||||
map))
|
||||
|
||||
(defalias 'vc-menu-map vc-menu-map)
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
# acl.m4 - check for access control list (ACL) primitives
|
||||
# serial 23
|
||||
# serial 24
|
||||
|
||||
# Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc.
|
||||
# This file is free software; the Free Software Foundation
|
||||
|
@ -139,7 +139,7 @@ int type = ACL_TYPE_EXTENDED;]])],
|
|||
AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.])
|
||||
fi
|
||||
fi
|
||||
test $gl_need_lib_has_acl && LIB_HAS_ACL=$LIB_ACL
|
||||
test -n "$gl_need_lib_has_acl" && LIB_HAS_ACL=$LIB_ACL
|
||||
AC_SUBST([LIB_ACL])
|
||||
AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl],
|
||||
[Define to nonzero if you want access control list support.])
|
||||
|
|
|
@ -69,7 +69,6 @@ AC_DEFUN([gl_EARLY],
|
|||
# Code from module diffseq:
|
||||
# Code from module dirent:
|
||||
# Code from module dirfd:
|
||||
# Code from module dosname:
|
||||
# Code from module double-slash-root:
|
||||
# Code from module dtoastr:
|
||||
# Code from module dtotimespec:
|
||||
|
@ -87,6 +86,7 @@ AC_DEFUN([gl_EARLY],
|
|||
# Code from module fcntl-h:
|
||||
# Code from module fdopendir:
|
||||
# Code from module filemode:
|
||||
# Code from module filename:
|
||||
# Code from module filevercmp:
|
||||
# Code from module flexmember:
|
||||
# Code from module fpending:
|
||||
|
@ -961,7 +961,6 @@ AC_DEFUN([gl_FILE_LIST], [
|
|||
lib/diffseq.h
|
||||
lib/dirent.in.h
|
||||
lib/dirfd.c
|
||||
lib/dosname.h
|
||||
lib/dtoastr.c
|
||||
lib/dtotimespec.c
|
||||
lib/dup2.c
|
||||
|
@ -977,6 +976,7 @@ AC_DEFUN([gl_FILE_LIST], [
|
|||
lib/fdopendir.c
|
||||
lib/filemode.c
|
||||
lib/filemode.h
|
||||
lib/filename.h
|
||||
lib/filevercmp.c
|
||||
lib/filevercmp.h
|
||||
lib/flexmember.h
|
||||
|
|
|
@ -55,7 +55,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT)
|
|||
ARG_NONNULL ((1, 2));
|
||||
extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long)
|
||||
ARG_NONNULL ((1, 2));
|
||||
extern double mpz_get_d_rounded (mpz_t const);
|
||||
extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST;
|
||||
|
||||
INLINE_HEADER_BEGIN
|
||||
|
||||
|
|
32
src/buffer.c
32
src/buffer.c
|
@ -131,6 +131,23 @@ CHECK_OVERLAY (Lisp_Object x)
|
|||
CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
|
||||
}
|
||||
|
||||
/* Convert the position POS to an EMACS_INT that fits in a fixnum.
|
||||
Yield POS's value if POS is already a fixnum, POS's marker position
|
||||
if POS is a marker, and MOST_NEGATIVE_FIXNUM or
|
||||
MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum.
|
||||
Signal an error if POS is not of the proper form. */
|
||||
|
||||
EMACS_INT
|
||||
fix_position (Lisp_Object pos)
|
||||
{
|
||||
if (FIXNUMP (pos))
|
||||
return XFIXNUM (pos);
|
||||
if (MARKERP (pos))
|
||||
return marker_position (pos);
|
||||
CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos);
|
||||
return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM;
|
||||
}
|
||||
|
||||
/* These setters are used only in this file, so they can be private.
|
||||
The public setters are inline functions defined in buffer.h. */
|
||||
static void
|
||||
|
@ -2257,19 +2274,20 @@ so the buffer is truly empty after this. */)
|
|||
}
|
||||
|
||||
void
|
||||
validate_region (register Lisp_Object *b, register Lisp_Object *e)
|
||||
validate_region (Lisp_Object *b, Lisp_Object *e)
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (*b);
|
||||
CHECK_FIXNUM_COERCE_MARKER (*e);
|
||||
EMACS_INT beg = fix_position (*b), end = fix_position (*e);
|
||||
|
||||
if (XFIXNUM (*b) > XFIXNUM (*e))
|
||||
if (end < beg)
|
||||
{
|
||||
Lisp_Object tem;
|
||||
tem = *b; *b = *e; *e = tem;
|
||||
EMACS_INT tem = beg; beg = end; end = tem;
|
||||
}
|
||||
|
||||
if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV))
|
||||
if (! (BEGV <= beg && end <= ZV))
|
||||
args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
|
||||
|
||||
*b = make_fixnum (beg);
|
||||
*e = make_fixnum (end);
|
||||
}
|
||||
|
||||
/* Advance BYTE_POS up to a character boundary
|
||||
|
|
|
@ -1150,6 +1150,8 @@ extern Lisp_Object interval_insert_behind_hooks;
|
|||
extern Lisp_Object interval_insert_in_front_hooks;
|
||||
|
||||
|
||||
extern EMACS_INT fix_position (Lisp_Object);
|
||||
#define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x)))
|
||||
extern void delete_all_overlays (struct buffer *);
|
||||
extern void reset_buffer (struct buffer *);
|
||||
extern void compact_buffer (struct buffer *);
|
||||
|
|
|
@ -931,10 +931,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (position);
|
||||
if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV)
|
||||
EMACS_INT fixed_pos = fix_position (position);
|
||||
if (! (BEGV <= fixed_pos && fixed_pos < ZV))
|
||||
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
|
||||
pos = XFIXNAT (position);
|
||||
pos = fixed_pos;
|
||||
p = CHAR_POS_ADDR (pos);
|
||||
}
|
||||
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
|
||||
|
|
15
src/cmds.c
15
src/cmds.c
|
@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
|
||||
static int internal_self_insert (int, EMACS_INT);
|
||||
|
||||
DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
|
||||
doc: /* Return buffer position N characters after (before if N negative) point. */)
|
||||
(Lisp_Object n)
|
||||
{
|
||||
CHECK_FIXNUM (n);
|
||||
|
||||
return make_fixnum (PT + XFIXNUM (n));
|
||||
}
|
||||
|
||||
/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
|
||||
Validate the new location. Return nil. */
|
||||
static Lisp_Object
|
||||
|
@ -460,7 +451,10 @@ internal_self_insert (int c, EMACS_INT n)
|
|||
string = concat2 (string, tem);
|
||||
}
|
||||
|
||||
replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0);
|
||||
ptrdiff_t to;
|
||||
if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
|
||||
to = PTRDIFF_MAX;
|
||||
replace_range (PT, to, string, 1, 1, 1, 0);
|
||||
Fforward_char (make_fixnum (n));
|
||||
}
|
||||
else if (n > 1)
|
||||
|
@ -526,7 +520,6 @@ syms_of_cmds (void)
|
|||
This is run after inserting the character. */);
|
||||
Vpost_self_insert_hook = Qnil;
|
||||
|
||||
defsubr (&Sforward_point);
|
||||
defsubr (&Sforward_char);
|
||||
defsubr (&Sbackward_char);
|
||||
defsubr (&Sforward_line);
|
||||
|
|
42
src/coding.c
42
src/coding.c
|
@ -9023,23 +9023,23 @@ DEFUN ("find-coding-systems-region-internal",
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start);
|
||||
CHECK_FIXNUM_COERCE_MARKER (end);
|
||||
if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end))
|
||||
EMACS_INT s = fix_position (start);
|
||||
EMACS_INT e = fix_position (end);
|
||||
if (! (BEG <= s && s <= e && e <= Z))
|
||||
args_out_of_range (start, end);
|
||||
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
|
||||
return Qt;
|
||||
start_byte = CHAR_TO_BYTE (XFIXNUM (start));
|
||||
end_byte = CHAR_TO_BYTE (XFIXNUM (end));
|
||||
if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte)
|
||||
start_byte = CHAR_TO_BYTE (s);
|
||||
end_byte = CHAR_TO_BYTE (e);
|
||||
if (e - s == end_byte - start_byte)
|
||||
return Qt;
|
||||
|
||||
if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
|
||||
if (s < GPT && GPT < e)
|
||||
{
|
||||
if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT))
|
||||
move_gap_both (XFIXNUM (start), start_byte);
|
||||
if (GPT - s < e - GPT)
|
||||
move_gap_both (s, start_byte);
|
||||
else
|
||||
move_gap_both (XFIXNUM (end), end_byte);
|
||||
move_gap_both (e, end_byte);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -9277,25 +9277,25 @@ is nil. */)
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start);
|
||||
CHECK_FIXNUM_COERCE_MARKER (end);
|
||||
if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end))
|
||||
EMACS_INT s = fix_position (start);
|
||||
EMACS_INT e = fix_position (end);
|
||||
if (! (BEG <= s && s <= e && e <= Z))
|
||||
args_out_of_range (start, end);
|
||||
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
|
||||
return Qnil;
|
||||
start_byte = CHAR_TO_BYTE (XFIXNUM (start));
|
||||
end_byte = CHAR_TO_BYTE (XFIXNUM (end));
|
||||
if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte)
|
||||
start_byte = CHAR_TO_BYTE (s);
|
||||
end_byte = CHAR_TO_BYTE (e);
|
||||
if (e - s == end_byte - start_byte)
|
||||
return Qnil;
|
||||
|
||||
if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
|
||||
if (s < GPT && GPT < e)
|
||||
{
|
||||
if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT))
|
||||
move_gap_both (XFIXNUM (start), start_byte);
|
||||
if (GPT - s < e - GPT)
|
||||
move_gap_both (s, start_byte);
|
||||
else
|
||||
move_gap_both (XFIXNUM (end), end_byte);
|
||||
move_gap_both (e, end_byte);
|
||||
}
|
||||
pos = XFIXNUM (start);
|
||||
pos = s;
|
||||
}
|
||||
|
||||
list = Qnil;
|
||||
|
|
|
@ -1839,27 +1839,24 @@ See `find-composition' for more details. */)
|
|||
ptrdiff_t start, end, from, to;
|
||||
int id;
|
||||
|
||||
CHECK_FIXNUM_COERCE_MARKER (pos);
|
||||
EMACS_INT fixed_pos = fix_position (pos);
|
||||
if (!NILP (limit))
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (limit);
|
||||
to = min (XFIXNUM (limit), ZV);
|
||||
}
|
||||
to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV);
|
||||
else
|
||||
to = -1;
|
||||
|
||||
if (!NILP (string))
|
||||
{
|
||||
CHECK_STRING (string);
|
||||
if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string))
|
||||
if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string)))
|
||||
args_out_of_range (string, pos);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV)
|
||||
if (! (BEGV <= fixed_pos && fixed_pos <= ZV))
|
||||
args_out_of_range (Fcurrent_buffer (), pos);
|
||||
}
|
||||
from = XFIXNUM (pos);
|
||||
from = fixed_pos;
|
||||
|
||||
if (!find_composition (from, to, &start, &end, &prop, string))
|
||||
{
|
||||
|
@ -1870,12 +1867,12 @@ See `find-composition' for more details. */)
|
|||
return list3 (make_fixnum (start), make_fixnum (end), gstring);
|
||||
return Qnil;
|
||||
}
|
||||
if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos)))
|
||||
if (! (start <= fixed_pos && fixed_pos < end))
|
||||
{
|
||||
ptrdiff_t s, e;
|
||||
|
||||
if (find_automatic_composition (from, to, &s, &e, &gstring, string)
|
||||
&& (e <= XFIXNUM (pos) ? e > end : s < start))
|
||||
&& (e <= fixed_pos ? e > end : s < start))
|
||||
return list3 (make_fixnum (s), make_fixnum (e), gstring);
|
||||
}
|
||||
if (!composition_valid_p (start, end, prop))
|
||||
|
|
77
src/data.c
77
src/data.c
|
@ -2368,6 +2368,24 @@ bool-vector. IDX starts at 0. */)
|
|||
|
||||
/* Arithmetic functions */
|
||||
|
||||
static Lisp_Object
|
||||
check_integer_coerce_marker (Lisp_Object x)
|
||||
{
|
||||
if (MARKERP (x))
|
||||
return make_fixnum (marker_position (x));
|
||||
CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x);
|
||||
return x;
|
||||
}
|
||||
|
||||
static Lisp_Object
|
||||
check_number_coerce_marker (Lisp_Object x)
|
||||
{
|
||||
if (MARKERP (x))
|
||||
return make_fixnum (marker_position (x));
|
||||
CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x);
|
||||
return x;
|
||||
}
|
||||
|
||||
Lisp_Object
|
||||
arithcompare (Lisp_Object num1, Lisp_Object num2,
|
||||
enum Arith_Comparison comparison)
|
||||
|
@ -2376,8 +2394,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
|
|||
bool lt, eq = true, gt;
|
||||
bool test;
|
||||
|
||||
CHECK_NUMBER_COERCE_MARKER (num1);
|
||||
CHECK_NUMBER_COERCE_MARKER (num2);
|
||||
num1 = check_number_coerce_marker (num1);
|
||||
num2 = check_number_coerce_marker (num2);
|
||||
|
||||
/* If the comparison is mostly done by comparing two doubles,
|
||||
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,
|
|||
argnum++;
|
||||
if (argnum == nargs)
|
||||
return make_float (accum);
|
||||
Lisp_Object val = args[argnum];
|
||||
CHECK_NUMBER_COERCE_MARKER (val);
|
||||
next = XFLOATINT (val);
|
||||
next = XFLOATINT (check_number_coerce_marker (args[argnum]));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2843,8 +2859,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
|
|||
argnum++;
|
||||
if (argnum == nargs)
|
||||
return make_integer_mpz ();
|
||||
val = args[argnum];
|
||||
CHECK_NUMBER_COERCE_MARKER (val);
|
||||
val = check_number_coerce_marker (args[argnum]);
|
||||
if (FLOATP (val))
|
||||
return float_arith_driver (code, nargs, args, argnum,
|
||||
mpz_get_d_rounded (*accum), val);
|
||||
|
@ -2873,8 +2888,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
|
|||
argnum++;
|
||||
if (argnum == nargs)
|
||||
return make_int (accum);
|
||||
val = args[argnum];
|
||||
CHECK_NUMBER_COERCE_MARKER (val);
|
||||
val = check_number_coerce_marker (args[argnum]);
|
||||
|
||||
/* Set NEXT to the next value if it fits, else exit the loop. */
|
||||
intmax_t next;
|
||||
|
@ -2921,8 +2935,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */)
|
|||
{
|
||||
if (nargs == 0)
|
||||
return make_fixnum (0);
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_NUMBER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_number_coerce_marker (args[0]);
|
||||
return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a);
|
||||
}
|
||||
|
||||
|
@ -2935,8 +2948,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
|
|||
{
|
||||
if (nargs == 0)
|
||||
return make_fixnum (0);
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_NUMBER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_number_coerce_marker (args[0]);
|
||||
if (nargs == 1)
|
||||
{
|
||||
if (FIXNUMP (a))
|
||||
|
@ -2956,8 +2968,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
|
|||
{
|
||||
if (nargs == 0)
|
||||
return make_fixnum (1);
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_NUMBER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_number_coerce_marker (args[0]);
|
||||
return nargs == 1 ? a : arith_driver (Amult, nargs, args, a);
|
||||
}
|
||||
|
||||
|
@ -2969,8 +2980,7 @@ The arguments must be numbers or markers.
|
|||
usage: (/ NUMBER &rest DIVISORS) */)
|
||||
(ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_NUMBER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_number_coerce_marker (args[0]);
|
||||
if (nargs == 1)
|
||||
{
|
||||
if (FIXNUMP (a))
|
||||
|
@ -3052,10 +3062,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
|
|||
DEFUN ("%", Frem, Srem, 2, 2, 0,
|
||||
doc: /* Return remainder of X divided by Y.
|
||||
Both must be integers or markers. */)
|
||||
(register Lisp_Object x, Lisp_Object y)
|
||||
(Lisp_Object x, Lisp_Object y)
|
||||
{
|
||||
CHECK_INTEGER_COERCE_MARKER (x);
|
||||
CHECK_INTEGER_COERCE_MARKER (y);
|
||||
x = check_integer_coerce_marker (x);
|
||||
y = check_integer_coerce_marker (y);
|
||||
return integer_remainder (x, y, false);
|
||||
}
|
||||
|
||||
|
@ -3065,8 +3075,8 @@ The result falls between zero (inclusive) and Y (exclusive).
|
|||
Both X and Y must be numbers or markers. */)
|
||||
(Lisp_Object x, Lisp_Object y)
|
||||
{
|
||||
CHECK_NUMBER_COERCE_MARKER (x);
|
||||
CHECK_NUMBER_COERCE_MARKER (y);
|
||||
x = check_number_coerce_marker (x);
|
||||
y = check_number_coerce_marker (y);
|
||||
if (FLOATP (x) || FLOATP (y))
|
||||
return fmod_float (x, y);
|
||||
return integer_remainder (x, y, true);
|
||||
|
@ -3076,12 +3086,10 @@ static Lisp_Object
|
|||
minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
|
||||
enum Arith_Comparison comparison)
|
||||
{
|
||||
Lisp_Object accum = args[0];
|
||||
CHECK_NUMBER_COERCE_MARKER (accum);
|
||||
Lisp_Object accum = check_number_coerce_marker (args[0]);
|
||||
for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
|
||||
{
|
||||
Lisp_Object val = args[argnum];
|
||||
CHECK_NUMBER_COERCE_MARKER (val);
|
||||
Lisp_Object val = check_number_coerce_marker (args[argnum]);
|
||||
if (!NILP (arithcompare (val, accum, comparison)))
|
||||
accum = val;
|
||||
else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
|
||||
|
@ -3116,8 +3124,7 @@ usage: (logand &rest INTS-OR-MARKERS) */)
|
|||
{
|
||||
if (nargs == 0)
|
||||
return make_fixnum (-1);
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_INTEGER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_integer_coerce_marker (args[0]);
|
||||
return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a);
|
||||
}
|
||||
|
||||
|
@ -3129,8 +3136,7 @@ usage: (logior &rest INTS-OR-MARKERS) */)
|
|||
{
|
||||
if (nargs == 0)
|
||||
return make_fixnum (0);
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_INTEGER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_integer_coerce_marker (args[0]);
|
||||
return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a);
|
||||
}
|
||||
|
||||
|
@ -3142,8 +3148,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */)
|
|||
{
|
||||
if (nargs == 0)
|
||||
return make_fixnum (0);
|
||||
Lisp_Object a = args[0];
|
||||
CHECK_INTEGER_COERCE_MARKER (a);
|
||||
Lisp_Object a = check_integer_coerce_marker (args[0]);
|
||||
return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a);
|
||||
}
|
||||
|
||||
|
@ -3262,9 +3267,9 @@ expt_integer (Lisp_Object x, Lisp_Object y)
|
|||
DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
|
||||
doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
|
||||
Markers are converted to integers. */)
|
||||
(register Lisp_Object number)
|
||||
(Lisp_Object number)
|
||||
{
|
||||
CHECK_NUMBER_COERCE_MARKER (number);
|
||||
number = check_number_coerce_marker (number);
|
||||
|
||||
if (FIXNUMP (number))
|
||||
return make_int (XFIXNUM (number) + 1);
|
||||
|
@ -3277,9 +3282,9 @@ Markers are converted to integers. */)
|
|||
DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
|
||||
doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
|
||||
Markers are converted to integers. */)
|
||||
(register Lisp_Object number)
|
||||
(Lisp_Object number)
|
||||
{
|
||||
CHECK_NUMBER_COERCE_MARKER (number);
|
||||
number = check_number_coerce_marker (number);
|
||||
|
||||
if (FIXNUMP (number))
|
||||
return make_int (XFIXNUM (number) - 1);
|
||||
|
|
121
src/editfns.c
121
src/editfns.c
|
@ -725,18 +725,23 @@ boundaries, bind `inhibit-field-text-motion' to t.
|
|||
This function does not move point. */)
|
||||
(Lisp_Object n)
|
||||
{
|
||||
ptrdiff_t charpos, bytepos;
|
||||
ptrdiff_t charpos, bytepos, count;
|
||||
|
||||
if (NILP (n))
|
||||
XSETFASTINT (n, 1);
|
||||
count = 0;
|
||||
else if (FIXNUMP (n))
|
||||
count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX);
|
||||
else
|
||||
CHECK_FIXNUM (n);
|
||||
{
|
||||
CHECK_INTEGER (n);
|
||||
count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
|
||||
}
|
||||
|
||||
scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos);
|
||||
scan_newline_from_point (count, &charpos, &bytepos);
|
||||
|
||||
/* Return END constrained to the current input field. */
|
||||
return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT),
|
||||
XFIXNUM (n) != 1 ? Qt : Qnil,
|
||||
count != 0 ? Qt : Qnil,
|
||||
Qt, Qnil);
|
||||
}
|
||||
|
||||
|
@ -763,11 +768,14 @@ This function does not move point. */)
|
|||
ptrdiff_t orig = PT;
|
||||
|
||||
if (NILP (n))
|
||||
XSETFASTINT (n, 1);
|
||||
clipped_n = 1;
|
||||
else if (FIXNUMP (n))
|
||||
clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX);
|
||||
else
|
||||
CHECK_FIXNUM (n);
|
||||
|
||||
clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX);
|
||||
{
|
||||
CHECK_INTEGER (n);
|
||||
clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
|
||||
}
|
||||
end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),
|
||||
NULL);
|
||||
|
||||
|
@ -940,10 +948,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
|
|||
If POSITION is out of range, the value is nil. */)
|
||||
(Lisp_Object position)
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (position);
|
||||
if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z)
|
||||
EMACS_INT pos = fix_position (position);
|
||||
if (! (BEG <= pos && pos <= Z))
|
||||
return Qnil;
|
||||
return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position)));
|
||||
return make_fixnum (CHAR_TO_BYTE (pos));
|
||||
}
|
||||
|
||||
DEFUN ("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. */)
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (pos);
|
||||
if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV)
|
||||
EMACS_INT p = fix_position (pos);
|
||||
if (! (BEGV <= p && p < ZV))
|
||||
return Qnil;
|
||||
|
||||
pos_byte = CHAR_TO_BYTE (XFIXNUM (pos));
|
||||
pos_byte = CHAR_TO_BYTE (p);
|
||||
}
|
||||
|
||||
return make_fixnum (FETCH_CHAR (pos_byte));
|
||||
|
@ -1094,12 +1102,12 @@ If POS is out of range, the value is nil. */)
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (pos);
|
||||
EMACS_INT p = fix_position (pos);
|
||||
|
||||
if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV)
|
||||
if (! (BEGV < p && p <= ZV))
|
||||
return Qnil;
|
||||
|
||||
pos_byte = CHAR_TO_BYTE (XFIXNUM (pos));
|
||||
pos_byte = CHAR_TO_BYTE (p);
|
||||
}
|
||||
|
||||
if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
|
||||
|
@ -1718,21 +1726,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */)
|
|||
if (!BUFFER_LIVE_P (bp))
|
||||
error ("Selecting deleted buffer");
|
||||
|
||||
if (NILP (start))
|
||||
b = BUF_BEGV (bp);
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start);
|
||||
b = XFIXNUM (start);
|
||||
}
|
||||
if (NILP (end))
|
||||
e = BUF_ZV (bp);
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (end);
|
||||
e = XFIXNUM (end);
|
||||
}
|
||||
|
||||
b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp);
|
||||
e = !NILP (end) ? fix_position (end) : BUF_ZV (bp);
|
||||
if (b > e)
|
||||
temp = b, b = e, e = temp;
|
||||
|
||||
|
@ -1786,21 +1781,8 @@ determines whether case is significant or ignored. */)
|
|||
error ("Selecting deleted buffer");
|
||||
}
|
||||
|
||||
if (NILP (start1))
|
||||
begp1 = BUF_BEGV (bp1);
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start1);
|
||||
begp1 = XFIXNUM (start1);
|
||||
}
|
||||
if (NILP (end1))
|
||||
endp1 = BUF_ZV (bp1);
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (end1);
|
||||
endp1 = XFIXNUM (end1);
|
||||
}
|
||||
|
||||
begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1);
|
||||
endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1);
|
||||
if (begp1 > endp1)
|
||||
temp = begp1, begp1 = endp1, endp1 = temp;
|
||||
|
||||
|
@ -1824,21 +1806,8 @@ determines whether case is significant or ignored. */)
|
|||
error ("Selecting deleted buffer");
|
||||
}
|
||||
|
||||
if (NILP (start2))
|
||||
begp2 = BUF_BEGV (bp2);
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start2);
|
||||
begp2 = XFIXNUM (start2);
|
||||
}
|
||||
if (NILP (end2))
|
||||
endp2 = BUF_ZV (bp2);
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (end2);
|
||||
endp2 = XFIXNUM (end2);
|
||||
}
|
||||
|
||||
begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2);
|
||||
endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2);
|
||||
if (begp2 > endp2)
|
||||
temp = begp2, begp2 = endp2, endp2 = temp;
|
||||
|
||||
|
@ -2692,29 +2661,27 @@ See also `save-restriction'.
|
|||
When calling from Lisp, pass two arguments START and END:
|
||||
positions (integers or markers) bounding the text that should
|
||||
remain visible. */)
|
||||
(register Lisp_Object start, Lisp_Object end)
|
||||
(Lisp_Object start, Lisp_Object end)
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start);
|
||||
CHECK_FIXNUM_COERCE_MARKER (end);
|
||||
EMACS_INT s = fix_position (start), e = fix_position (end);
|
||||
|
||||
if (XFIXNUM (start) > XFIXNUM (end))
|
||||
if (e < s)
|
||||
{
|
||||
Lisp_Object tem;
|
||||
tem = start; start = end; end = tem;
|
||||
EMACS_INT tem = s; s = e; e = tem;
|
||||
}
|
||||
|
||||
if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z))
|
||||
if (!(BEG <= s && s <= e && e <= Z))
|
||||
args_out_of_range (start, end);
|
||||
|
||||
if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end))
|
||||
if (BEGV != s || ZV != e)
|
||||
current_buffer->clip_changed = 1;
|
||||
|
||||
SET_BUF_BEGV (current_buffer, XFIXNAT (start));
|
||||
SET_BUF_ZV (current_buffer, XFIXNAT (end));
|
||||
if (PT < XFIXNAT (start))
|
||||
SET_PT (XFIXNAT (start));
|
||||
if (PT > XFIXNAT (end))
|
||||
SET_PT (XFIXNAT (end));
|
||||
SET_BUF_BEGV (current_buffer, s);
|
||||
SET_BUF_ZV (current_buffer, e);
|
||||
if (PT < s)
|
||||
SET_PT (s);
|
||||
if (e < PT)
|
||||
SET_PT (e);
|
||||
/* Changing the buffer bounds invalidates any recorded current column. */
|
||||
invalidate_current_column ();
|
||||
return Qnil;
|
||||
|
|
|
@ -88,6 +88,7 @@ To add a new module function, proceed as follows:
|
|||
#include "dynlib.h"
|
||||
#include "coding.h"
|
||||
#include "keyboard.h"
|
||||
#include "process.h"
|
||||
#include "syssignal.h"
|
||||
#include "sysstdio.h"
|
||||
#include "thread.h"
|
||||
|
@ -977,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign,
|
|||
return lisp_to_value (env, make_integer_mpz ());
|
||||
}
|
||||
|
||||
static int
|
||||
module_open_channel (emacs_env *env, emacs_value pipe_process)
|
||||
{
|
||||
MODULE_FUNCTION_BEGIN (-1);
|
||||
return open_channel_for_module (value_to_lisp (pipe_process));
|
||||
}
|
||||
|
||||
|
||||
/* Subroutines. */
|
||||
|
||||
|
@ -1391,6 +1399,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
|
|||
env->make_big_integer = module_make_big_integer;
|
||||
env->get_function_finalizer = module_get_function_finalizer;
|
||||
env->set_function_finalizer = module_set_function_finalizer;
|
||||
env->open_channel = module_open_channel;
|
||||
Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
|
||||
return env;
|
||||
}
|
||||
|
|
|
@ -96,7 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include <acl.h>
|
||||
#include <allocator.h>
|
||||
#include <careadlinkat.h>
|
||||
#include <dosname.h>
|
||||
#include <filename.h>
|
||||
#include <fsusage.h>
|
||||
#include <stat-time.h>
|
||||
#include <tempname.h>
|
||||
|
|
|
@ -661,7 +661,7 @@ void
|
|||
lock_file (Lisp_Object fn)
|
||||
{
|
||||
Lisp_Object orig_fn, encoded_fn;
|
||||
char *lfname;
|
||||
char *lfname = NULL;
|
||||
lock_info_type lock_info;
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
|
@ -686,21 +686,15 @@ lock_file (Lisp_Object fn)
|
|||
|
||||
/* See if this file is visited and has changed on disk since it was
|
||||
visited. */
|
||||
{
|
||||
register Lisp_Object subject_buf;
|
||||
|
||||
subject_buf = get_truename_buffer (orig_fn);
|
||||
|
||||
if (!NILP (subject_buf)
|
||||
&& NILP (Fverify_visited_file_modtime (subject_buf))
|
||||
&& !NILP (Ffile_exists_p (fn))
|
||||
&& (!create_lockfiles || current_lock_owner (NULL, lfname) != -2))
|
||||
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
|
||||
|
||||
}
|
||||
Lisp_Object subject_buf = get_truename_buffer (orig_fn);
|
||||
if (!NILP (subject_buf)
|
||||
&& NILP (Fverify_visited_file_modtime (subject_buf))
|
||||
&& !NILP (Ffile_exists_p (fn))
|
||||
&& !(lfname && current_lock_owner (NULL, lfname) == -2))
|
||||
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
|
||||
|
||||
/* Don't do locking if the user has opted out. */
|
||||
if (create_lockfiles)
|
||||
if (lfname)
|
||||
{
|
||||
/* Try to lock the lock. FIXME: This ignores errors when
|
||||
lock_if_free returns a positive errno value. */
|
||||
|
@ -860,7 +854,7 @@ syms_of_filelock (void)
|
|||
The name of the (per-buffer) lockfile is constructed by prepending a
|
||||
'.#' to the name of the file being locked. See also `lock-buffer' and
|
||||
Info node `(emacs)Interlocking'. */);
|
||||
create_lockfiles = 1;
|
||||
create_lockfiles = true;
|
||||
|
||||
defsubr (&Sunlock_buffer);
|
||||
defsubr (&Slock_buffer);
|
||||
|
|
18
src/fns.c
18
src/fns.c
|
@ -5187,22 +5187,8 @@ extract_data_from_object (Lisp_Object spec,
|
|||
struct buffer *bp = XBUFFER (object);
|
||||
set_buffer_internal (bp);
|
||||
|
||||
if (NILP (start))
|
||||
b = BEGV;
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (start);
|
||||
b = XFIXNUM (start);
|
||||
}
|
||||
|
||||
if (NILP (end))
|
||||
e = ZV;
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (end);
|
||||
e = XFIXNUM (end);
|
||||
}
|
||||
|
||||
b = !NILP (start) ? fix_position (start) : BEGV;
|
||||
e = !NILP (end) ? fix_position (end) : ZV;
|
||||
if (b > e)
|
||||
{
|
||||
EMACS_INT temp = b;
|
||||
|
|
16
src/font.c
16
src/font.c
|
@ -4606,10 +4606,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
|
|||
Lisp_Object window;
|
||||
struct window *w;
|
||||
|
||||
CHECK_FIXNUM_COERCE_MARKER (position);
|
||||
if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV))
|
||||
EMACS_INT fixed_pos = fix_position (position);
|
||||
if (! (BEGV <= fixed_pos && fixed_pos < ZV))
|
||||
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
|
||||
pos = XFIXNUM (position);
|
||||
pos = fixed_pos;
|
||||
pos_byte = CHAR_TO_BYTE (pos);
|
||||
if (NILP (ch))
|
||||
c = FETCH_CHAR (pos_byte);
|
||||
|
@ -5013,24 +5013,26 @@ character at index specified by POSITION. */)
|
|||
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
|
||||
{
|
||||
struct window *w = decode_live_window (window);
|
||||
EMACS_INT pos;
|
||||
|
||||
if (NILP (string))
|
||||
{
|
||||
if (XBUFFER (w->contents) != current_buffer)
|
||||
error ("Specified window is not displaying the current buffer");
|
||||
CHECK_FIXNUM_COERCE_MARKER (position);
|
||||
if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV))
|
||||
pos = fix_position (position);
|
||||
if (! (BEGV <= pos && pos < ZV))
|
||||
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
|
||||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM (position);
|
||||
CHECK_STRING (string);
|
||||
if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string)))
|
||||
pos = XFIXNUM (position);
|
||||
if (! (0 <= pos && pos < SCHARS (string)))
|
||||
args_out_of_range (string, position);
|
||||
}
|
||||
|
||||
return font_at (-1, XFIXNUM (position), NULL, w, string);
|
||||
return font_at (-1, pos, NULL, w, string);
|
||||
}
|
||||
|
||||
#if 0
|
||||
|
|
|
@ -1675,10 +1675,10 @@ Return nil if POS is not visible in WINDOW. */)
|
|||
|
||||
if (!NILP (pos))
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (pos);
|
||||
if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV))
|
||||
EMACS_INT p = fix_position (pos);
|
||||
if (! (BEGV <= p && p <= ZV))
|
||||
args_out_of_range (window, pos);
|
||||
textpos = XFIXNUM (pos);
|
||||
textpos = p;
|
||||
}
|
||||
else if (w == XWINDOW (selected_window))
|
||||
textpos = PT;
|
||||
|
|
32
src/lisp.h
32
src/lisp.h
|
@ -585,7 +585,7 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
|
|||
Lisp_Object);
|
||||
|
||||
/* Defined in bignum.c. */
|
||||
extern double bignum_to_double (Lisp_Object);
|
||||
extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST;
|
||||
extern Lisp_Object make_bigint (intmax_t);
|
||||
extern Lisp_Object make_biguint (uintmax_t);
|
||||
|
||||
|
@ -3023,14 +3023,6 @@ CHECK_FIXNAT (Lisp_Object x)
|
|||
CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
|
||||
} while (false)
|
||||
|
||||
#define CHECK_FIXNUM_COERCE_MARKER(x) \
|
||||
do { \
|
||||
if (MARKERP ((x))) \
|
||||
XSETFASTINT (x, marker_position (x)); \
|
||||
else \
|
||||
CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \
|
||||
} while (false)
|
||||
|
||||
INLINE double
|
||||
XFLOATINT (Lisp_Object n)
|
||||
{
|
||||
|
@ -3050,22 +3042,6 @@ CHECK_INTEGER (Lisp_Object x)
|
|||
{
|
||||
CHECK_TYPE (INTEGERP (x), Qnumberp, x);
|
||||
}
|
||||
|
||||
#define CHECK_NUMBER_COERCE_MARKER(x) \
|
||||
do { \
|
||||
if (MARKERP (x)) \
|
||||
XSETFASTINT (x, marker_position (x)); \
|
||||
else \
|
||||
CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \
|
||||
} while (false)
|
||||
|
||||
#define CHECK_INTEGER_COERCE_MARKER(x) \
|
||||
do { \
|
||||
if (MARKERP (x)) \
|
||||
XSETFASTINT (x, marker_position (x)); \
|
||||
else \
|
||||
CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \
|
||||
} while (false)
|
||||
|
||||
|
||||
/* 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)
|
|||
|
||||
/* Defined in bignum.c. This part of bignum.c's API does not require
|
||||
the caller to access bignum internals; see bignum.h for that. */
|
||||
extern intmax_t bignum_to_intmax (Lisp_Object);
|
||||
extern uintmax_t bignum_to_uintmax (Lisp_Object);
|
||||
extern ptrdiff_t bignum_bufsize (Lisp_Object, int);
|
||||
extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST;
|
||||
extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST;
|
||||
extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST;
|
||||
extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
|
||||
extern Lisp_Object bignum_to_string (Lisp_Object, int);
|
||||
extern Lisp_Object make_bignum_str (char const *, int);
|
||||
|
|
|
@ -9,3 +9,6 @@
|
|||
void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
|
||||
void (*fin) (void *) EMACS_NOEXCEPT)
|
||||
EMACS_ATTRIBUTE_NONNULL (1);
|
||||
|
||||
int (*open_channel) (emacs_env *env, emacs_value pipe_process)
|
||||
EMACS_ATTRIBUTE_NONNULL (1);
|
||||
|
|
|
@ -8200,6 +8200,17 @@ restore_nofile_limit (void)
|
|||
#endif
|
||||
}
|
||||
|
||||
int
|
||||
open_channel_for_module (Lisp_Object process)
|
||||
{
|
||||
CHECK_PROCESS (process);
|
||||
CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
|
||||
int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
|
||||
if (fd == -1)
|
||||
report_file_error ("Cannot duplicate file descriptor", Qnil);
|
||||
return fd;
|
||||
}
|
||||
|
||||
|
||||
/* This is not called "init_process" because that is the name of a
|
||||
Mach system call, so it would cause problems on Darwin systems. */
|
||||
|
@ -8446,6 +8457,7 @@ amounts of data in one go. */);
|
|||
DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
|
||||
|
||||
DEFSYM (Qnull, "null");
|
||||
DEFSYM (Qpipe_process_p, "pipe-process-p");
|
||||
|
||||
defsubr (&Sprocessp);
|
||||
defsubr (&Sget_process);
|
||||
|
|
|
@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object);
|
|||
extern void update_processes_for_thread_death (Lisp_Object);
|
||||
extern void dissociate_controlling_tty (void);
|
||||
|
||||
extern int open_channel_for_module (Lisp_Object);
|
||||
|
||||
INLINE_HEADER_END
|
||||
|
||||
#endif /* EMACS_PROCESS_H */
|
||||
|
|
|
@ -1028,8 +1028,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (bound);
|
||||
lim = XFIXNUM (bound);
|
||||
lim = fix_position (bound);
|
||||
if (n > 0 ? lim < PT : lim > PT)
|
||||
error ("Invalid search bound (wrong side of point)");
|
||||
if (lim > ZV)
|
||||
|
|
|
@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
|
|||
{
|
||||
INTERVAL i;
|
||||
ptrdiff_t searchpos;
|
||||
Lisp_Object begin0 = *begin, end0 = *end;
|
||||
|
||||
CHECK_STRING_OR_BUFFER (object);
|
||||
CHECK_FIXNUM_COERCE_MARKER (*begin);
|
||||
|
@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
|
|||
|
||||
if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
|
||||
&& XFIXNUM (*end) <= BUF_ZV (b)))
|
||||
args_out_of_range (*begin, *end);
|
||||
args_out_of_range (begin0, end0);
|
||||
i = buffer_intervals (b);
|
||||
|
||||
/* If there's no text, there are no properties. */
|
||||
|
@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
|
|||
|
||||
if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
|
||||
&& XFIXNUM (*end) <= len))
|
||||
args_out_of_range (*begin, *end);
|
||||
args_out_of_range (begin0, end0);
|
||||
i = string_intervals (object);
|
||||
|
||||
if (len == 0)
|
||||
|
@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
|
|||
{
|
||||
struct window *w = 0;
|
||||
|
||||
CHECK_FIXNUM_COERCE_MARKER (position);
|
||||
EMACS_INT pos = fix_position (position);
|
||||
|
||||
if (NILP (object))
|
||||
XSETBUFFER (object, current_buffer);
|
||||
|
@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
|
|||
Lisp_Object *overlay_vec;
|
||||
struct buffer *obuf = current_buffer;
|
||||
|
||||
if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object))
|
||||
|| XFIXNUM (position) > BUF_ZV (XBUFFER (object)))
|
||||
if (! (BUF_BEGV (XBUFFER (object)) <= pos
|
||||
&& pos <= BUF_ZV (XBUFFER (object))))
|
||||
xsignal1 (Qargs_out_of_range, position);
|
||||
|
||||
set_buffer_temp (XBUFFER (object));
|
||||
|
||||
USE_SAFE_ALLOCA;
|
||||
GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false);
|
||||
GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
|
||||
noverlays = sort_overlays (overlay_vec, noverlays, w);
|
||||
|
||||
set_buffer_temp (obuf);
|
||||
|
@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
|
|||
|
||||
/* Not a buffer, or no appropriate overlay, so fall through to the
|
||||
simpler case. */
|
||||
return Fget_text_property (position, prop, object);
|
||||
return Fget_text_property (make_fixnum (pos), prop, object);
|
||||
}
|
||||
|
||||
DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
|
||||
|
|
|
@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number
|
|||
if (EQ (pos, Qt))
|
||||
posint = -1;
|
||||
else if (!NILP (pos))
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (pos);
|
||||
posint = XFIXNUM (pos);
|
||||
}
|
||||
posint = fix_position (pos);
|
||||
else if (w == XWINDOW (selected_window))
|
||||
posint = PT;
|
||||
else
|
||||
|
|
20
src/xdisp.c
20
src/xdisp.c
|
@ -815,11 +815,6 @@ static struct props it_props[] =
|
|||
{0, 0, NULL}
|
||||
};
|
||||
|
||||
/* Value is the position described by X. If X is a marker, value is
|
||||
the marker_position of X. Otherwise, value is X. */
|
||||
|
||||
#define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X))
|
||||
|
||||
/* Enumeration returned by some move_it_.* functions internally. */
|
||||
|
||||
enum move_it_result
|
||||
|
@ -10418,10 +10413,7 @@ include the height of both, if present, in the return value. */)
|
|||
start = pos;
|
||||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (from);
|
||||
start = min (max (XFIXNUM (from), BEGV), ZV);
|
||||
}
|
||||
start = clip_to_bounds (BEGV, fix_position (from), ZV);
|
||||
|
||||
if (NILP (to))
|
||||
end = ZV;
|
||||
|
@ -10435,10 +10427,7 @@ include the height of both, if present, in the return value. */)
|
|||
end = pos;
|
||||
}
|
||||
else
|
||||
{
|
||||
CHECK_FIXNUM_COERCE_MARKER (to);
|
||||
end = max (start, min (XFIXNUM (to), ZV));
|
||||
}
|
||||
end = clip_to_bounds (start, fix_position (to), ZV);
|
||||
|
||||
if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX))
|
||||
max_x = XFIXNUM (x_limit);
|
||||
|
@ -14944,7 +14933,7 @@ overlay_arrows_changed_p (bool set_redisplay)
|
|||
val = find_symbol_value (var);
|
||||
if (!MARKERP (val))
|
||||
continue;
|
||||
if (! EQ (COERCE_MARKER (val),
|
||||
if (! EQ (Fmarker_position (val),
|
||||
/* FIXME: Don't we have a problem, using such a global
|
||||
* "last-position" if the variable is buffer-local? */
|
||||
Fget (var, Qlast_arrow_position))
|
||||
|
@ -14987,8 +14976,7 @@ update_overlay_arrows (int up_to_date)
|
|||
Lisp_Object val = find_symbol_value (var);
|
||||
if (!MARKERP (val))
|
||||
continue;
|
||||
Fput (var, Qlast_arrow_position,
|
||||
COERCE_MARKER (val));
|
||||
Fput (var, Qlast_arrow_position, Fmarker_position (val));
|
||||
Fput (var, Qlast_arrow_string,
|
||||
overlay_arrow_string_or_property (var));
|
||||
}
|
||||
|
|
|
@ -30,6 +30,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include <string.h>
|
||||
#include <time.h>
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
/* Cannot include <process.h> because of the local header by the same
|
||||
name, sigh. */
|
||||
uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *);
|
||||
# if !defined __x86_64__
|
||||
# define ALIGN_STACK __attribute__((force_align_arg_pointer))
|
||||
# endif
|
||||
# include <windows.h> /* for Sleep */
|
||||
#else /* !WINDOWSNT */
|
||||
# include <pthread.h>
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_GMP
|
||||
#include <gmp.h>
|
||||
#else
|
||||
|
@ -299,7 +312,7 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
|
|||
}
|
||||
|
||||
/* An invalid finalizer: Finalizers are run during garbage collection,
|
||||
where Lisp code can’t be executed. -module-assertions tests for
|
||||
where Lisp code can't be executed. -module-assertions tests for
|
||||
this case. */
|
||||
|
||||
static emacs_env *current_env;
|
||||
|
@ -320,9 +333,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
|
|||
}
|
||||
|
||||
static void
|
||||
signal_errno (emacs_env *env, const char *function)
|
||||
signal_system_error (emacs_env *env, int error, const char *function)
|
||||
{
|
||||
const char *message = strerror (errno);
|
||||
const char *message = strerror (error);
|
||||
emacs_value message_value = env->make_string (env, message, strlen (message));
|
||||
emacs_value symbol = env->intern (env, "file-error");
|
||||
emacs_value elements[2]
|
||||
|
@ -331,6 +344,12 @@ signal_errno (emacs_env *env, const char *function)
|
|||
env->non_local_exit_signal (env, symbol, data);
|
||||
}
|
||||
|
||||
static void
|
||||
signal_errno (emacs_env *env, const char *function)
|
||||
{
|
||||
signal_system_error (env, errno, function);
|
||||
}
|
||||
|
||||
/* A long-running operation that occasionally calls `should_quit' or
|
||||
`process_input'. */
|
||||
|
||||
|
@ -533,6 +552,73 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
|
|||
return env->funcall (env, Flist, 2, list_args);
|
||||
}
|
||||
|
||||
static void
|
||||
sleep_for_half_second (void)
|
||||
{
|
||||
/* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */
|
||||
#ifdef WINDOWSNT
|
||||
Sleep (500);
|
||||
#else
|
||||
const struct timespec sleep = {0, 500000000};
|
||||
if (nanosleep (&sleep, NULL) != 0)
|
||||
perror ("nanosleep");
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
static void ALIGN_STACK
|
||||
#else
|
||||
static void *
|
||||
#endif
|
||||
write_to_pipe (void *arg)
|
||||
{
|
||||
/* We sleep a bit to test that writing to a pipe is indeed possible
|
||||
if no environment is active. */
|
||||
sleep_for_half_second ();
|
||||
FILE *stream = arg;
|
||||
/* The string below should be identical to the one we compare with
|
||||
in emacs-module-tests.el:module/async-pipe. */
|
||||
if (fputs ("data from thread", stream) < 0)
|
||||
perror ("fputs");
|
||||
if (fclose (stream) != 0)
|
||||
perror ("close");
|
||||
#ifndef WINDOWSNT
|
||||
return NULL;
|
||||
#endif
|
||||
}
|
||||
|
||||
static emacs_value
|
||||
Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
|
||||
void *data)
|
||||
{
|
||||
assert (nargs == 1);
|
||||
int fd = env->open_channel (env, args[0]);
|
||||
if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
|
||||
return NULL;
|
||||
FILE *stream = fdopen (fd, "w");
|
||||
if (stream == NULL)
|
||||
{
|
||||
signal_errno (env, "fdopen");
|
||||
return NULL;
|
||||
}
|
||||
#ifdef WINDOWSNT
|
||||
uintptr_t thd = _beginthread (write_to_pipe, 0, stream);
|
||||
int error = (thd == (uintptr_t)-1L) ? errno : 0;
|
||||
#else /* !WINDOWSNT */
|
||||
pthread_t thread;
|
||||
int error
|
||||
= pthread_create (&thread, NULL, write_to_pipe, stream);
|
||||
#endif
|
||||
if (error != 0)
|
||||
{
|
||||
signal_system_error (env, error, "thread create");
|
||||
if (fclose (stream) != 0)
|
||||
perror ("fclose");
|
||||
return NULL;
|
||||
}
|
||||
return env->intern (env, "nil");
|
||||
}
|
||||
|
||||
/* Lisp utilities for easier readability (simple wrappers). */
|
||||
|
||||
/* Provide FEATURE to Emacs. */
|
||||
|
@ -614,6 +700,7 @@ emacs_module_init (struct emacs_runtime *ert)
|
|||
Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
|
||||
DEFUN ("mod-test-function-finalizer-calls",
|
||||
Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
|
||||
DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
|
||||
|
||||
#undef DEFUN
|
||||
|
||||
|
|
|
@ -67,6 +67,6 @@
|
|||
(gravatar-force-default nil)
|
||||
(gravatar-size nil))
|
||||
(should (equal (gravatar-build-url "foo") "\
|
||||
https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
|
||||
https://seccdn.libravatar.org/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
|
||||
|
||||
;;; gravatar-tests.el ends here
|
||||
|
|
|
@ -424,4 +424,21 @@ See Bug#36226."
|
|||
;; but at least one.
|
||||
(should (> valid-after valid-before)))))
|
||||
|
||||
(ert-deftest module/async-pipe ()
|
||||
"Check that writing data from another thread works."
|
||||
(skip-unless (not (eq system-type 'windows-nt))) ; FIXME!
|
||||
(with-temp-buffer
|
||||
(let ((process (make-pipe-process :name "module/async-pipe"
|
||||
:buffer (current-buffer)
|
||||
:coding 'utf-8-unix
|
||||
:noquery t)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(mod-test-async-pipe process)
|
||||
(should (accept-process-output process 1))
|
||||
;; The string below must be identical to what
|
||||
;; mod-test.c:write_to_pipe produces.
|
||||
(should (equal (buffer-string) "data from thread")))
|
||||
(delete-process process)))))
|
||||
|
||||
;;; emacs-module-tests.el ends here
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue