;;; filenotify.el --- watch files for changes on disk -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;;; Code:
+(require 'cl-lib)
+
(defconst file-notify--library
(cond
((featurep 'inotify) 'inotify)
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)
+(defun file-notify--rm-descriptor (descriptor)
"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'."
+If it is registered in `file-notify-descriptors', a stopped event is sent."
(let* ((desc (if (consp descriptor) (car descriptor) descriptor))
- (file (if (consp descriptor) (cdr descriptor)))
(registered (gethash desc file-notify-descriptors))
+ (file (if (consp descriptor) (cdr descriptor) (cl-caadr registered)))
(dir (car registered)))
- (when (and (consp registered) (or (null what) (string-equal dir what)))
+ (when (consp registered)
;; Send `stopped' event.
- (dolist (entry (cdr registered))
- (funcall (cdr entry)
- `(,descriptor stopped
- ,(or (and (stringp (car entry))
- (expand-file-name (car entry) dir))
- dir))))
+ (funcall
+ (cdr (assoc file (cdr registered)))
+ `(,descriptor stopped ,(if file (expand-file-name file dir) dir)))
;; Modify `file-notify-descriptors'.
(if (not file)
"A pending file notification events for a future `renamed' action.
It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
+(defun file-notify--event-watched-file (event)
+ "Return file or directory being watched.
+Could be different from the directory watched by the backend library."
+ (let* ((desc (if (consp (car event)) (caar event) (car event)))
+ (registered (gethash desc file-notify-descriptors))
+ (file (if (consp (car event)) (cdar event) (cl-caadr registered)))
+ (dir (car registered)))
+ (if file (expand-file-name file dir) dir)))
+
(defun file-notify--event-file-name (event)
"Return file name of file notification event, or nil."
(directory-file-name
'(attribute-changed changed created deleted renamed))
action)
((memq action '(moved rename))
- (setq file1 (file-notify--event-file1-name event))
- 'renamed)
+ ;; The kqueue rename event does not return file1 in
+ ;; case a file monitor is established.
+ (if (setq file1 (file-notify--event-file1-name event))
+ 'renamed 'deleted))
((eq action 'ignored)
(setq stopped t actions nil))
((memq action '(attrib link)) 'attribute-changed)
(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
;; File matches.
(string-equal
(nth 0 entry) (file-name-nondirectory file))
+ ;; Directory matches.
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory (car registered)))
;; File1 matches.
(and (stringp file1)
(string-equal
(nth 0 entry) (file-name-nondirectory file1)))))
+ ;;(message
+ ;;"file-notify-callback %S %S %S %S %S"
+ ;;(file-notify--descriptor desc (car entry))
+ ;;action file file1 registered)
(if file1
(funcall
callback
- `(,(file-notify--descriptor desc file) ,action ,file ,file1))
+ `(,(file-notify--descriptor desc (car entry))
+ ,action ,file ,file1))
(funcall
callback
- `(,(file-notify--descriptor desc file) ,action ,file)))))
-
- ;; Modify `file-notify-descriptors'.
- (when stopped
- (file-notify--rm-descriptor
- (file-notify--descriptor desc file) file)))))
+ `(,(file-notify--descriptor desc (car entry)) ,action ,file))))
+
+ ;; Send `stopped' event.
+ (when (or stopped
+ (and (memq action '(deleted renamed))
+ ;; Not, when a file is backed up.
+ (not (and (stringp file1) (backup-file-name-p file1)))
+ ;; Watched file or directory is concerned.
+ (string-equal
+ file (file-notify--event-watched-file event))))
+ (file-notify-rm-watch (file-notify--descriptor desc (car entry))))))))
;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
;; for every `file-notify-add-watch', while `inotify' returns a unique
;; 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))
+ handler 'file-notify-add-watch
+ ;; kqueue does not report file changes in
+ ;; directory monitor. So we must watch the file
+ ;; itself.
+ (if (eq file-notify--library 'kqueue) file dir)
+ flags callback))
;; Check, whether Emacs has been compiled with file notification
;; support.
((eq file-notify--library 'inotify)
'(create delete delete-self modify move-self move))
((eq file-notify--library 'kqueue)
- '(delete write extend rename))
+ '(create delete write extend rename))
((eq file-notify--library 'w32notify)
'(file-name directory-name size last-write-time)))))
(when (memq 'attribute-change flags)
l-flags)))
;; Call low-level function.
- (setq desc (funcall func dir l-flags 'file-notify-callback)))
+ (setq desc (funcall
+ func (if (eq file-notify--library 'kqueue) file dir)
+ l-flags 'file-notify-callback)))
;; Modify `file-notify-descriptors'.
(setq file (unless (file-directory-p file) (file-name-nondirectory file))
- desc (file-notify--descriptor desc file)
+ desc (if (consp desc) (car desc) desc)
registered (gethash desc file-notify-descriptors)
entry `(,file . ,callback))
(unless (member entry (cdr registered))
(puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors))
;; Return descriptor.
- desc))
+ (file-notify--descriptor desc file)))
(defun file-notify-rm-watch (descriptor)
"Remove an existing watch specified by its DESCRIPTOR.