1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-05 19:31:02 -08:00

* filenotify.el: New package.

* autorevert.el (top): Require filenotify.el.
(auto-revert-notify-enabled): Remove.  Use `file-notify-support'
instead.
(auto-revert-notify-rm-watch, auto-revert-notify-add-watch)
(auto-revert-notify-handler): Use `file-notify-*' functions.

* subr.el (file-notify-handle-event): Move function to filenotify.el.

* net/tramp.el (tramp-file-name-for-operation): Handle
`file-notify-add-watch' and `file-notify-rm-watch'.

* net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add handler
for `file-notify-add-watch' and `file-notify-rm-watch'.
(tramp-process-sentinel): Improve trace.
(tramp-sh-handle-file-notify-add-watch)
(tramp-sh-file-notify-process-filter)
(tramp-sh-handle-file-notify-rm-watch)
(tramp-get-remote-inotifywait): New defuns.
This commit is contained in:
Michael Albinus 2013-07-04 11:39:36 +02:00
parent 86dfb7a815
commit 864c58ca5f
6 changed files with 474 additions and 123 deletions

View file

@ -1,3 +1,26 @@
2013-07-04 Michael Albinus <michael.albinus@gmx.de>
* filenotify.el: New package.
* autorevert.el (top): Require filenotify.el.
(auto-revert-notify-enabled): Remove. Use `file-notify-support'
instead.
(auto-revert-notify-rm-watch, auto-revert-notify-add-watch)
(auto-revert-notify-handler): Use `file-notify-*' functions.
* subr.el (file-notify-handle-event): Move function to filenotify.el.
* net/tramp.el (tramp-file-name-for-operation): Handle
`file-notify-add-watch' and `file-notify-rm-watch'.
* net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add handler
for `file-notify-add-watch' and `file-notify-rm-watch'.
(tramp-process-sentinel): Improve trace.
(tramp-sh-handle-file-notify-add-watch)
(tramp-sh-file-notify-process-filter)
(tramp-sh-handle-file-notify-rm-watch)
(tramp-get-remote-inotifywait): New defuns.
2013-07-03 Juri Linkov <juri@jurta.org> 2013-07-03 Juri Linkov <juri@jurta.org>
* buff-menu.el (Buffer-menu-multi-occur): Add args and move the * buff-menu.el (Buffer-menu-multi-occur): Add args and move the
@ -299,12 +322,12 @@
2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de> 2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* lisp/textmodes/bibtex.el (bibtex-generate-url-list): Add support * textmodes/bibtex.el (bibtex-generate-url-list): Add support
for DOI URLs. for DOI URLs.
2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de> 2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
* lisp/textmodes/bibtex.el (bibtex-mode, bibtex-set-dialect): * textmodes/bibtex.el (bibtex-mode, bibtex-set-dialect):
Update imenu-support when dialect changes. Update imenu-support when dialect changes.
2013-06-25 Leo Liu <sdl.web@gmail.com> 2013-06-25 Leo Liu <sdl.web@gmail.com>

View file

@ -103,6 +103,7 @@
(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-lib))
(require 'timer) (require 'timer)
(require 'filenotify)
;; Custom Group: ;; Custom Group:
;; ;;
@ -270,21 +271,17 @@ This variable becomes buffer local when set in any fashion.")
:type 'boolean :type 'boolean
:version "24.4") :version "24.4")
(defconst auto-revert-notify-enabled (defcustom auto-revert-use-notify (and file-notify-support t)
(or (featurep 'gfilenotify) (featurep 'inotify) (featurep 'w32notify))
"Non-nil when Emacs has been compiled with file notification support.")
(defcustom auto-revert-use-notify auto-revert-notify-enabled
"If non-nil Auto Revert Mode uses file notification functions. "If non-nil Auto Revert Mode uses file notification functions.
This requires Emacs being compiled with file notification This requires Emacs being compiled with file notification
support (see `auto-revert-notify-enabled'). You should set this support (see `file-notify-support'). You should set this variable
variable through Custom." through Custom."
:group 'auto-revert :group 'auto-revert
:type 'boolean :type 'boolean
:set (lambda (variable value) :set (lambda (variable value)
(set-default variable (and auto-revert-notify-enabled value)) (set-default variable (and file-notify-support value))
(unless (symbol-value variable) (unless (symbol-value variable)
(when auto-revert-notify-enabled (when file-notify-support
(dolist (buf (buffer-list)) (dolist (buf (buffer-list))
(with-current-buffer buf (with-current-buffer buf
(when (symbol-value 'auto-revert-notify-watch-descriptor) (when (symbol-value 'auto-revert-notify-watch-descriptor)
@ -502,12 +499,7 @@ will use an up-to-date value of `auto-revert-interval'"
(puthash key value auto-revert-notify-watch-descriptor-hash-list) (puthash key value auto-revert-notify-watch-descriptor-hash-list)
(remhash key auto-revert-notify-watch-descriptor-hash-list) (remhash key auto-revert-notify-watch-descriptor-hash-list)
(ignore-errors (ignore-errors
(funcall (file-notify-rm-watch auto-revert-notify-watch-descriptor)))))
(cond
((fboundp 'gfile-rm-watch) 'gfile-rm-watch)
((fboundp 'inotify-rm-watch) 'inotify-rm-watch)
((fboundp 'w32notify-rm-watch) 'w32notify-rm-watch))
auto-revert-notify-watch-descriptor)))))
auto-revert-notify-watch-descriptor-hash-list) auto-revert-notify-watch-descriptor-hash-list)
(remove-hook 'kill-buffer-hook 'auto-revert-notify-rm-watch)) (remove-hook 'kill-buffer-hook 'auto-revert-notify-rm-watch))
(setq auto-revert-notify-watch-descriptor nil (setq auto-revert-notify-watch-descriptor nil
@ -522,100 +514,58 @@ will use an up-to-date value of `auto-revert-interval'"
(when (and buffer-file-name auto-revert-use-notify (when (and buffer-file-name auto-revert-use-notify
(not auto-revert-notify-watch-descriptor)) (not auto-revert-notify-watch-descriptor))
(let ((func (setq auto-revert-notify-watch-descriptor
(cond (ignore-errors
((fboundp 'gfile-add-watch) 'gfile-add-watch) (file-notify-add-watch
((fboundp 'inotify-add-watch) 'inotify-add-watch) (expand-file-name buffer-file-name default-directory)
((fboundp 'w32notify-add-watch) 'w32notify-add-watch))) '(change attribute-change) 'auto-revert-notify-handler)))
(aspect (if auto-revert-notify-watch-descriptor
(cond (progn
((fboundp 'gfile-add-watch) '(watch-mounts)) (puthash
;; `attrib' is needed for file modification time. auto-revert-notify-watch-descriptor
((fboundp 'inotify-add-watch) '(attrib create modify moved-to)) (cons (current-buffer)
((fboundp 'w32notify-add-watch) '(size last-write-time)))) (gethash auto-revert-notify-watch-descriptor
(file (if (or (fboundp 'gfile-add-watch) (fboundp 'inotify-add-watch)) auto-revert-notify-watch-descriptor-hash-list))
(directory-file-name (expand-file-name default-directory)) auto-revert-notify-watch-descriptor-hash-list)
(buffer-file-name)))) (add-hook (make-local-variable 'kill-buffer-hook)
(setq auto-revert-notify-watch-descriptor 'auto-revert-notify-rm-watch))
(ignore-errors ;; Fallback to file checks.
(funcall func file aspect 'auto-revert-notify-handler))) (set (make-local-variable 'auto-revert-use-notify) nil))))
(if auto-revert-notify-watch-descriptor
(progn
(puthash
auto-revert-notify-watch-descriptor
(cons (current-buffer)
(gethash auto-revert-notify-watch-descriptor
auto-revert-notify-watch-descriptor-hash-list))
auto-revert-notify-watch-descriptor-hash-list)
(add-hook (make-local-variable 'kill-buffer-hook)
'auto-revert-notify-rm-watch))
;; Fallback to file checks.
(set (make-local-variable 'auto-revert-use-notify) nil)))))
(defun auto-revert-notify-event-p (event)
"Check that event is a file notification event."
(and (listp event)
(cond ((featurep 'gfilenotify)
(and (>= (length event) 3) (stringp (nth 2 event))))
((featurep 'inotify)
(= (length event) 4))
((featurep 'w32notify)
(and (= (length event) 3) (stringp (nth 2 event)))))))
(defun auto-revert-notify-event-descriptor (event)
"Return watch descriptor of file notification event, or nil."
(and (auto-revert-notify-event-p event) (car event)))
(defun auto-revert-notify-event-action (event)
"Return action of file notification event, or nil."
(and (auto-revert-notify-event-p event) (nth 1 event)))
(defun auto-revert-notify-event-file-name (event)
"Return file name of file notification event, or nil."
(and (auto-revert-notify-event-p event)
(cond ((featurep 'gfilenotify) (nth 2 event))
((featurep 'inotify) (nth 3 event))
((featurep 'w32notify) (nth 2 event)))))
(defun auto-revert-notify-handler (event) (defun auto-revert-notify-handler (event)
"Handle an EVENT returned from file notification." "Handle an EVENT returned from file notification."
(when (auto-revert-notify-event-p event) (ignore-errors
(let* ((descriptor (auto-revert-notify-event-descriptor event)) (let* ((descriptor (car event))
(action (auto-revert-notify-event-action event)) (action (nth 1 event))
(file (auto-revert-notify-event-file-name event)) (file (nth 2 event))
(file1 (nth 3 event)) ;; Target of `renamed'.
(buffers (gethash descriptor (buffers (gethash descriptor
auto-revert-notify-watch-descriptor-hash-list))) auto-revert-notify-watch-descriptor-hash-list)))
(ignore-errors ;; Check, that event is meant for us.
;; Check, that event is meant for us. (cl-assert descriptor)
;; TODO: Filter events which stop watching, like `move' or `removed'. ;; We do not handle `deleted', because nothing has to be refreshed.
(cl-assert descriptor) (cl-assert (memq action '(attribute-changed changed created renamed)) t)
(cond ;; Since we watch a directory, a file name must be returned.
((featurep 'gfilenotify) (cl-assert (stringp file))
(cl-assert (memq action '(attribute-changed changed created deleted (when (eq action 'renamed) (cl-assert (stringp file1)))
;; FIXME: I keep getting this action, so I ;; Loop over all buffers, in order to find the intended one.
;; added it here, but I have no idea what (dolist (buffer buffers)
;; I'm doing. --Stef (when (buffer-live-p buffer)
changes-done-hint)) (with-current-buffer buffer
t)) (when (and (stringp buffer-file-name)
((featurep 'inotify) (or
(cl-assert (or (memq 'attrib action) (and (memq action '(attribute-changed changed created))
(memq 'create action) (string-equal
(memq 'modify action) (file-name-nondirectory file)
(memq 'moved-to action)))) (file-name-nondirectory buffer-file-name)))
((featurep 'w32notify) (cl-assert (eq 'modified action)))) (and (eq action 'renamed)
;; Since we watch a directory, a file name must be returned. (string-equal
(cl-assert (stringp file)) (file-name-nondirectory file1)
(dolist (buffer buffers) (file-name-nondirectory buffer-file-name)))))
(when (buffer-live-p buffer) ;; Mark buffer modified.
(with-current-buffer buffer (setq auto-revert-notify-modified-p t)
(when (and (stringp buffer-file-name) ;; No need to check other buffers.
(string-equal (cl-return))))))))
(file-name-nondirectory file)
(file-name-nondirectory buffer-file-name)))
;; Mark buffer modified.
(setq auto-revert-notify-modified-p t)
;; No need to check other buffers.
(cl-return)))))))))
(defun auto-revert-active-p () (defun auto-revert-active-p ()
"Check if auto-revert is active (in current buffer or globally)." "Check if auto-revert is active (in current buffer or globally)."

324
lisp/filenotify.el Normal file
View file

@ -0,0 +1,324 @@
;;; filenotify.el --- watch files for changes on disk
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary
;; This package is an abstraction layer from the different low-level
;; file notification packages `gfilenotify', `inotify' and
;; `w32notify'.
;;; Code:
;;;###autoload
(defconst file-notify-support
(cond
((featurep 'gfilenotify) 'gfilenotify)
((featurep 'inotify) 'inotify)
((featurep 'w32notify) 'w32notify))
"Non-nil when Emacs has been compiled with file notification support.
The value is the name of the low-level file notification package
to be used for local file systems. Remote file notifications
could use another implementation.")
(defvar file-notify-descriptors (make-hash-table :test 'equal)
"Hash table for registered file notification descriptors.
A key in this hash table is the descriptor as returned from
`gfilenotify', `inotify', `w32notify' or a file name handler.
The value in the hash table is the cons cell (DIR FILE CALLBACK).")
;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
;;;###autoload
(defun file-notify-handle-event (event)
"Handle file system monitoring event.
If EVENT is a filewatch event, call its callback.
Otherwise, signal a `file-notify-error'."
(interactive "e")
(if (and (eq (car event) 'file-notify)
(>= (length event) 3))
(funcall (nth 2 event) (nth 1 event))
(signal 'file-notify-error
(cons "Not a valid file-notify event" event))))
(defvar file-notify--pending-events nil
"List of pending file notification events for a future `renamed' action.
The entries are a list (DESCRIPTOR ACTION FILE COOKIE). ACTION
is either `moved-from' or `renamed-from'.")
(defun file-notify--event-file-name (event)
"Return file name of file notification event, or nil."
(expand-file-name
(or (and (stringp (nth 2 event)) (nth 2 event)) "")
(car (gethash (car event) file-notify-descriptors))))
;; Only `gfilenotify' could return two file names.
(defun file-notify--event-file1-name (event)
"Return second file name of file notification event, or nil.
This is available in case a file has been moved."
(and (stringp (nth 3 event))
(expand-file-name
(nth 3 event) (car (gethash (car event) file-notify-descriptors)))))
;; Cookies are offered by `inotify' only.
(defun file-notify--event-cookie (event)
"Return cookie of file notification event, or nil.
This is available in case a file has been moved."
(nth 3 event))
;; The callback function used to map between specific flags of the
;; respective file notifications, and the ones we return.
(defun file-notify-callback (event)
"Handle an EVENT returned from file notification.
EVENT is the same one as in `file-notify-handle-event' except the
car of that event, which is the symbol `file-notify'."
(let* ((desc (car event))
(registered (gethash desc file-notify-descriptors))
(pending-event (assoc desc file-notify--pending-events))
(actions (nth 1 event))
(file (file-notify--event-file-name event))
file1 cookie callback)
;; Make actions a list.
(unless (consp actions) (setq actions (cons actions nil)))
;; Check, that event is meant for us.
(unless (setq callback (nth 2 registered))
(setq actions nil))
;; Loop over actions. In fact, more than one action happens only
;; for `inotify'.
(dolist (action actions)
;; Send pending event, if it doesn't match.
(when (and pending-event
;; The cookie doesn't match.
(not (eq (file-notify--event-cookie pending-event)
(file-notify--event-cookie event)))
(or
;; inotify.
(and (eq (nth 1 pending-event) 'moved-from)
(not (eq action 'moved-to)))
;; w32notify.
(and (eq (nth 1 pending-event) 'renamed-from)
(not (eq action 'renamed-to)))))
(funcall callback
(list desc 'deleted
(file-notify--event-file-name pending-event)))
(setq file-notify--pending-events
(delete pending-event file-notify--pending-events)))
;; Map action. We ignore all events which cannot be mapped.
(setq action
(cond
;; gfilenotify.
((memq action '(attribute-changed changed created deleted)) action)
((eq action 'moved)
(setq file1 (file-notify--event-file1-name event))
'renamed)
;; inotify.
((eq action 'attrib) 'attribute-changed)
((eq action 'create) 'created)
((eq action 'modify) 'changed)
((memq action '(delete 'delete-self move-self)) 'deleted)
;; Make the event pending.
((eq action 'moved-from)
(add-to-list 'file-notify--pending-events
(list desc action file
(file-notify--event-cookie event)))
nil)
;; Look for pending event.
((eq action 'moved-to)
(if (null pending-event)
'created
(setq file1 file
file (file-notify--event-file-name pending-event)
file-notify--pending-events
(delete pending-event file-notify--pending-events))
'renamed))
;; w32notify.
((eq action 'added) 'created)
((eq action 'modified) 'changed)
((eq action 'removed) 'deleted)
;; Make the event pending.
((eq 'renamed-from action)
(add-to-list 'file-notify--pending-events
(list desc action file
(file-notify--event-cookie event)))
nil)
;; Look for pending event.
((eq 'renamed-to action)
(if (null pending-event)
'created
(setq file1 file
file (file-notify--event-file-name pending-event)
file-notify--pending-events
(delete pending-event file-notify--pending-events))
'renamed))))
;; Apply callback.
(when (and action
(or
;; If there is no relative file name for that watch,
;; we watch the whole directory.
(null (nth 1 registered))
;; File matches.
(string-equal
(nth 1 registered) (file-name-nondirectory file))
;; File1 matches.
(and (stringp file1)
(string-equal
(nth 1 registered) (file-name-nondirectory file1)))))
(if file1
(funcall callback (list desc action file file1))
(funcall callback (list desc action file)))))))
(defun file-notify-add-watch (file flags callback)
"Add a watch for filesystem events pertaining to FILE.
This arranges for filesystem events pertaining to FILE to be reported
to Emacs. Use `file-notify-rm-watch' to cancel the watch.
The returned value is a descriptor for the added watch. If the
file cannot be watched for some reason, this function signals a
`file-notify-error' error.
FLAGS is a list of conditions to set what will be watched for. It can
include the following symbols:
`change' -- watch for file changes
`attribute-change' -- watch for file attributes changes, like
permissions or modification time
If FILE is a directory, 'change' watches for file creation or
deletion in that directory.
When any event happens, Emacs will call the CALLBACK function passing
it a single argument EVENT, which is of the form
(DESCRIPTOR ACTION FILE [FILE1])
DESCRIPTOR is the same object as the one returned by this function.
ACTION is the description of the event. It could be any one of the
following:
`created' -- FILE was created
`deleted' -- FILE was deleted
`changed' -- FILE has changed
`renamed' -- FILE has been renamed to FILE1
`attribute-changed' -- a FILE attribute was changed
FILE is the name of the file whose event is being reported."
;; Check arguments.
(unless (stringp file)
(signal 'wrong-type-argument (list file)))
(setq file (expand-file-name file))
(unless (and (consp flags)
(null (delq 'change (delq 'attribute-change (copy-tree flags)))))
(signal 'wrong-type-argument (list flags)))
(unless (functionp callback)
(signal 'wrong-type-argument (list callback)))
(let* ((handler (find-file-name-handler file 'file-notify-add-watch))
(dir (directory-file-name
(if (or (and (not handler) (eq file-notify-support 'w32notify))
(file-directory-p file))
file
(file-name-directory file))))
desc func l-flags)
;; Check, whether this has been registered already.
; (maphash
; (lambda (key value)
; (when (equal (cons file callback) value) (setq desc key)))
; file-notify-descriptors)
(unless desc
(if handler
;; A file name handler could exist even if there is no local
;; file notification support.
(setq desc (funcall
handler 'file-notify-add-watch dir flags callback))
;; Check, whether Emacs has been compiled with file
;; notification support.
(unless file-notify-support
(signal 'file-notify-error
'("No file notification package available")))
;; Determine low-level function to be called.
(setq func (cond
((eq file-notify-support 'gfilenotify) 'gfile-add-watch)
((eq file-notify-support 'inotify) 'inotify-add-watch)
((eq file-notify-support 'w32notify) 'w32notify-add-watch)))
;; Determine respective flags.
(if (eq file-notify-support 'gfilenotify)
(setq l-flags '(watch-mounts send-moved))
(when (memq 'change flags)
(setq
l-flags
(cond
((eq file-notify-support 'inotify) '(create modify move delete))
((eq file-notify-support 'w32notify)
'(file-name directory-name size last-write-time)))))
(when (memq 'attribute-change flags)
(add-to-list
'l-flags
(cond
((eq file-notify-support 'inotify) 'attrib)
((eq file-notify-support 'w32notify) 'attributes)))))
;; Call low-level function.
(setq desc (funcall func dir l-flags 'file-notify-callback))))
;; Return descriptor.
(puthash desc
(list (directory-file-name
(if (file-directory-p dir) dir (file-name-directory dir)))
(unless (file-directory-p file)
(file-name-nondirectory file))
callback)
file-notify-descriptors)
desc))
(defun file-notify-rm-watch (descriptor)
"Remove an existing watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(let ((file (car (gethash descriptor file-notify-descriptors)))
handler)
(when (stringp file)
(setq handler (find-file-name-handler file 'file-notify-rm-watch))
(if handler
(funcall handler 'file-notify-rm-watch descriptor)
(funcall
(cond
((eq file-notify-support 'gfilenotify) 'gfile-rm-watch)
((eq file-notify-support 'inotify) 'inotify-rm-watch)
((eq file-notify-support 'w32notify) 'w32notify-rm-watch))
descriptor)))
(remhash descriptor file-notify-descriptors)))
;; The end:
(provide 'filenotify)
;;; filenotify.el ends here

View file

@ -862,7 +862,9 @@ of command line.")
(set-file-selinux-context . tramp-sh-handle-set-file-selinux-context) (set-file-selinux-context . tramp-sh-handle-set-file-selinux-context)
(file-acl . tramp-sh-handle-file-acl) (file-acl . tramp-sh-handle-file-acl)
(set-file-acl . tramp-sh-handle-set-file-acl) (set-file-acl . tramp-sh-handle-set-file-acl)
(vc-registered . tramp-sh-handle-vc-registered)) (vc-registered . tramp-sh-handle-vc-registered)
(file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-sh-handle-file-notify-rm-watch))
"Alist of handler functions. "Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.") Operations not mentioned here will be handled by the normal Emacs functions.")
@ -2669,7 +2671,7 @@ the result will be a local, non-Tramp, filename."
(unless (memq (process-status proc) '(run open)) (unless (memq (process-status proc) '(run open))
(let ((vec (tramp-get-connection-property proc "vector" nil))) (let ((vec (tramp-get-connection-property proc "vector" nil)))
(when vec (when vec
(tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event) (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-property proc) (tramp-flush-connection-property proc)
(tramp-flush-directory-property vec ""))))) (tramp-flush-directory-property vec "")))))
@ -3376,6 +3378,63 @@ Fall back to normal file name handler if no Tramp handler exists."
;; Default file name handlers, we don't care. ;; Default file name handlers, we don't care.
(t (tramp-run-real-handler operation args))))))) (t (tramp-run-real-handler operation args)))))))
;; We use inotify for implementation. It is more likely to exist than glib.
(defun tramp-sh-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* ((default-directory (file-name-directory file-name))
(command (tramp-get-remote-inotifywait v))
(events
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
"create,modify,move,delete,attrib")
((memq 'change flags) "create,modify,move,delete")
((memq 'attribute-change flags) "attrib")))
(p (and command
(start-file-process
"inotifywait" (generate-new-buffer " *inotifywait*")
command "-mq" "-e" events localname))))
;; Return the process object as watch-descriptor.
(if (not (processp p))
(tramp-error
v 'file-notify-error "`inotifywait' not found on remote host")
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-filter p 'tramp-sh-file-notify-process-filter)
p))))
(defun tramp-sh-file-notify-process-filter (proc string)
"Read output from \"inotifywait\" and add corresponding file-notify events."
(tramp-message proc 6 (format "%S\n%s" proc string))
(dolist (line (split-string string "[\n\r]+" 'omit-nulls))
;; Check, whether there is a problem.
(unless
(string-match
"^[^[:blank:]]+[[:blank:]]+\\([^[:blank:]]+\\)+\\([[:blank:]]+\\([^[:blank:]]+\\)\\)?[[:blank:]]*$" line)
(tramp-error proc 'file-notify-error "%s" line))
;; 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.
(let* ((object
(list
proc
(mapcar
(lambda (x)
(intern-soft (replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit-nulls))
(match-string 3 line))))
(tramp-compat-funcall 'file-notify-callback object))))
(defvar file-notify-descriptors)
(defun tramp-sh-handle-file-notify-rm-watch (proc)
"Like `file-notify-rm-watch' for Tramp files."
;; The descriptor must be a process object.
(unless (and (processp proc) (gethash proc file-notify-descriptors))
(tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
(tramp-message proc 6 (format "Kill %S" proc))
(kill-process proc))
;;; Internal Functions: ;;; Internal Functions:
(defun tramp-maybe-send-script (vec script name) (defun tramp-maybe-send-script (vec script name)
@ -4864,6 +4923,11 @@ Return ATTR."
(tramp-message vec 5 "Finding a suitable `trash' command") (tramp-message vec 5 "Finding a suitable `trash' command")
(tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
(defun tramp-get-remote-inotifywait (vec)
(with-tramp-connection-property vec "inotifywait"
(tramp-message vec 5 "Finding a suitable `inotifywait' command")
(tramp-find-executable vec "inotifywait" (tramp-get-remote-path vec) t t)))
(defun tramp-get-remote-id (vec) (defun tramp-get-remote-id (vec)
(with-tramp-connection-property vec "id" (with-tramp-connection-property vec "id"
(tramp-message vec 5 "Finding POSIX `id' command") (tramp-message vec 5 "Finding POSIX `id' command")

View file

@ -1964,7 +1964,7 @@ ARGS are the arguments OPERATION has been called with."
;; Emacs 22+ only. ;; Emacs 22+ only.
'set-file-times 'set-file-times
;; Emacs 24+ only. ;; Emacs 24+ only.
'file-acl 'file-selinux-context 'file-acl 'file-notify-add-watch 'file-selinux-context
'set-file-acl 'set-file-selinux-context 'set-file-acl 'set-file-selinux-context
;; XEmacs only. ;; XEmacs only.
'abbreviate-file-name 'create-file-buffer 'abbreviate-file-name 'create-file-buffer
@ -2018,6 +2018,10 @@ ARGS are the arguments OPERATION has been called with."
;; XEmacs only. ;; XEmacs only.
'dired-print-file 'dired-shell-call-process)) 'dired-print-file 'dired-shell-call-process))
default-directory) default-directory)
;; PROC.
((eq operation 'file-notify-rm-watch)
(with-current-buffer (process-buffer (nth 0 args))
default-directory))
;; Unknown file primitive. ;; Unknown file primitive.
(t (error "unknown file I/O primitive: %s" operation)))) (t (error "unknown file I/O primitive: %s" operation))))

View file

@ -4495,20 +4495,6 @@ convenience wrapper around `make-progress-reporter' and friends.
(progress-reporter-done ,temp2) (progress-reporter-done ,temp2)
nil ,@(cdr (cdr spec))))) nil ,@(cdr (cdr spec)))))
;;;; Support for watching filesystem events.
(defun file-notify-handle-event (event)
"Handle file system monitoring event.
If EVENT is a filewatch event, call its callback.
Otherwise, signal a `filewatch-error'."
(interactive "e")
(if (and (eq (car event) 'file-notify)
(>= (length event) 3))
(funcall (nth 2 event) (nth 1 event))
(signal 'filewatch-error
(cons "Not a valid file-notify event" event))))
;;;; Comparing version strings. ;;;; Comparing version strings.