[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r113280: * filenotify.el: New package.
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] trunk r113280: * filenotify.el: New package. |
|
Date: |
Thu, 04 Jul 2013 09:39:43 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 113280
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Thu 2013-07-04 11:39:36 +0200
message:
* 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.
added:
lisp/filenotify.el filenotify.el-20130625113410-31so8z8hgotqv5s4-1
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/autorevert.el
autorevert.el-20091113204419-o5vbwnq5f7feedwu-1197
lisp/net/tramp-sh.el trampsh.el-20100913133439-a1faifh29eqoi4nh-1
lisp/net/tramp.el tramp.el-20091113204419-o5vbwnq5f7feedwu-2427
lisp/subr.el subr.el-20091113204419-o5vbwnq5f7feedwu-151
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-07-03 23:11:58 +0000
+++ b/lisp/ChangeLog 2013-07-04 09:39:36 +0000
@@ -1,3 +1,26 @@
+2013-07-04 Michael Albinus <address@hidden>
+
+ * 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 <address@hidden>
* buff-menu.el (Buffer-menu-multi-occur): Add args and move the
@@ -299,12 +322,12 @@
2013-06-25 Rüdiger Sonderfeld <address@hidden>
- * lisp/textmodes/bibtex.el (bibtex-generate-url-list): Add support
+ * textmodes/bibtex.el (bibtex-generate-url-list): Add support
for DOI URLs.
2013-06-25 Rüdiger Sonderfeld <address@hidden>
- * lisp/textmodes/bibtex.el (bibtex-mode, bibtex-set-dialect):
+ * textmodes/bibtex.el (bibtex-mode, bibtex-set-dialect):
Update imenu-support when dialect changes.
2013-06-25 Leo Liu <address@hidden>
=== modified file 'lisp/autorevert.el'
--- a/lisp/autorevert.el 2013-06-05 19:57:10 +0000
+++ b/lisp/autorevert.el 2013-07-04 09:39:36 +0000
@@ -103,6 +103,7 @@
(eval-when-compile (require 'cl-lib))
(require 'timer)
+(require 'filenotify)
;; Custom Group:
;;
@@ -270,21 +271,17 @@
:type 'boolean
:version "24.4")
-(defconst auto-revert-notify-enabled
- (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
+(defcustom auto-revert-use-notify (and file-notify-support t)
"If non-nil Auto Revert Mode uses file notification functions.
This requires Emacs being compiled with file notification
-support (see `auto-revert-notify-enabled'). You should set this
-variable through Custom."
+support (see `file-notify-support'). You should set this variable
+through Custom."
:group 'auto-revert
:type 'boolean
: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)
- (when auto-revert-notify-enabled
+ (when file-notify-support
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (symbol-value 'auto-revert-notify-watch-descriptor)
@@ -502,12 +499,7 @@
(puthash key value auto-revert-notify-watch-descriptor-hash-list)
(remhash key auto-revert-notify-watch-descriptor-hash-list)
(ignore-errors
- (funcall
- (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)))))
+ (file-notify-rm-watch auto-revert-notify-watch-descriptor)))))
auto-revert-notify-watch-descriptor-hash-list)
(remove-hook 'kill-buffer-hook 'auto-revert-notify-rm-watch))
(setq auto-revert-notify-watch-descriptor nil
@@ -522,100 +514,58 @@
(when (and buffer-file-name auto-revert-use-notify
(not auto-revert-notify-watch-descriptor))
- (let ((func
- (cond
- ((fboundp 'gfile-add-watch) 'gfile-add-watch)
- ((fboundp 'inotify-add-watch) 'inotify-add-watch)
- ((fboundp 'w32notify-add-watch) 'w32notify-add-watch)))
- (aspect
- (cond
- ((fboundp 'gfile-add-watch) '(watch-mounts))
- ;; `attrib' is needed for file modification time.
- ((fboundp 'inotify-add-watch) '(attrib create modify moved-to))
- ((fboundp 'w32notify-add-watch) '(size last-write-time))))
- (file (if (or (fboundp 'gfile-add-watch) (fboundp 'inotify-add-watch))
- (directory-file-name (expand-file-name default-directory))
- (buffer-file-name))))
- (setq auto-revert-notify-watch-descriptor
- (ignore-errors
- (funcall func file aspect 'auto-revert-notify-handler)))
- (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)))))
+ (setq auto-revert-notify-watch-descriptor
+ (ignore-errors
+ (file-notify-add-watch
+ (expand-file-name buffer-file-name default-directory)
+ '(change attribute-change) 'auto-revert-notify-handler)))
+ (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-handler (event)
"Handle an EVENT returned from file notification."
- (when (auto-revert-notify-event-p event)
- (let* ((descriptor (auto-revert-notify-event-descriptor event))
- (action (auto-revert-notify-event-action event))
- (file (auto-revert-notify-event-file-name event))
+ (ignore-errors
+ (let* ((descriptor (car event))
+ (action (nth 1 event))
+ (file (nth 2 event))
+ (file1 (nth 3 event)) ;; Target of `renamed'.
(buffers (gethash descriptor
auto-revert-notify-watch-descriptor-hash-list)))
- (ignore-errors
- ;; Check, that event is meant for us.
- ;; TODO: Filter events which stop watching, like `move' or `removed'.
- (cl-assert descriptor)
- (cond
- ((featurep 'gfilenotify)
- (cl-assert (memq action '(attribute-changed changed created deleted
- ;; FIXME: I keep getting this action, so I
- ;; added it here, but I have no idea what
- ;; I'm doing. --Stef
- changes-done-hint))
- t))
- ((featurep 'inotify)
- (cl-assert (or (memq 'attrib action)
- (memq 'create action)
- (memq 'modify action)
- (memq 'moved-to action))))
- ((featurep 'w32notify) (cl-assert (eq 'modified action))))
- ;; Since we watch a directory, a file name must be returned.
- (cl-assert (stringp file))
- (dolist (buffer buffers)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (when (and (stringp buffer-file-name)
- (string-equal
- (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)))))))))
+ ;; Check, that event is meant for us.
+ (cl-assert descriptor)
+ ;; We do not handle `deleted', because nothing has to be refreshed.
+ (cl-assert (memq action '(attribute-changed changed created renamed)) t)
+ ;; Since we watch a directory, a file name must be returned.
+ (cl-assert (stringp file))
+ (when (eq action 'renamed) (cl-assert (stringp file1)))
+ ;; Loop over all buffers, in order to find the intended one.
+ (dolist (buffer buffers)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (and (stringp buffer-file-name)
+ (or
+ (and (memq action '(attribute-changed changed created))
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory buffer-file-name)))
+ (and (eq action 'renamed)
+ (string-equal
+ (file-name-nondirectory file1)
+ (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 ()
"Check if auto-revert is active (in current buffer or globally)."
=== added file 'lisp/filenotify.el'
--- a/lisp/filenotify.el 1970-01-01 00:00:00 +0000
+++ b/lisp/filenotify.el 2013-07-04 09:39:36 +0000
@@ -0,0 +1,324 @@
+;;; filenotify.el --- watch files for changes on disk
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+
+;; 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
=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el 2013-06-19 13:14:24 +0000
+++ b/lisp/net/tramp-sh.el 2013-07-04 09:39:36 +0000
@@ -862,7 +862,9 @@
(set-file-selinux-context . tramp-sh-handle-set-file-selinux-context)
(file-acl . tramp-sh-handle-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.
Operations not mentioned here will be handled by the normal Emacs functions.")
@@ -2669,7 +2671,7 @@
(unless (memq (process-status proc) '(run open))
(let ((vec (tramp-get-connection-property proc "vector" nil)))
(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-directory-property vec "")))))
@@ -3376,6 +3378,63 @@
;; Default file name handlers, we don't care.
(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:
(defun tramp-maybe-send-script (vec script name)
@@ -4864,6 +4923,11 @@
(tramp-message vec 5 "Finding a suitable `trash' command")
(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)
(with-tramp-connection-property vec "id"
(tramp-message vec 5 "Finding POSIX `id' command")
=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2013-04-22 10:26:09 +0000
+++ b/lisp/net/tramp.el 2013-07-04 09:39:36 +0000
@@ -1964,7 +1964,7 @@
;; Emacs 22+ only.
'set-file-times
;; Emacs 24+ only.
- 'file-acl 'file-selinux-context
+ 'file-acl 'file-notify-add-watch 'file-selinux-context
'set-file-acl 'set-file-selinux-context
;; XEmacs only.
'abbreviate-file-name 'create-file-buffer
@@ -2018,6 +2018,10 @@
;; XEmacs only.
'dired-print-file 'dired-shell-call-process))
default-directory)
+ ;; PROC.
+ ((eq operation 'file-notify-rm-watch)
+ (with-current-buffer (process-buffer (nth 0 args))
+ default-directory))
;; Unknown file primitive.
(t (error "unknown file I/O primitive: %s" operation))))
=== modified file 'lisp/subr.el'
--- a/lisp/subr.el 2013-07-03 03:20:04 +0000
+++ b/lisp/subr.el 2013-07-04 09:39:36 +0000
@@ -4496,20 +4496,6 @@
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.
(defconst version-separator "."
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r113280: * filenotify.el: New package.,
Michael Albinus <=