Several values for a given DIR happen only for `inotify', when
different files from the same directory are watched.")
+(defun file-notify--rm-descriptor (descriptor &optional what)
+ "Remove DESCRIPTOR from `file-notify-descriptors'.
+DESCRIPTOR should be an object returned by `file-notify-add-watch'.
+If it is registered in `file-notify-descriptors', a stopped event is sent.
+WHAT is a file or directory name to be removed, needed just for `inotify'."
+ (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
+ (file (if (consp descriptor) (cdr descriptor)))
+ (registered (gethash desc file-notify-descriptors))
+ (dir (car registered)))
+
+ (when (and (consp registered) (or (null what) (string-equal dir what)))
+ ;; Send `stopped' event.
+ (dolist (entry (cdr registered))
+ (funcall (cdr entry)
+ `(,descriptor stopped
+ ,(or (and (stringp (car entry))
+ (expand-file-name (car entry) dir))
+ dir))))
+
+ ;; Modify `file-notify-descriptors'.
+ (if (not file)
+ (remhash desc file-notify-descriptors)
+ (setcdr registered
+ (delete (assoc file (cdr registered)) (cdr registered)))
+ (if (null (cdr registered))
+ (remhash desc file-notify-descriptors)
+ (puthash desc registered file-notify-descriptors))))))
+
;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
;;;###autoload
(defun file-notify-handle-event (event)
Otherwise, signal a `file-notify-error'."
(interactive "e")
+ ;;(message "file-notify-handle-event %S" event)
(if (and (eq (car event) 'file-notify)
(>= (length event) 3))
(funcall (nth 2 event) (nth 1 event))
(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))))
+ (directory-file-name
+ (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)))))
+ (directory-file-name
+ (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)
;; `inotify' returns the same descriptor when the file (directory)
;; uses the same inode. We want to distinguish, and apply a virtual
;; descriptor which make the difference.
-(defun file-notify--descriptor (descriptor)
+(defun file-notify--descriptor (desc file)
"Return the descriptor to be used in `file-notify-*-watch'.
For `gfilenotify' and `w32notify' it is the same descriptor as
used in the low-level file notification package."
- (if (and (natnump descriptor) (eq file-notify--library 'inotify))
- (cons descriptor
- (car (cadr (gethash descriptor file-notify-descriptors))))
- descriptor))
+ (if (and (natnump desc) (eq file-notify--library 'inotify))
+ (cons desc
+ (and (stringp file)
+ (car (assoc
+ (file-name-nondirectory file)
+ (gethash desc file-notify-descriptors)))))
+ desc))
;; The callback function used to map between specific flags of the
;; respective file notifications, and the ones we return.
(registered (gethash desc file-notify-descriptors))
(actions (nth 1 event))
(file (file-notify--event-file-name event))
- file1 callback pending-event)
+ file1 callback pending-event stopped)
;; Make actions a list.
(unless (consp actions) (setq actions (cons actions nil)))
'renamed)
;; inotify, w32notify.
+ ((eq action 'ignored)
+ (setq stopped t actions nil))
((eq action 'attrib) 'attribute-changed)
((memq action '(create added)) 'created)
((memq action '(modify modified)) 'changed)
(car file-notify--pending-event)))
;; If the source is handled by another watch, we
;; must fire the rename event there as well.
- (when (not (equal (file-notify--descriptor desc)
+ (when (not (equal (file-notify--descriptor desc file1)
(file-notify--descriptor
- (caar file-notify--pending-event))))
+ (caar file-notify--pending-event)
+ (file-notify--event-file-name
+ file-notify--pending-event))))
(setq pending-event
`((,(caar file-notify--pending-event)
renamed ,file ,file1)
;; Apply pending callback.
(when pending-event
(setcar
- (car pending-event) (file-notify--descriptor (caar pending-event)))
+ (car pending-event)
+ (file-notify--descriptor
+ (caar pending-event)
+ (file-notify--event-file-name file-notify--pending-event)))
(funcall (cadr pending-event) (car pending-event))
(setq pending-event nil))
+ ;; Check for stopped.
+ ;;(message "file-notify-callback %S %S" file registered)
+ (setq
+ stopped
+ (or
+ stopped
+ (and
+ (memq action '(deleted renamed))
+ (= (length (cdr registered)) 1)
+ (string-equal
+ (file-name-nondirectory file)
+ (or (file-name-nondirectory (car registered))
+ (car (cadr registered)))))))
+
;; Apply callback.
(when (and action
(or
(if file1
(funcall
callback
- `(,(file-notify--descriptor desc) ,action ,file ,file1))
+ `(,(file-notify--descriptor desc file) ,action ,file ,file1))
(funcall
callback
- `(,(file-notify--descriptor desc) ,action ,file))))))))
+ `(,(file-notify--descriptor desc file) ,action ,file)))))
+
+ ;; Modify `file-notify-descriptors'.
+ (when stopped
+ (file-notify--rm-descriptor
+ (file-notify--descriptor desc file) file)))))
;; `gfilenotify' and `w32notify' return a unique descriptor for every
;; `file-notify-add-watch', while `inotify' returns a unique
`changed' -- FILE has changed
`renamed' -- FILE has been renamed to FILE1
`attribute-changed' -- a FILE attribute was changed
+ `stopped' -- watching FILE has been stopped
FILE is the name of the file whose event is being reported."
;; Check arguments.
(unless (stringp file)
- (signal 'wrong-type-argument (list file)))
+ (signal 'wrong-type-argument `(,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)))
+ (signal 'wrong-type-argument `(,flags)))
(unless (functionp callback)
- (signal 'wrong-type-argument (list callback)))
+ (signal 'wrong-type-argument `(,callback)))
(let* ((handler (find-file-name-handler file 'file-notify-add-watch))
(dir (directory-file-name
(file-name-directory file))))
desc func l-flags registered)
+ (unless (file-directory-p dir)
+ (signal 'file-notify-error `("Directory does not exist" ,dir)))
+
(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.
+ ;; Check, whether Emacs has been compiled with file notification
+ ;; support.
(unless file-notify--library
(signal 'file-notify-error
'("No file notification package available")))
(setq
l-flags
(cond
- ((eq file-notify--library 'inotify) '(create modify move delete))
+ ((eq file-notify--library 'inotify)
+ '(create delete delete-self modify move-self move))
((eq file-notify--library 'w32notify)
'(file-name directory-name size last-write-time)))))
(when (memq 'attribute-change flags)
file-notify-descriptors)
;; Return descriptor.
- (file-notify--descriptor desc)))
+ (file-notify--descriptor
+ desc (unless (file-directory-p file) (file-name-nondirectory file)))))
(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* ((desc (if (consp descriptor) (car descriptor) descriptor))
(file (if (consp descriptor) (cdr descriptor)))
- (dir (car (gethash desc file-notify-descriptors)))
- handler registered)
+ (registered (gethash desc file-notify-descriptors))
+ (dir (car registered))
+ (handler (and (stringp dir)
+ (find-file-name-handler dir 'file-notify-rm-watch))))
(when (stringp dir)
;; Call low-level function.
- (setq handler (find-file-name-handler dir 'file-notify-rm-watch))
- (condition-case nil
- (if handler
- ;; A file name handler could exist even if there is no
- ;; local file notification support.
- (funcall handler 'file-notify-rm-watch desc)
-
- (funcall
- (cond
- ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
- ((eq file-notify--library 'inotify) 'inotify-rm-watch)
- ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
- desc))
- (file-notify-error nil))
+ (when (or (not file)
+ (and (= (length (cdr registered)) 1)
+ (assoc file (cdr registered))))
+ (condition-case nil
+ (if handler
+ ;; A file name handler could exist even if there is no local
+ ;; file notification support.
+ (funcall handler 'file-notify-rm-watch descriptor)
+
+ (funcall
+ (cond
+ ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
+ ((eq file-notify--library 'inotify) 'inotify-rm-watch)
+ ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
+ desc))
+ (file-notify-error nil)))
;; Modify `file-notify-descriptors'.
- (if (not file)
- (remhash desc file-notify-descriptors)
-
- (setq registered (gethash desc file-notify-descriptors))
- (setcdr registered
- (delete (assoc file (cdr registered)) (cdr registered)))
- (if (null (cdr registered))
- (remhash desc file-notify-descriptors)
- (puthash desc registered file-notify-descriptors))))))
+ (file-notify--rm-descriptor descriptor))))
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.