X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ef33bc7fcf7b2e9fc41706ebce3bfbc814b0e832..1dd4f26ab6c1f14628d9fcf03b0cca7e54d52302:/lisp/filenotify.el diff --git a/lisp/filenotify.el b/lisp/filenotify.el index ebf4dd277c..faa801ee6e 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -22,15 +22,16 @@ ;;; Commentary ;; This package is an abstraction layer from the different low-level -;; file notification packages `gfilenotify', `inotify' and +;; file notification packages `inotify', `kqueue', `gfilenotify' and ;; `w32notify'. ;;; Code: (defconst file-notify--library (cond - ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'inotify) 'inotify) + ((featurep 'kqueue) 'kqueue) + ((featurep 'gfilenotify) 'gfilenotify) ((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 @@ -40,25 +41,24 @@ 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 a list +`inotify', `kqueue', `gfilenotify', `w32notify' or a file name +handler. The value in the hash table is a list (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...) 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)) (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) @@ -76,7 +76,8 @@ WHAT is a file or directory name to be removed, needed just for `inotify'." (remhash desc file-notify-descriptors) (puthash desc registered file-notify-descriptors)))))) -;; This function is used by `gfilenotify', `inotify' and `w32notify' events. +;; This function is used by `inotify', `kqueue', `gfilenotify' and +;; `w32notify' events. ;;;###autoload (defun file-notify-handle-event (event) "Handle file system monitoring event. @@ -159,7 +160,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq actions nil)) ;; Loop over actions. In fact, more than one action happens only - ;; for `inotify'. + ;; for `inotify' and `kqueue'. (dolist (action actions) ;; Send pending event, if it doesn't match. @@ -184,19 +185,17 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Map action. We ignore all events which cannot be mapped. (setq action (cond - ;; gfilenotify. - ((memq action '(attribute-changed changed created deleted)) + ((memq action + '(attribute-changed changed created deleted renamed)) action) - ((eq action 'moved) + ((memq action '(moved rename)) (setq file1 (file-notify--event-file1-name event)) 'renamed) - - ;; inotify, w32notify. ((eq action 'ignored) (setq stopped t actions nil)) - ((eq action 'attrib) 'attribute-changed) + ((memq action '(attrib link)) 'attribute-changed) ((memq action '(create added)) 'created) - ((memq action '(modify modified)) 'changed) + ((memq action '(modify modified write)) 'changed) ((memq action '(delete delete-self move-self removed)) 'deleted) ;; Make the event pending. ((memq action '(moved-from renamed-from)) @@ -236,7 +235,6 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq pending-event nil)) ;; Check for stopped. - ;;(message "file-notify-callback %S %S" file registered) (setq stopped (or @@ -244,10 +242,13 @@ EVENT is the cadr of the event in `file-notify-handle-event' (and (memq action '(deleted renamed)) (= (length (cdr registered)) 1) - (string-equal - (file-name-nondirectory file) - (or (file-name-nondirectory (car registered)) - (car (cadr registered))))))) + (or + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory (car registered))) + (string-equal + (file-name-nondirectory file) + (car (cadr registered))))))) ;; Apply callback. (when (and action @@ -258,10 +259,17 @@ 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 file) action file file1 registered) (if file1 (funcall callback @@ -272,11 +280,10 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Modify `file-notify-descriptors'. (when stopped - (file-notify--rm-descriptor - (file-notify--descriptor desc file) file))))) + (file-notify-rm-watch (file-notify--descriptor desc file)))))) -;; `gfilenotify' and `w32notify' return a unique descriptor for every -;; `file-notify-add-watch', while `inotify' returns a unique +;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor +;; for every `file-notify-add-watch', while `inotify' returns a unique ;; descriptor per inode only. (defun file-notify-add-watch (file flags callback) "Add a watch for filesystem events pertaining to FILE. @@ -329,7 +336,7 @@ FILE is the name of the file whose event is being reported." (if (file-directory-p file) file (file-name-directory file)))) - desc func l-flags registered) + desc func l-flags registered entry) (unless (file-directory-p dir) (signal 'file-notify-error `("Directory does not exist" ,dir))) @@ -338,7 +345,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. @@ -349,8 +361,9 @@ FILE is the name of the file whose event is being reported." ;; Determine low-level function to be called. (setq func (cond - ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) ((eq file-notify--library 'inotify) 'inotify-add-watch) + ((eq file-notify--library 'kqueue) 'kqueue-add-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) ;; Determine respective flags. @@ -362,30 +375,32 @@ FILE is the name of the file whose event is being reported." (cond ((eq file-notify--library 'inotify) '(create delete delete-self modify move-self move)) + ((eq file-notify--library 'kqueue) + '(create delete write extend rename)) ((eq file-notify--library 'w32notify) '(file-name directory-name size last-write-time))))) (when (memq 'attribute-change flags) (push (cond ((eq file-notify--library 'inotify) 'attrib) + ((eq file-notify--library 'kqueue) 'attrib) ((eq file-notify--library 'w32notify) 'attributes)) 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 registered (gethash desc file-notify-descriptors)) - (puthash - desc - `(,dir - (,(unless (file-directory-p file) (file-name-nondirectory file)) - . ,callback) - . ,(cdr registered)) - file-notify-descriptors) + (setq file (unless (file-directory-p file) (file-name-nondirectory 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. - (file-notify--descriptor - desc (unless (file-directory-p file) (file-name-nondirectory file))))) + (file-notify--descriptor desc file))) (defun file-notify-rm-watch (descriptor) "Remove an existing watch specified by its DESCRIPTOR. @@ -410,8 +425,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall (cond - ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) ((eq file-notify--library 'inotify) 'inotify-rm-watch) + ((eq file-notify--library 'kqueue) 'kqueue-rm-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) desc)) (file-notify-error nil))) @@ -441,8 +457,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall handler 'file-notify-valid-p descriptor) (funcall (cond - ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'inotify) 'inotify-valid-p) + ((eq file-notify--library 'kqueue) 'kqueue-valid-p) + ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'w32notify) 'w32notify-valid-p)) desc)) t))))