Merge remote-tracking branch 'savannah/master' into HEAD

This commit is contained in:
Andrea Corallo 2020-03-29 12:31:24 +01:00
commit 00ee320a62
66 changed files with 1121 additions and 885 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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.

View file

@ -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>

View file

@ -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>

View file

@ -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

View file

@ -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
View 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 */

View file

@ -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. */

View file

@ -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))

View file

@ -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.

View file

@ -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)

View file

@ -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)

View file

@ -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."

View file

@ -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")))))

View file

@ -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)))

View file

@ -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"))))))

View file

@ -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))

View file

@ -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

View file

@ -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))))

View file

@ -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)

View file

@ -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)))

View file

@ -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.

View file

@ -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)

View file

@ -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 \"/\""))))

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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"))

View file

@ -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'.

View file

@ -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)

View file

@ -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).

View file

@ -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

View file

@ -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)

View file

@ -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.])

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 *);

View file

@ -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)))

View file

@ -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);

View file

@ -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;

View file

@ -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))

View file

@ -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);

View file

@ -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;

View file

@ -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;
}

View file

@ -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>

View file

@ -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);

View file

@ -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;

View file

@ -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

View file

@ -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;

View file

@ -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);

View file

@ -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);

View file

@ -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);

View file

@ -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 */

View file

@ -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)

View file

@ -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,

View file

@ -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

View file

@ -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));
}

View file

@ -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 cant 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

View file

@ -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

View file

@ -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