X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/54e22f958b2e277830a01a5a1b0fe51ce1b6f405..0ea47a6159f351f32b7dbc68debe99eb02f2dd8d:/lisp/filenotify.el diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 2302942776..61b6d240e6 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -1,6 +1,6 @@ ;;; 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 @@ -27,6 +27,8 @@ ;;; Code: +(require 'cl-lib) + (defconst file-notify--library (cond ((featurep 'inotify) 'inotify) @@ -49,24 +51,20 @@ handler. The value in the hash table is a list 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) @@ -100,6 +98,15 @@ Otherwise, signal a `file-notify-error'." "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 @@ -190,8 +197,10 @@ EVENT is the cadr of the event in `file-notify-handle-event' '(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) @@ -235,20 +244,6 @@ EVENT is the cadr of the event in `file-notify-handle-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 @@ -258,22 +253,36 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; 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 @@ -338,7 +347,12 @@ FILE is the name of the file whose event is being reported." ;; 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. @@ -364,7 +378,7 @@ FILE is the name of the file whose event is being reported." ((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) @@ -375,18 +389,20 @@ FILE is the name of the file whose event is being reported." 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.