-
This commit is contained in:
Paul Eggert
commit
05595c2e59
15 changed files with 311 additions and 137 deletions
|
|
@ -3370,7 +3370,7 @@ if test "${with_modules}" != "no"; then
|
|||
else
|
||||
SAVE_LIBS=$LIBS
|
||||
LIBS="$LIBS $LIBMODULES"
|
||||
AC_CHECK_FUNCS([dlfunc])
|
||||
AC_CHECK_FUNCS([dladdr dlfunc])
|
||||
LIBS=$SAVE_LIBS
|
||||
fi
|
||||
fi
|
||||
|
|
@ -3383,7 +3383,6 @@ if test "${HAVE_MODULES}" = yes; then
|
|||
fi
|
||||
AC_SUBST(MODULES_OBJ)
|
||||
AC_SUBST(LIBMODULES)
|
||||
AC_CHECK_FUNCS(dladdr)
|
||||
|
||||
### Use -lpng if available, unless '--with-png=no'.
|
||||
HAVE_PNG=no
|
||||
|
|
|
|||
|
|
@ -412,17 +412,31 @@ information about emacs-w3m}, @code{links}, @code{lynx},
|
|||
external viewer. You can also specify a function, which will be
|
||||
called with a @acronym{MIME} handle as the argument.
|
||||
|
||||
@item mm-inline-text-html-with-images
|
||||
@item mm-html-inhibit-images
|
||||
@vindex mm-html-inhibit-images
|
||||
@vindex mm-inline-text-html-with-images
|
||||
Some @acronym{HTML} mails might have the trick of spammers using
|
||||
@samp{<img>} tags. It is likely to be intended to verify whether you
|
||||
have read the mail. You can prevent your personal information from
|
||||
leaking by setting this option to @code{nil} (which is the default).
|
||||
For emacs-w3m, you may use the command @kbd{t} on the image anchor to
|
||||
show an image even if it is @code{nil}.@footnote{The command @kbd{T}
|
||||
will load all images. If you have set the option
|
||||
@code{w3m-key-binding} to @code{info}, use @kbd{i} or @kbd{I}
|
||||
instead.}
|
||||
If this is non-@code{nil}, inhibit displaying of images inline in the
|
||||
article body. It is effective to images in @acronym{HTML} articles
|
||||
rendered when @code{mm-text-html-renderer} (@pxref{Display
|
||||
Customization}) is @code{shr} or @code{w3m}. In Gnus, this is
|
||||
overridden by the value of @code{gnus-inhibit-images} (@pxref{Misc
|
||||
Article, ,Misc Article, gnus, Gnus manual}).
|
||||
|
||||
@item mm-html-blocked-images
|
||||
@vindex mm-html-blocked-images
|
||||
External images that have @acronym{URL}s that match this regexp won't
|
||||
be fetched and displayed. For instance, to block all @acronym{URL}s
|
||||
that have the string ``ads'' in them, do the following:
|
||||
|
||||
@lisp
|
||||
(setq mm-html-blocked-images "ads")
|
||||
@end lisp
|
||||
|
||||
It is effective when @code{mm-text-html-renderer} (@pxref{Display
|
||||
Customization}) is @code{shr}. In Gnus, this is overridden by the value
|
||||
of @code{gnus-blocked-images} or the return value of the function that
|
||||
@code{gnus-blocked-images} is set to (@pxref{HTML, ,HTML, gnus, Gnus
|
||||
manual}).
|
||||
|
||||
@item mm-w3m-safe-url-regexp
|
||||
@vindex mm-w3m-safe-url-regexp
|
||||
|
|
|
|||
|
|
@ -11790,7 +11790,7 @@ renderer. If set to @code{gnus-w3m}, it uses @code{w3m}.
|
|||
@item gnus-blocked-images
|
||||
@vindex gnus-blocked-images
|
||||
External images that have @acronym{URL}s that match this regexp won't
|
||||
be fetched and displayed. For instance, do block all @acronym{URL}s
|
||||
be fetched and displayed. For instance, to block all @acronym{URL}s
|
||||
that have the string ``ads'' in them, do the following:
|
||||
|
||||
@lisp
|
||||
|
|
|
|||
17
etc/NEWS
17
etc/NEWS
|
|
@ -359,12 +359,17 @@ as you type. See also the new variable ‘text-quoting-style’.
|
|||
** New minor mode global-eldoc-mode is enabled by default.
|
||||
|
||||
---
|
||||
** Emacs now supports "bracketed paste mode" when running on a terminal
|
||||
that supports it. This facility allows Emacs to understand pasted
|
||||
chunks of text as strings to be inserted, instead of interpreting each
|
||||
character in the pasted text as actual user input. This results in a
|
||||
paste experience similar to that under a window system, and significant
|
||||
performance improvements when pasting large amounts of text.
|
||||
** Emacs now uses "bracketed paste mode" on text terminals that support it.
|
||||
Bracketed paste mode causes text terminals to wrap pasted text in special
|
||||
escape sequences that allow Emacs to tell the difference between text
|
||||
you type and text you paste from other applications. Emacs then
|
||||
avoids interpreting each character in the pasted text as it does with
|
||||
keyboard input, which results in a paste experience similar to that
|
||||
under a window system, and significant performance improvements when
|
||||
pasting large amounts of text.
|
||||
|
||||
Bracketed paste mode is disabled by default, so Emacs automatically
|
||||
enables it at startup if the terminal supports it.
|
||||
|
||||
+++
|
||||
** Emacs now supports the latest version of the UBA.
|
||||
|
|
|
|||
|
|
@ -242,10 +242,14 @@ EVENT is the cadr of the event in `file-notify-handle-event'
|
|||
(and
|
||||
(memq action '(deleted renamed))
|
||||
(= (length (cdr registered)) 1)
|
||||
;; Not, when a file is backed up.
|
||||
(not (and (stringp file1) (backup-file-name-p file1)))
|
||||
(or
|
||||
;; Watched file or directory is concerned.
|
||||
(string-equal
|
||||
(file-name-nondirectory file)
|
||||
(file-name-nondirectory (car registered)))
|
||||
;; File inside a watched directory is concerned.
|
||||
(string-equal
|
||||
(file-name-nondirectory file)
|
||||
(car (cadr registered)))))))
|
||||
|
|
|
|||
|
|
@ -2258,8 +2258,7 @@ This only works if the article in question is HTML."
|
|||
(save-restriction
|
||||
(widen)
|
||||
(if (eq mm-text-html-renderer 'w3m)
|
||||
(let ((mm-inline-text-html-with-images nil))
|
||||
(w3m-toggle-inline-images))
|
||||
(w3m-toggle-inline-images)
|
||||
(dolist (region (gnus-find-text-property-region (point-min) (point-max)
|
||||
'image-displayer))
|
||||
(destructuring-bind (start end function) region
|
||||
|
|
@ -4929,25 +4928,30 @@ General format specifiers can also be used. See Info node
|
|||
(vector (caddr c) (car c) :active t))
|
||||
gnus-url-button-commands)))
|
||||
|
||||
(defmacro gnus-bind-safe-url-regexp (&rest body)
|
||||
"Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
|
||||
`(let ((mm-w3m-safe-url-regexp
|
||||
(let ((group (if (and (derived-mode-p 'gnus-article-mode)
|
||||
(gnus-buffer-live-p
|
||||
gnus-article-current-summary))
|
||||
(with-current-buffer gnus-article-current-summary
|
||||
gnus-newsgroup-name)
|
||||
gnus-newsgroup-name)))
|
||||
(if (cond ((not group)
|
||||
;; Maybe we're in a mml-preview buffer
|
||||
;; and no group is selected.
|
||||
t)
|
||||
((stringp gnus-safe-html-newsgroups)
|
||||
(string-match gnus-safe-html-newsgroups group))
|
||||
((consp gnus-safe-html-newsgroups)
|
||||
(member group gnus-safe-html-newsgroups)))
|
||||
nil
|
||||
mm-w3m-safe-url-regexp))))
|
||||
(defmacro gnus-bind-mm-vars (&rest body)
|
||||
"Bind some mm-* variables and execute BODY."
|
||||
`(let (mm-html-inhibit-images
|
||||
mm-html-blocked-images
|
||||
(mm-w3m-safe-url-regexp mm-w3m-safe-url-regexp))
|
||||
(with-current-buffer
|
||||
(cond ((derived-mode-p 'gnus-article-mode)
|
||||
(if (gnus-buffer-live-p gnus-article-current-summary)
|
||||
gnus-article-current-summary
|
||||
;; Maybe we're in a mml-preview buffer
|
||||
;; and no group is selected.
|
||||
(current-buffer)))
|
||||
((gnus-buffer-live-p gnus-summary-buffer)
|
||||
gnus-summary-buffer)
|
||||
(t (current-buffer)))
|
||||
(setq mm-html-inhibit-images gnus-inhibit-images
|
||||
mm-html-blocked-images (gnus-blocked-images))
|
||||
(when (or (not gnus-newsgroup-name)
|
||||
(and (stringp gnus-safe-html-newsgroups)
|
||||
(string-match gnus-safe-html-newsgroups
|
||||
gnus-newsgroup-name))
|
||||
(and (consp gnus-safe-html-newsgroups)
|
||||
(member gnus-newsgroup-name gnus-safe-html-newsgroups)))
|
||||
(setq mm-w3m-safe-url-regexp nil)))
|
||||
,@body))
|
||||
|
||||
(defun gnus-mime-button-menu (event prefix)
|
||||
|
|
@ -4975,7 +4979,7 @@ General format specifiers can also be used. See Info node
|
|||
(or (search-forward "\n\n") (goto-char (point-max)))
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region (point) (point-max))
|
||||
(gnus-bind-safe-url-regexp (mm-display-parts handles)))))))
|
||||
(gnus-bind-mm-vars (mm-display-parts handles)))))))
|
||||
|
||||
(defun gnus-article-jump-to-part (n)
|
||||
"Jump to MIME part N."
|
||||
|
|
@ -5514,8 +5518,7 @@ If no internal viewer is available, use an external viewer."
|
|||
(gnus-mime-view-part-as-type
|
||||
nil (lambda (type) (mm-inlinable-p handle type)))
|
||||
(when handle
|
||||
(gnus-bind-safe-url-regexp
|
||||
(mm-display-part handle nil t))))))
|
||||
(gnus-bind-mm-vars (mm-display-part handle nil t))))))
|
||||
|
||||
(defun gnus-mime-action-on-part (&optional action)
|
||||
"Do something with the MIME attachment at (point)."
|
||||
|
|
@ -5745,7 +5748,7 @@ all parts."
|
|||
(mm-inlined-p handle)
|
||||
t)
|
||||
(with-temp-buffer
|
||||
(gnus-bind-safe-url-regexp
|
||||
(gnus-bind-mm-vars
|
||||
(setq retval (mm-display-part handle)))
|
||||
(unless (zerop (buffer-size))
|
||||
(buffer-string))))))
|
||||
|
|
@ -6106,7 +6109,7 @@ If nil, don't show those extra buttons."
|
|||
(set-buffer gnus-summary-buffer)
|
||||
(error))
|
||||
gnus-newsgroup-ignored-charsets)))
|
||||
(gnus-bind-safe-url-regexp (mm-display-part handle t))))
|
||||
(gnus-bind-mm-vars (mm-display-part handle t))))
|
||||
((and text not-attachment)
|
||||
(mm-display-inline handle)))
|
||||
(goto-char (point-max))
|
||||
|
|
@ -6236,7 +6239,7 @@ If nil, don't show those extra buttons."
|
|||
(mail-parse-ignored-charsets
|
||||
(with-current-buffer gnus-summary-buffer
|
||||
gnus-newsgroup-ignored-charsets)))
|
||||
(gnus-bind-safe-url-regexp (mm-display-part preferred))
|
||||
(gnus-bind-mm-vars (mm-display-part preferred))
|
||||
;; Do highlighting.
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
|
|
|
|||
|
|
@ -2418,6 +2418,8 @@ With prefix-argument just set Follow-Up, don't cross-post."
|
|||
nil nil '("poster" . 0)
|
||||
(if (boundp 'gnus-group-history)
|
||||
'gnus-group-history))))
|
||||
(when (fboundp 'gnus-group-real-name)
|
||||
(setq target-group (gnus-group-real-name target-group)))
|
||||
(cond ((not (or (null target-group) ; new subject not empty
|
||||
(zerop (string-width target-group))
|
||||
(string-match "^[ \t]*$" target-group)))
|
||||
|
|
|
|||
|
|
@ -145,14 +145,23 @@ nil : use external viewer (default web browser)."
|
|||
(function))
|
||||
:group 'mime-display)
|
||||
|
||||
(defcustom mm-inline-text-html-with-images nil
|
||||
"If non-nil, Gnus will allow retrieving images in HTML that has <img> tags.
|
||||
See also the documentation for the `mm-w3m-safe-url-regexp'
|
||||
variable."
|
||||
:version "22.1"
|
||||
(defcustom mm-html-inhibit-images
|
||||
(if (boundp 'mm-inline-text-html-with-images)
|
||||
(not (symbol-value 'mm-inline-text-html-with-images))
|
||||
t)
|
||||
"Non-nil means inhibit displaying of images inline in the article body."
|
||||
:version "25.1"
|
||||
:type 'boolean
|
||||
:group 'mime-display)
|
||||
|
||||
(defcustom mm-html-blocked-images ""
|
||||
"Regexp matching image URLs to be blocked, or nil meaning not to block.
|
||||
Note that cid images that are embedded in a message won't be blocked."
|
||||
:version "25.1"
|
||||
:type '(choice (const :tag "Allow all" nil)
|
||||
(regexp :tag "Regular expression"))
|
||||
:group 'mime-display)
|
||||
|
||||
(defcustom mm-w3m-safe-url-regexp "\\`cid:"
|
||||
"Regexp matching URLs which are considered to be safe.
|
||||
Some HTML mails might contain a nasty trick used by spammers, using
|
||||
|
|
@ -543,7 +552,7 @@ into
|
|||
|
||||
\(a 1 b 2 c 3)
|
||||
|
||||
The original alist is not modified. See also `destructive-alist-to-plist'."
|
||||
The original alist is not modified."
|
||||
(let (plist)
|
||||
(while alist
|
||||
(let ((el (car alist)))
|
||||
|
|
@ -1828,14 +1837,11 @@ If RECURSIVE, search recursively."
|
|||
(declare-function shr-insert-document "shr" (dom))
|
||||
(defvar shr-blocked-images)
|
||||
(defvar shr-use-fonts)
|
||||
(defvar gnus-inhibit-images)
|
||||
(autoload 'gnus-blocked-images "gnus-art")
|
||||
|
||||
(defun mm-shr (handle)
|
||||
;; Require since we bind its variables.
|
||||
(require 'shr)
|
||||
(let ((article-buffer (current-buffer))
|
||||
(shr-width (if (and (boundp 'shr-use-fonts)
|
||||
(let ((shr-width (if (and (boundp 'shr-use-fonts)
|
||||
shr-use-fonts)
|
||||
nil
|
||||
fill-column))
|
||||
|
|
@ -1844,15 +1850,9 @@ If RECURSIVE, search recursively."
|
|||
(when handle
|
||||
(mm-with-part handle
|
||||
(buffer-string))))))
|
||||
shr-inhibit-images shr-blocked-images charset char)
|
||||
(if (and (boundp 'gnus-summary-buffer)
|
||||
(bufferp gnus-summary-buffer)
|
||||
(buffer-name gnus-summary-buffer))
|
||||
(with-current-buffer gnus-summary-buffer
|
||||
(setq shr-inhibit-images gnus-inhibit-images
|
||||
shr-blocked-images (gnus-blocked-images)))
|
||||
(setq shr-inhibit-images gnus-inhibit-images
|
||||
shr-blocked-images (gnus-blocked-images)))
|
||||
(shr-inhibit-images mm-html-inhibit-images)
|
||||
(shr-blocked-images mm-html-blocked-images)
|
||||
charset char)
|
||||
(unless handle
|
||||
(setq handle (mm-dissect-buffer t)))
|
||||
(setq charset (mail-content-type-get (mm-handle-type handle) 'charset))
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@
|
|||
(push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
|
||||
w3m-cid-retrieve-function-alist))
|
||||
(setq mm-w3m-setup t))
|
||||
(setq w3m-display-inline-images mm-inline-text-html-with-images))
|
||||
(setq w3m-display-inline-images (not mm-html-inhibit-images)))
|
||||
|
||||
(defun mm-w3m-cid-retrieve-1 (url handle)
|
||||
(dolist (elem handle)
|
||||
|
|
|
|||
|
|
@ -655,10 +655,10 @@ The passphrase is read and cached."
|
|||
(catch 'break
|
||||
(dolist (uid uids nil)
|
||||
(if (and (stringp (epg-user-id-string uid))
|
||||
(equal (car (mail-header-parse-address
|
||||
(epg-user-id-string uid)))
|
||||
(car (mail-header-parse-address
|
||||
recipient)))
|
||||
(equal (downcase (car (mail-header-parse-address
|
||||
(epg-user-id-string uid))))
|
||||
(downcase (car (mail-header-parse-address
|
||||
recipient))))
|
||||
(not (memq (epg-user-id-validity uid)
|
||||
'(revoked expired))))
|
||||
(throw 'break t))))))
|
||||
|
|
|
|||
|
|
@ -1831,7 +1831,9 @@ Return the server's response to the SELECT or EXAMINE command."
|
|||
(let ((open-result t))
|
||||
(when (and server
|
||||
(not (nnimap-server-opened server)))
|
||||
(setq open-result (nnimap-open-server server nil no-reconnect)))
|
||||
(let ((method (gnus-server-to-method server)))
|
||||
(setq open-result (nnimap-open-server (nth 1 method) (nthcdr 2 method)
|
||||
no-reconnect))))
|
||||
(cond
|
||||
((not open-result)
|
||||
nil)
|
||||
|
|
|
|||
70
src/alloc.c
70
src/alloc.c
|
|
@ -819,8 +819,10 @@ malloc_unblock_input (void)
|
|||
malloc_probe (size); \
|
||||
} while (0)
|
||||
|
||||
static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
|
||||
static void *lrealloc (void *, size_t);
|
||||
|
||||
/* Like malloc but check for no memory and block interrupt input.. */
|
||||
/* Like malloc but check for no memory and block interrupt input. */
|
||||
|
||||
void *
|
||||
xmalloc (size_t size)
|
||||
|
|
@ -828,7 +830,7 @@ xmalloc (size_t size)
|
|||
void *val;
|
||||
|
||||
MALLOC_BLOCK_INPUT;
|
||||
val = malloc (size);
|
||||
val = lmalloc (size);
|
||||
MALLOC_UNBLOCK_INPUT;
|
||||
|
||||
if (!val && size)
|
||||
|
|
@ -845,7 +847,7 @@ xzalloc (size_t size)
|
|||
void *val;
|
||||
|
||||
MALLOC_BLOCK_INPUT;
|
||||
val = malloc (size);
|
||||
val = lmalloc (size);
|
||||
MALLOC_UNBLOCK_INPUT;
|
||||
|
||||
if (!val && size)
|
||||
|
|
@ -866,9 +868,9 @@ xrealloc (void *block, size_t size)
|
|||
/* We must call malloc explicitly when BLOCK is 0, since some
|
||||
reallocs don't do this. */
|
||||
if (! block)
|
||||
val = malloc (size);
|
||||
val = lmalloc (size);
|
||||
else
|
||||
val = realloc (block, size);
|
||||
val = lrealloc (block, size);
|
||||
MALLOC_UNBLOCK_INPUT;
|
||||
|
||||
if (!val && size)
|
||||
|
|
@ -1070,7 +1072,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
|
|||
allocated_mem_type = type;
|
||||
#endif
|
||||
|
||||
val = malloc (nbytes);
|
||||
val = lmalloc (nbytes);
|
||||
|
||||
#if ! USE_LSB_TAG
|
||||
/* If the memory just allocated cannot be addressed thru a Lisp
|
||||
|
|
@ -1364,6 +1366,62 @@ lisp_align_free (void *block)
|
|||
MALLOC_UNBLOCK_INPUT;
|
||||
}
|
||||
|
||||
#if !defined __GNUC__ && !defined __alignof__
|
||||
# define __alignof__(type) alignof (type)
|
||||
#endif
|
||||
|
||||
/* True if malloc returns a multiple of GCALIGNMENT. In practice this
|
||||
holds if __alignof__ (max_align_t) is a multiple. Use __alignof__
|
||||
if available, as otherwise this check would fail with GCC x86.
|
||||
This is a macro, not an enum constant, for portability to HP-UX
|
||||
10.20 cc and AIX 3.2.5 xlc. */
|
||||
#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0)
|
||||
|
||||
/* True if P is suitably aligned for SIZE, where Lisp alignment may be
|
||||
needed if SIZE is Lisp-aligned. */
|
||||
|
||||
static bool
|
||||
laligned (void *p, size_t size)
|
||||
{
|
||||
return (MALLOC_IS_GC_ALIGNED || size % GCALIGNMENT != 0
|
||||
|| (intptr_t) p % GCALIGNMENT == 0);
|
||||
}
|
||||
|
||||
/* Like malloc and realloc except that if SIZE is Lisp-aligned, make
|
||||
sure the result is too. */
|
||||
|
||||
static void *
|
||||
lmalloc (size_t size)
|
||||
{
|
||||
#if USE_ALIGNED_ALLOC
|
||||
if (! MALLOC_IS_GC_ALIGNED)
|
||||
return aligned_alloc (GCALIGNMENT, size);
|
||||
#endif
|
||||
|
||||
void *p;
|
||||
while (true)
|
||||
{
|
||||
p = malloc (size);
|
||||
if (laligned (p, size))
|
||||
break;
|
||||
free (p);
|
||||
}
|
||||
|
||||
eassert ((intptr_t) p % GCALIGNMENT == 0);
|
||||
return p;
|
||||
}
|
||||
|
||||
static void *
|
||||
lrealloc (void *p, size_t size)
|
||||
{
|
||||
do
|
||||
p = realloc (p, size);
|
||||
while (! laligned (p, size));
|
||||
|
||||
eassert ((intptr_t) p % GCALIGNMENT == 0);
|
||||
return p;
|
||||
}
|
||||
|
||||
|
||||
/***********************************************************************
|
||||
Interval Allocation
|
||||
|
|
|
|||
20
src/lisp.h
20
src/lisp.h
|
|
@ -67,20 +67,6 @@ DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS)
|
|||
#define GCTYPEBITS 3
|
||||
DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
|
||||
|
||||
/* The number of bits needed in an EMACS_INT over and above the number
|
||||
of bits in a pointer. This is 0 on systems where:
|
||||
1. We can specify multiple-of-8 alignment on static variables.
|
||||
2. We know malloc returns a multiple of 8. */
|
||||
#if (defined alignas \
|
||||
&& (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
|
||||
|| defined CYGWIN || defined __MINGW32__ \
|
||||
|| defined DARWIN_OS || defined __FreeBSD__ \
|
||||
|| defined __sun))
|
||||
# define NONPOINTER_BITS 0
|
||||
#else
|
||||
# define NONPOINTER_BITS GCTYPEBITS
|
||||
#endif
|
||||
|
||||
/* EMACS_INT - signed integer wide enough to hold an Emacs value
|
||||
EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
|
||||
pI - printf length modifier for EMACS_INT
|
||||
|
|
@ -88,18 +74,16 @@ DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
|
|||
#ifndef EMACS_INT_MAX
|
||||
# if INTPTR_MAX <= 0
|
||||
# error "INTPTR_MAX misconfigured"
|
||||
# elif INTPTR_MAX <= INT_MAX >> NONPOINTER_BITS && !defined WIDE_EMACS_INT
|
||||
# elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
|
||||
typedef int EMACS_INT;
|
||||
typedef unsigned int EMACS_UINT;
|
||||
# define EMACS_INT_MAX INT_MAX
|
||||
# define pI ""
|
||||
# elif INTPTR_MAX <= LONG_MAX >> NONPOINTER_BITS && !defined WIDE_EMACS_INT
|
||||
# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
|
||||
typedef long int EMACS_INT;
|
||||
typedef unsigned long EMACS_UINT;
|
||||
# define EMACS_INT_MAX LONG_MAX
|
||||
# define pI "l"
|
||||
/* Check versus LLONG_MAX, not LLONG_MAX >> NONPOINTER_BITS.
|
||||
In theory this is not safe, but in practice it seems to be OK. */
|
||||
# elif INTPTR_MAX <= LLONG_MAX
|
||||
typedef long long int EMACS_INT;
|
||||
typedef unsigned long long int EMACS_UINT;
|
||||
|
|
|
|||
|
|
@ -89,10 +89,14 @@ WRITE_LOG = > $@ 2>&1 || { stat=ERROR; cat $@; }; echo $$stat: $@
|
|||
## Beware: it approximates 'no-byte-compile', so watch out for false-positives!
|
||||
SELECTOR_DEFAULT = (quote (not (tag :expensive-test)))
|
||||
SELECTOR_EXPENSIVE = nil
|
||||
ifndef SELECTOR
|
||||
ifdef SELECTOR
|
||||
SELECTOR_ACTUAL=$(SELECTOR)
|
||||
else ifeq ($(MAKECMDGOALS),check)
|
||||
SELECTOR_ACTUAL=$(SELECTOR_DEFAULT)
|
||||
else ifeq ($(MAKECMDGOALS),check-maybe)
|
||||
SELECTOR_ACTUAL=$(SELECTOR_DEFAULT)
|
||||
else
|
||||
SELECTOR_ACTUAL=$(SELECTOR)
|
||||
SELECTOR_ACTUAL=$(SELECTOR_EXPENSIVE)
|
||||
endif
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -62,6 +62,10 @@
|
|||
(defvar file-notify--test-event nil)
|
||||
(defvar file-notify--test-events nil)
|
||||
|
||||
(defconst file-notify--test-read-event-timeout 0.02
|
||||
"Timeout for `read-event' calls.
|
||||
It is different for local and remote file notification libraries.")
|
||||
|
||||
(defun file-notify--test-timeout ()
|
||||
"Timeout to wait for arriving events, in seconds."
|
||||
(cond
|
||||
|
|
@ -74,19 +78,20 @@
|
|||
"Cleanup after a test."
|
||||
(file-notify-rm-watch file-notify--test-desc)
|
||||
|
||||
(when (and file-notify--test-tmpfile
|
||||
(file-exists-p file-notify--test-tmpfile))
|
||||
(ignore-errors
|
||||
(delete-file (file-newest-backup file-notify--test-tmpfile)))
|
||||
(ignore-errors
|
||||
(if (file-directory-p file-notify--test-tmpfile)
|
||||
(delete-directory file-notify--test-tmpfile 'recursive)
|
||||
(delete-file file-notify--test-tmpfile)))
|
||||
(when (and file-notify--test-tmpfile1
|
||||
(file-exists-p file-notify--test-tmpfile1))
|
||||
(ignore-errors
|
||||
(if (file-directory-p file-notify--test-tmpfile1)
|
||||
(delete-directory file-notify--test-tmpfile1 'recursive)
|
||||
(delete-file file-notify--test-tmpfile1)))
|
||||
(when (file-remote-p temporary-file-directory)
|
||||
(tramp-cleanup-connection
|
||||
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password))
|
||||
(ignore-errors
|
||||
(when (file-remote-p temporary-file-directory)
|
||||
(tramp-cleanup-connection
|
||||
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password)))
|
||||
|
||||
(setq file-notify--test-tmpfile nil
|
||||
file-notify--test-tmpfile1 nil
|
||||
|
|
@ -155,6 +160,7 @@ remote host, or nil."
|
|||
:tags '(:expensive-test)
|
||||
(let* ((temporary-file-directory
|
||||
file-notify-test-remote-temporary-file-directory)
|
||||
(file-notify--test-read-event-timeout 0.1)
|
||||
(ert-test (ert-get-test ',test)))
|
||||
(skip-unless (file-notify--test-remote-enabled))
|
||||
(tramp-cleanup-connection
|
||||
|
|
@ -285,7 +291,27 @@ and the event to `file-notify--test-events'."
|
|||
TIMEOUT is the maximum time to wait for, in seconds."
|
||||
`(with-timeout (,timeout (ignore))
|
||||
(while (null ,until)
|
||||
(read-event nil nil 0.1))))
|
||||
(read-event nil nil file-notify--test-read-event-timeout))))
|
||||
|
||||
(defun file-notify--test-with-events-check (events)
|
||||
"Check whether received events match one of the EVENTS alternatives."
|
||||
(let (result)
|
||||
(dolist (elt events result)
|
||||
(setq result
|
||||
(or result
|
||||
(equal elt (mapcar #'cadr file-notify--test-events)))))))
|
||||
|
||||
(defun file-notify--test-with-events-explainer (events)
|
||||
"Explain why `file-notify--test-with-events-check' fails."
|
||||
(if (null (cdr events))
|
||||
(format "Received events `%s' do not match expected events `%s'"
|
||||
(mapcar #'cadr file-notify--test-events) (car events))
|
||||
(format
|
||||
"Received events `%s' do not match any sequence of expected events `%s'"
|
||||
(mapcar #'cadr file-notify--test-events) events)))
|
||||
|
||||
(put 'file-notify--test-with-events-check 'ert-explainer
|
||||
'file-notify--test-with-events-explainer)
|
||||
|
||||
(defmacro file-notify--test-with-events (events &rest body)
|
||||
"Run BODY collecting events and then compare with EVENTS.
|
||||
|
|
@ -297,7 +323,7 @@ longer than timeout seconds for the events to be delivered."
|
|||
`(let* ((,outer file-notify--test-events)
|
||||
(events (if (consp (car ,events)) ,events (list ,events)))
|
||||
(max-length (apply 'max (mapcar 'length events)))
|
||||
create-lockfiles result)
|
||||
create-lockfiles)
|
||||
;; Flush pending events.
|
||||
(file-notify--wait-for-events
|
||||
(file-notify--test-timeout)
|
||||
|
|
@ -309,11 +335,7 @@ longer than timeout seconds for the events to be delivered."
|
|||
(* (ceiling max-length 100) (file-notify--test-timeout))
|
||||
(= max-length (length file-notify--test-events)))
|
||||
;; One of the possible results shall match.
|
||||
(should
|
||||
(dolist (elt events result)
|
||||
(setq result
|
||||
(or result
|
||||
(equal elt (mapcar #'cadr file-notify--test-events))))))
|
||||
(should (file-notify--test-with-events-check events))
|
||||
(setq ,outer (append ,outer file-notify--test-events)))
|
||||
(setq file-notify--test-events ,outer))))
|
||||
|
||||
|
|
@ -342,7 +364,7 @@ longer than timeout seconds for the events to be delivered."
|
|||
(t '(created changed deleted stopped)))
|
||||
(write-region
|
||||
"another text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
|
||||
(let (file-notify--test-events)
|
||||
|
|
@ -371,10 +393,10 @@ longer than timeout seconds for the events to be delivered."
|
|||
'((changed deleted stopped)
|
||||
(changed changed deleted stopped)))
|
||||
(t '(changed changed deleted stopped)))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"another text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
|
||||
(let (file-notify--test-events)
|
||||
|
|
@ -405,10 +427,10 @@ longer than timeout seconds for the events to be delivered."
|
|||
((string-equal (file-notify--test-library) "kqueue")
|
||||
'(created changed deleted stopped))
|
||||
(t '(created changed deleted deleted stopped)))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-directory temporary-file-directory 'recursive))
|
||||
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
|
||||
(let (file-notify--test-events)
|
||||
|
|
@ -440,17 +462,17 @@ longer than timeout seconds for the events to be delivered."
|
|||
'(created changed created changed deleted stopped))
|
||||
(t '(created changed created changed
|
||||
deleted deleted deleted stopped)))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
|
||||
;; The next two events shall not be visible.
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(set-file-modes file-notify--test-tmpfile 000)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(set-file-times file-notify--test-tmpfile '(0 0))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-directory temporary-file-directory 'recursive))
|
||||
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
|
||||
(let (file-notify--test-events)
|
||||
|
|
@ -480,13 +502,13 @@ longer than timeout seconds for the events to be delivered."
|
|||
((string-equal (file-notify--test-library) "kqueue")
|
||||
'(created changed renamed deleted stopped))
|
||||
(t '(created changed renamed deleted deleted stopped)))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
|
||||
;; After the rename, we won't get events anymore.
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-directory temporary-file-directory 'recursive))
|
||||
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
|
||||
(let (file-notify--test-events)
|
||||
|
|
@ -514,14 +536,14 @@ longer than timeout seconds for the events to be delivered."
|
|||
(file-remote-p temporary-file-directory))
|
||||
'(attribute-changed attribute-changed attribute-changed))
|
||||
(t '(attribute-changed attribute-changed)))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(set-file-modes file-notify--test-tmpfile 000)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(set-file-times file-notify--test-tmpfile '(0 0))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
|
||||
(let (file-notify--test-events)
|
||||
|
|
@ -678,10 +700,10 @@ longer than timeout seconds for the events to be delivered."
|
|||
(changed changed deleted stopped)))
|
||||
(t '(changed changed deleted stopped)))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"another text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
;; After deleting the file, the descriptor is not valid anymore.
|
||||
(should-not (file-notify-valid-p file-notify--test-desc))
|
||||
|
|
@ -713,10 +735,10 @@ longer than timeout seconds for the events to be delivered."
|
|||
'(created changed deleted stopped))
|
||||
(t '(created changed deleted deleted stopped)))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-directory temporary-file-directory t))
|
||||
;; After deleting the parent directory, the descriptor must
|
||||
;; not be valid anymore.
|
||||
|
|
@ -814,9 +836,9 @@ longer than timeout seconds for the events to be delivered."
|
|||
(let ((source-file-list source-file-list)
|
||||
(target-file-list target-file-list))
|
||||
(while (and source-file-list target-file-list)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region "" nil (pop source-file-list) nil 'no-message)
|
||||
(read-event nil nil 0.1)
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(write-region "" nil (pop target-file-list) nil 'no-message))))
|
||||
(file-notify--test-with-events
|
||||
(cond
|
||||
|
|
@ -829,16 +851,93 @@ longer than timeout seconds for the events to be delivered."
|
|||
(let ((source-file-list source-file-list)
|
||||
(target-file-list target-file-list))
|
||||
(while (and source-file-list target-file-list)
|
||||
(rename-file (pop source-file-list) (pop target-file-list) t)
|
||||
(read-event nil nil 0.02))))
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(rename-file (pop source-file-list) (pop target-file-list) t))))
|
||||
(file-notify--test-with-events (make-list n 'deleted)
|
||||
(dolist (file target-file-list)
|
||||
(prog1 (delete-file file) (read-event nil nil 0.02)))))
|
||||
(read-event nil nil file-notify--test-read-event-timeout)
|
||||
(delete-file file) file-notify--test-read-event-timeout)))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup)))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test06-many-events
|
||||
"Check that events are not dropped for remote directories.")
|
||||
|
||||
(ert-deftest file-notify-test07-backup ()
|
||||
"Check that backup keeps file notification."
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
|
||||
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(should
|
||||
(setq file-notify--test-desc
|
||||
(file-notify-add-watch
|
||||
file-notify--test-tmpfile
|
||||
'(change) #'file-notify--test-event-handler)))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(file-notify--test-with-events
|
||||
(cond
|
||||
;; For w32notify and in the remote case, there are two
|
||||
;; `changed' events.
|
||||
((or (string-equal (file-notify--test-library) "w32notify")
|
||||
(file-remote-p temporary-file-directory))
|
||||
'(changed changed))
|
||||
(t '(changed)))
|
||||
;; There shouldn't be any problem, because the file is kept.
|
||||
(with-temp-buffer
|
||||
(let ((buffer-file-name file-notify--test-tmpfile)
|
||||
(make-backup-files t)
|
||||
(backup-by-copying t)
|
||||
(kept-new-versions 1)
|
||||
(delete-old-versions t))
|
||||
(insert "another text")
|
||||
(save-buffer))))
|
||||
;; After saving the buffer, the descriptor is still valid.
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup))
|
||||
|
||||
(unwind-protect
|
||||
(progn
|
||||
;; It doesn't work for kqueue, because we don't use an
|
||||
;; implicit directory monitor.
|
||||
(unless (string-equal (file-notify--test-library) "kqueue")
|
||||
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(should
|
||||
(setq file-notify--test-desc
|
||||
(file-notify-add-watch
|
||||
file-notify--test-tmpfile
|
||||
'(change) #'file-notify--test-event-handler)))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(file-notify--test-with-events '(renamed created changed)
|
||||
;; The file is renamed when creating a backup. It shall
|
||||
;; still be watched.
|
||||
(with-temp-buffer
|
||||
(let ((buffer-file-name file-notify--test-tmpfile)
|
||||
(make-backup-files t)
|
||||
(backup-by-copying nil)
|
||||
(backup-by-copying-when-mismatch nil)
|
||||
(kept-new-versions 1)
|
||||
(delete-old-versions t))
|
||||
(insert "another text")
|
||||
(save-buffer))))
|
||||
;; After saving the buffer, the descriptor is still valid.
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(delete-file file-notify--test-tmpfile)))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup)))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test07-backup
|
||||
"Check that backup keeps file notification for remote files.")
|
||||
|
||||
(defun file-notify-test-all (&optional interactive)
|
||||
"Run all tests for \\[file-notify]."
|
||||
(interactive "p")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue