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:
parent
86dfb7a815
commit
864c58ca5f
6 changed files with 474 additions and 123 deletions
|
|
@ -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>
|
||||||
|
|
|
||||||
|
|
@ -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
324
lisp/filenotify.el
Normal 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
|
||||||
|
|
@ -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")
|
||||||
|
|
|
||||||
|
|
@ -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))))
|
||||||
|
|
||||||
|
|
|
||||||
14
lisp/subr.el
14
lisp/subr.el
|
|
@ -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.
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue