@code{file-name-nondirectory},
@code{file-name-sans-versions}, @code{file-newer-than-file-p},
@code{file-notify-add-watch}, @code{file-notify-rm-watch},
+@code{file-notify-valid-p},
@code{file-ownership-preserved-p},
@code{file-readable-p}, @code{file-regular-p},
@code{file-remote-p}, @code{file-selinux-context},
@code{file-name-nondirec@discretionary{}{}{}tory},
@code{file-name-sans-versions}, @code{file-newer-than-file-p},
@code{file-notify-add-watch}, @code{file-notify-rm-watch},
+@code{file-notify-valid-p},
@code{file-ownership-pre@discretionary{}{}{}served-p},
@code{file-readable-p}, @code{file-regular-p},
@code{file-remote-p}, @code{file-selinux-context},
@code{file-notify-add-watch}.
@end defun
+@defun file-notify-valid-p descriptor
+Checks a watch specified by its @var{descriptor} for validity.
+@var{descriptor} should be an object returned by
+@code{file-notify-add-watch}.
+
+A watch can become invalid if the file or directory it watches is
+deleted, or if the watcher thread exits abnormally for any other
+reason. Removing the watch by calling @code{file-notify-rm-watch}
+also makes it invalid.
+@end defun
+
@node Dynamic Libraries
@section Dynamically Loaded Libraries
@cindex dynamic libraries
(add-to-list 'display-buffer-alist
'("^\\*shell\\*$" . (display-buffer-same-window))).
-
** EIEIO
+++
*** The `:protection' slot option is not obeyed any more.
** Tramp
++++
*** New connection method "nc", which allows to access dumb busyboxes.
++++
*** Method-specific parameters can be overwritten now with variable
`tramp-connection-properties'.
+---
+*** Handler for `file-notify-valid-p' for remote machines that support
+filesystem notifications.
+
** SQL mode
*** New user variable `sql-default-directory' enables remote
** tar-mode: new `tar-new-entry' command, allowing for new members to
be added to the archive.
+---
** Autorevert: dired buffers are also auto-reverted via file
notifications, if Emacs is compiled with file notification support.
++++
+** File Notifications: the new function `file-notify-valid-p' checks,
+whether a file notification descriptor still corresponds to an
+activate watch.
+
** Obsolete packages
---
v (concat localname filename)
"file-name-all-completions" result))))))))
-(defun tramp-gvfs-handle-file-notify-add-watch (file-name _flags _callback)
+(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files."
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
- (let ((p (start-process
- "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
- "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
+ ;; We cannot watch directories, because `gvfs-monitor-dir' is not
+ ;; supported for gvfs-mounted directories.
+ (when (file-directory-p file-name)
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ (let* ((default-directory (file-name-directory file-name))
+ (events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ '(created changed changes-done-hint moved deleted
+ attribute-changed))
+ ((memq 'change flags)
+ '(created changed changes-done-hint moved deleted))
+ ((memq 'attribute-change flags) '(attribute-changed))))
+ (p (start-process
+ "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
+ "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
(if (not (processp p))
(tramp-error
- v 'file-notify-error "gvfs-monitor-file failed to start")
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name)
(tramp-message
v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p)
(tramp-set-connection-property p "vector" v)
+ (tramp-compat-process-put p 'events events)
+ (tramp-compat-process-put p 'watch-name localname)
(tramp-compat-set-process-query-on-exit-flag p nil)
- (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter)
- (with-current-buffer (process-buffer p)
- (setq default-directory (file-name-directory file-name)))
+ (set-process-filter p 'tramp-gvfs-monitor-file-process-filter)
+ ;; There might be an error if the monitor is not supported.
+ ;; Give the filter a chance to read the output.
+ (tramp-accept-process-output p 1)
+ (unless (memq (process-status p) '(run open))
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
p))))
-(defun tramp-gvfs-file-gvfs-monitor-file-process-filter (proc string)
- "Read output from \"gvfs-monitor-file\" and add corresponding file-notify events."
+(defun tramp-gvfs-monitor-file-process-filter (proc string)
+ "Read output from \"gvfs-monitor-file\" and add corresponding \
+file-notify events."
(let* ((rest-string (tramp-compat-process-get proc 'rest-string))
(dd (with-current-buffer (process-buffer proc) default-directory))
(ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
;; Attribute change is returned in unused wording.
string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+ (when (string-match "Monitoring not supported" string)
+ (delete-process proc))
(while (string-match
(concat "^[\n\r]*"
"File = \\([^\n\r]+\\)[\n\r]+"
"Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
- (let ((action (intern-soft
+ (let ((file (match-string 1 string))
+ (action (intern-soft
(tramp-compat-replace-regexp-in-string
- "_" "-" (downcase (match-string 2 string)))))
- (file (match-string 1 string)))
+ "_" "-" (downcase (match-string 2 string))))))
(setq string (replace-match "" nil nil string))
;; File names are returned as URL paths. We must convert them.
(when (string-match ddu file)
"Like `file-notify-add-watch' for Tramp files."
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
- (let* ((default-directory (file-name-directory file-name))
- command events filter p sequence)
+ (let ((default-directory (file-name-directory file-name))
+ command events filter p sequence)
(cond
;; gvfs-monitor-dir.
((setq command (tramp-get-remote-gvfs-monitor-dir v))
- (setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter
+ (setq filter 'tramp-sh-gvfs-monitor-dir-process-filter
events
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
sequence `(,command ,localname)))
;; inotifywait.
((setq command (tramp-get-remote-inotifywait v))
- (setq filter 'tramp-sh-file-inotifywait-process-filter
+ (setq filter 'tramp-sh-inotifywait-process-filter
events
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
(concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,attrib"))
+ "delete,delete_self,attrib,ignored"))
((memq 'change flags)
(concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self"))
- ((memq 'attribute-change flags) "attrib"))
+ "delete,delete_self,ignored"))
+ ((memq 'attribute-change flags) "attrib,ignored"))
sequence `(,command "-mq" "-e" ,events ,localname)))
;; None.
(t (tramp-error
(mapconcat 'identity sequence " "))
(tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p)
(tramp-set-connection-property p "vector" v)
- ;; Needed for `tramp-sh-file-gvfs-monitor-dir-process-filter'.
+ ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'.
(tramp-compat-process-put p 'events events)
+ (tramp-compat-process-put p 'watch-name localname)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-filter p filter)
+ ;; There might be an error if the monitor is not supported.
+ ;; Give the filter a chance to read the output.
+ (tramp-accept-process-output p 1)
+ (unless (memq (process-status p) '(run open))
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
p))))
-(defun tramp-sh-file-gvfs-monitor-dir-process-filter (proc string)
+(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string)
"Read output from \"gvfs-monitor-dir\" and add corresponding \
file-notify events."
(let ((remote-prefix
;; Attribute change is returned in unused wording.
string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+ (when (string-match "Monitoring not supported" string)
+ (delete-process proc))
(while (string-match
(concat "^[\n\r]*"
"\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
"Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
- (let ((object
- (list
- proc
- (intern-soft
- (tramp-compat-replace-regexp-in-string
- "_" "-" (downcase (match-string 4 string))))
- ;; File names are returned as absolute paths. We must
- ;; add the remote prefix.
- (concat remote-prefix (match-string 1 string))
- (when (match-string 3 string)
- (concat remote-prefix (match-string 3 string))))))
+ (let* ((file (match-string 1 string))
+ (file1 (match-string 3 string))
+ (object
+ (list
+ proc
+ (intern-soft
+ (tramp-compat-replace-regexp-in-string
+ "_" "-" (downcase (match-string 4 string))))
+ ;; File names are returned as absolute paths. We must
+ ;; add the remote prefix.
+ (concat remote-prefix file)
+ (when file1 (concat remote-prefix file1)))))
(setq string (replace-match "" nil nil string))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (and (member (cadr object) '(moved deleted))
+ (string-equal
+ file (tramp-compat-process-get proc 'watch-name)))
+ (delete-process proc))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the callback directly.
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(tramp-compat-process-put proc 'rest-string string)))
-(defun tramp-sh-file-inotifywait-process-filter (proc string)
+(defun tramp-sh-inotifywait-process-filter (proc string)
"Read output from \"inotifywait\" and add corresponding file-notify events."
(tramp-message proc 6 "%S\n%s" proc string)
(dolist (line (split-string string "[\n\r]+" 'omit-nulls))
(tramp-compat-replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit-nulls))
(match-string 3 line))))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (equal (cadr object) 'ignored)
+ (delete-process proc))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the callback directly.
(defun tramp-handle-file-notify-add-watch (filename _flags _callback)
"Like `file-notify-add-watch' for Tramp files."
;; This is the default handler. tramp-gvfs.el and tramp-sh.el have
- ;; its own one.
+ ;; their own one.
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(tramp-error
(unless (processp proc)
(tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
(tramp-message proc 6 "Kill %S" proc)
- (kill-process proc))
+ (delete-process proc))
(defun tramp-handle-file-notify-valid-p (proc)
"Like `file-notify-valid-p' for Tramp files."
- (and proc (processp proc) (memq (process-status proc) '(run open))))
+ (and proc (processp proc) (memq (process-status proc) '(run open))
+ ;; Sometimes, the process is still in status `run' when the
+ ;; file or directory to be watched is deleted already.
+ (with-current-buffer (process-buffer proc)
+ (file-exists-p
+ (concat (file-remote-p default-directory)
+ (tramp-compat-process-get proc 'watch-name))))))
;;; Functions for establishing connection:
(defvar file-notify--test-results nil)
(defvar file-notify--test-event nil)
(defvar file-notify--test-events nil)
+(defun file-notify--test-timeout ()
+ (if (file-remote-p temporary-file-directory) 6 3))
(defun file-notify--test-cleanup ()
"Cleanup after a test."
(when (and file-notify--test-tmpfile
(file-exists-p file-notify--test-tmpfile))
(if (directory-name-p file-notify--test-tmpfile)
- (delete-directory 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))
(if (directory-name-p file-notify--test-tmpfile1)
- (delete-directory 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))
(setq file-notify--test-tmpfile nil)
(setq file-notify--test-tmpfile1 nil)
(should
(setq file-notify--test-desc
(file-notify-add-watch temporary-file-directory '(change) 'ignore)))
+
+ ;; Cleanup.
(file-notify--test-cleanup))
(file-notify--deftest-remote file-notify-test00-availability
(file-notify-add-watch temporary-file-directory '(change) 3))
'(wrong-type-argument 3)))
+ ;; Cleanup.
(file-notify--test-cleanup))
(file-notify--deftest-remote file-notify-test01-add-watch
(defun file-notify--test-event-handler (event)
"Run a test over FILE-NOTIFY--TEST-EVENT.
-For later analysis, append the test result to
-`file-notify--test-results' and the event to
-`file-notify--test-events'."
+For later analysis, append the test result to `file-notify--test-results'
+and the event to `file-notify--test-events'."
(let* ((file-notify--test-event event)
- (result (ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
+ (result
+ (ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
(setq file-notify--test-events
(append file-notify--test-events `(,file-notify--test-event)))
(setq file-notify--test-results
(declare (indent 3))
(let ((outer (make-symbol "outer")))
`(let ((,outer file-notify--test-events))
- (let ((file-notify--test-events nil))
+ (let (file-notify--test-events)
,@body
(file-notify--wait-for-events
,timeout (= ,n (length file-notify--test-events)))
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
(progn
- (setq file-notify--test-results nil
- file-notify--test-events nil
- file-notify--test-tmpfile (file-notify--test-make-temp-name)
+ (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
file-notify--test-desc
(file-notify-add-watch
;; Check creation, change, and deletion.
(file-notify--test-with-events
- 3 3 (lambda (events)
- (should (equal '(created changed deleted)
- (mapcar #'cadr events))))
+ 3 (file-notify--test-timeout)
+ (lambda (events)
+ (should (equal '(created changed deleted)
+ (mapcar #'cadr events))))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(delete-file file-notify--test-tmpfile))
;; Check copy.
(file-notify--test-with-events
- 3 3 (lambda (events)
- (should (equal '(created changed deleted)
- (mapcar #'cadr events))))
+ 3 (file-notify--test-timeout)
+ (lambda (events)
+ (should (equal '(created changed deleted)
+ (mapcar #'cadr events))))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
+ ;; The next two events shall not be visible.
+ (set-file-modes file-notify--test-tmpfile 000)
+ (set-file-times file-notify--test-tmpfile '(0 0))
(delete-file file-notify--test-tmpfile)
(delete-file file-notify--test-tmpfile1))
;; Check rename.
(file-notify--test-with-events
- 3 3 (lambda (events)
- (should (equal '(created changed renamed)
- (mapcar #'cadr events))))
+ 3 (file-notify--test-timeout)
+ (lambda (events)
+ (should (equal '(created changed renamed)
+ (mapcar #'cadr events))))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; After the rename, we won't get events anymore.
(delete-file file-notify--test-tmpfile1))
+ ;; Check attribute change.
+ (file-notify-rm-watch file-notify--test-desc)
+ (setq file-notify--test-desc
+ (file-notify-add-watch
+ file-notify--test-tmpfile
+ '(attribute-change) 'file-notify--test-event-handler))
+ (file-notify--test-with-events
+ 2 (file-notify--test-timeout)
+ (lambda (events)
+ (should (equal '(attribute-changed attribute-changed)
+ (mapcar #'cadr events))))
+ (write-region
+ "any text" nil file-notify--test-tmpfile nil 'no-message)
+ (set-file-modes file-notify--test-tmpfile 000)
+ (read-event nil nil 0.1) ; In order to distinguish the events.
+ (set-file-times file-notify--test-tmpfile '(0 0))
+ (delete-file file-notify--test-tmpfile))
+
;; Check the global sequence again just to make sure that
;; `file-notify--test-events' has been set correctly.
(should (equal (mapcar #'cadr file-notify--test-events)
'(created changed deleted
created changed deleted
- created changed renamed)))
+ created changed renamed
+ attribute-changed attribute-changed)))
(should file-notify--test-results)
(dolist (result file-notify--test-results)
(when (ert-test-failed-p result)
(ert-fail
(cadr (ert-test-result-with-condition-condition result))))))
+
+ ;; Cleanup.
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test02-events
(buffer-string))))
(should (string-match "another text" (buffer-string)))))
- ;; Exit.
+ ;; Cleanup.
(ignore-errors (kill-buffer buf))
(file-notify--test-cleanup))))
(ert-deftest file-notify-test04-file-validity ()
"Check `file-notify-valid-p' for files."
(skip-unless (file-notify--test-local-enabled))
+
+ (unwind-protect
+ (progn
+ (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
+ (setq file-notify--test-desc (file-notify-add-watch
+ file-notify--test-tmpfile
+ '(change)
+ #'file-notify--test-event-handler))
+ (file-notify--test-with-events
+ 2 (file-notify--test-timeout)
+ (lambda (events)
+ (should (equal '(created changed)
+ (mapcar #'cadr events))))
+ (should (file-notify-valid-p file-notify--test-desc))
+ (write-region
+ "any text" nil file-notify--test-tmpfile nil 'no-message)
+ (should (file-notify-valid-p file-notify--test-desc)))
+ ;; After removing the watch, the descriptor must not be valid
+ ;; anymore.
+ (file-notify-rm-watch file-notify--test-desc)
+ (should-not (file-notify-valid-p file-notify--test-desc)))
+
+ ;; Cleanup.
+ (file-notify--test-cleanup))
+
;; The batch-mode operation of w32notify is fragile (there's no
;; input threads to send the message to).
(skip-unless (not (and noninteractive (eq file-notify--library 'w32notify))))
'(change)
#'file-notify--test-event-handler))
(file-notify--test-with-events
- 2 3 (lambda (events)
- (should (equal '(created changed)
- (mapcar #'cadr events))))
+ 2 (file-notify--test-timeout)
+ (lambda (events)
+ (should (equal '(created changed)
+ (mapcar #'cadr events))))
(should (file-notify-valid-p file-notify--test-desc))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
;; After deleting the parent, the descriptor must not be valid
;; anymore.
(delete-directory temporary-file-directory t)
- (read-event nil nil 0.5)
+ (file-notify--wait-for-events
+ (file-notify--test-timeout)
+ (not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc)))
- ;; Exit.
+ ;; Cleanup.
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test04-file-validity
(ert-deftest file-notify-test05-dir-validity ()
"Check `file-notify-valid-p' for directories."
(skip-unless (file-notify--test-local-enabled))
+
+ (unwind-protect
+ (progn
+ (setq file-notify--test-tmpfile (file-name-as-directory
+ (file-notify--test-make-temp-name)))
+ (make-directory file-notify--test-tmpfile)
+ (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))
+ ;; After removing the watch, the descriptor must not be valid
+ ;; anymore.
+ (file-notify-rm-watch file-notify--test-desc)
+ (should-not (file-notify-valid-p file-notify--test-desc)))
+
+ ;; Cleanup.
+ (file-notify--test-cleanup))
+
;; The batch-mode operation of w32notify is fragile (there's no
;; input threads to send the message to).
(skip-unless (not (and noninteractive (eq file-notify--library 'w32notify))))
'(change)
#'file-notify--test-event-handler))
(should (file-notify-valid-p file-notify--test-desc))
- (delete-directory file-notify--test-tmpfile t)
;; After deleting the directory, the descriptor must not be
;; valid anymore.
- (read-event nil nil 0.5)
+ (delete-directory file-notify--test-tmpfile t)
+ (file-notify--wait-for-events
+ (file-notify--test-timeout)
+ (not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc)))
- ;; Exit.
+ ;; Cleanup.
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test05-dir-validity
projects / emacs.git / commitdiff