[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 05595c2 10/12: -
|
From: |
Paul Eggert |
|
Subject: |
[Emacs-diffs] master 05595c2 10/12: - |
|
Date: |
Tue, 09 Feb 2016 22:35:45 +0000 |
branch: master
commit 05595c2e59983db469e620c4f34b2eef5123391b
Merge: 8fa67e9 8212135
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
-
---
configure.ac | 3 +-
doc/misc/emacs-mime.texi | 34 ++++++---
doc/misc/gnus.texi | 2 +-
etc/NEWS | 17 +++--
lisp/filenotify.el | 4 +
lisp/gnus/gnus-art.el | 57 +++++++------
lisp/gnus/message.el | 2 +
lisp/gnus/mm-decode.el | 38 +++++-----
lisp/gnus/mm-view.el | 2 +-
lisp/gnus/mml-sec.el | 8 +-
lisp/gnus/nnimap.el | 4 +-
src/alloc.c | 70 +++++++++++++++--
src/lisp.h | 20 +----
test/Makefile.in | 8 ++-
test/lisp/filenotify-tests.el | 179 ++++++++++++++++++++++++++++++++---------
15 files changed, 311 insertions(+), 137 deletions(-)
diff --git a/configure.ac b/configure.ac
index 286ca52..c3e2554 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index b252b11..ae1e091 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -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.
address@hidden mm-inline-text-html-with-images
address@hidden mm-html-inhibit-images
address@hidden mm-html-inhibit-images
@vindex mm-inline-text-html-with-images
-Some @acronym{HTML} mails might have the trick of spammers using
address@hidden<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 @address@hidden command @kbd{T}
-will load all images. If you have set the option
address@hidden to @code{info}, use @kbd{i} or @kbd{I}
-instead.}
+If this is address@hidden, 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}).
+
address@hidden mm-html-blocked-images
address@hidden 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:
+
address@hidden
+(setq mm-html-blocked-images "ads")
address@hidden 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
address@hidden is set to (@pxref{HTML, ,HTML, gnus, Gnus
+manual}).
@item mm-w3m-safe-url-regexp
@vindex mm-w3m-safe-url-regexp
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index e6e3e76..fa7cd09 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 717c6bc..f0a3bec 100644
--- a/etc/NEWS
+++ b/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.
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index faa801e..66e7fd7 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -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)))))))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index f36fdd2..238a67f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -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
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 5551820..6ee5264 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -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)))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 79fc74a..c6cb652 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -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))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 9942455..8e1e3e7 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -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)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 48e6384..3ac3da0 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -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))))))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c285bef..130658c 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -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)
diff --git a/src/alloc.c b/src/alloc.c
index 7364d7c..81cfdb0 100644
--- a/src/alloc.c
+++ b/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
diff --git a/src/lisp.h b/src/lisp.h
index 2130170..f71394e 100644
--- a/src/lisp.h
+++ b/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;
diff --git a/test/Makefile.in b/test/Makefile.in
index 0034f10..e651c6c 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -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
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 5fc4ff8..a852182 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -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")
- [Emacs-diffs] master updated (53f3d4a -> 8456ba1), Paul Eggert, 2016/02/09
- [Emacs-diffs] master f414fe6 01/12: ; make change-history-commit, Paul Eggert, 2016/02/09
- [Emacs-diffs] master fdc2da4 02/12: Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master 44f853c 03/12: ; Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master f55fc92 04/12: Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master c71e7cc 05/12: ; Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master b3fc7a3 06/12: Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master a9650e9 07/12: ; Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master 8986f16 08/12: Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master 8fa67e9 09/12: ; Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master 05595c2 10/12: -,
Paul Eggert <=
- [Emacs-diffs] master 0e7b901 11/12: ; Merge from origin/emacs-25, Paul Eggert, 2016/02/09
- [Emacs-diffs] master 8456ba1 12/12: -, Paul Eggert, 2016/02/09