1 ;;; filenotify.el --- watch files for changes on disk -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; This package is an abstraction layer from the different low-level
25 ;; file notification packages `inotify', `kqueue', `gfilenotify' and
30 (defconst file-notify--library
32 ((featurep 'inotify) 'inotify)
33 ((featurep 'kqueue) 'kqueue)
34 ((featurep 'gfilenotify) 'gfilenotify)
35 ((featurep 'w32notify) 'w32notify))
36 "Non-nil when Emacs has been compiled with file notification support.
37 The value is the name of the low-level file notification package
38 to be used for local file systems. Remote file notifications
39 could use another implementation.")
41 (defvar file-notify-descriptors (make-hash-table :test 'equal)
42 "Hash table for registered file notification descriptors.
43 A key in this hash table is the descriptor as returned from
44 `inotify', `kqueue', `gfilenotify', `w32notify' or a file name
45 handler. The value in the hash table is a list
47 (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...)
49 Several values for a given DIR happen only for `inotify', when
50 different files from the same directory are watched.")
52 (defun file-notify--rm-descriptor (descriptor &optional what)
53 "Remove DESCRIPTOR from `file-notify-descriptors'.
54 DESCRIPTOR should be an object returned by `file-notify-add-watch'.
55 If it is registered in `file-notify-descriptors', a stopped event is sent.
56 WHAT is a file or directory name to be removed, needed just for `inotify'."
57 (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
58 (file (if (consp descriptor) (cdr descriptor)))
59 (registered (gethash desc file-notify-descriptors))
60 (dir (car registered)))
62 (when (and (consp registered) (or (null what) (string-equal dir what)))
63 ;; Send `stopped' event.
64 (dolist (entry (cdr registered))
67 ,(or (and (stringp (car entry))
68 (expand-file-name (car entry) dir))
71 ;; Modify `file-notify-descriptors'.
73 (remhash desc file-notify-descriptors)
75 (delete (assoc file (cdr registered)) (cdr registered)))
76 (if (null (cdr registered))
77 (remhash desc file-notify-descriptors)
78 (puthash desc registered file-notify-descriptors))))))
80 ;; This function is used by `inotify', `kqueue', `gfilenotify' and
81 ;; `w32notify' events.
83 (defun file-notify-handle-event (event)
84 "Handle file system monitoring event.
85 If EVENT is a filewatch event, call its callback. It has the format
87 (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
89 Otherwise, signal a `file-notify-error'."
91 ;;(message "file-notify-handle-event %S" event)
92 (if (and (eq (car event) 'file-notify)
93 (>= (length event) 3))
94 (funcall (nth 2 event) (nth 1 event))
95 (signal 'file-notify-error
96 (cons "Not a valid file-notify event" event))))
98 ;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil.
99 (defvar file-notify--pending-event nil
100 "A pending file notification events for a future `renamed' action.
101 It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
103 (defun file-notify--event-file-name (event)
104 "Return file name of file notification event, or nil."
107 (or (and (stringp (nth 2 event)) (nth 2 event)) "")
108 (car (gethash (car event) file-notify-descriptors)))))
110 ;; Only `gfilenotify' could return two file names.
111 (defun file-notify--event-file1-name (event)
112 "Return second file name of file notification event, or nil.
113 This is available in case a file has been moved."
114 (and (stringp (nth 3 event))
117 (nth 3 event) (car (gethash (car event) file-notify-descriptors))))))
119 ;; Cookies are offered by `inotify' only.
120 (defun file-notify--event-cookie (event)
121 "Return cookie of file notification event, or nil.
122 This is available in case a file has been moved."
125 ;; `inotify' returns the same descriptor when the file (directory)
126 ;; uses the same inode. We want to distinguish, and apply a virtual
127 ;; descriptor which make the difference.
128 (defun file-notify--descriptor (desc file)
129 "Return the descriptor to be used in `file-notify-*-watch'.
130 For `gfilenotify' and `w32notify' it is the same descriptor as
131 used in the low-level file notification package."
132 (if (and (natnump desc) (eq file-notify--library 'inotify))
136 (file-name-nondirectory file)
137 (gethash desc file-notify-descriptors)))))
140 ;; The callback function used to map between specific flags of the
141 ;; respective file notifications, and the ones we return.
142 (defun file-notify-callback (event)
143 "Handle an EVENT returned from file notification.
144 EVENT is the cadr of the event in `file-notify-handle-event'
145 \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
146 (let* ((desc (car event))
147 (registered (gethash desc file-notify-descriptors))
148 (actions (nth 1 event))
149 (file (file-notify--event-file-name event))
150 file1 callback pending-event stopped)
152 ;; Make actions a list.
153 (unless (consp actions) (setq actions (cons actions nil)))
155 ;; Loop over registered entries. In fact, more than one entry
156 ;; happens only for `inotify'.
157 (dolist (entry (cdr registered))
159 ;; Check, that event is meant for us.
160 (unless (setq callback (cdr entry))
163 ;; Loop over actions. In fact, more than one action happens only
164 ;; for `inotify' and `kqueue'.
165 (dolist (action actions)
167 ;; Send pending event, if it doesn't match.
168 (when (and file-notify--pending-event
169 ;; The cookie doesn't match.
170 (not (eq (file-notify--event-cookie
171 (car file-notify--pending-event))
172 (file-notify--event-cookie event)))
175 (and (eq (nth 1 (car file-notify--pending-event))
177 (not (eq action 'moved-to)))
179 (and (eq (nth 1 (car file-notify--pending-event))
181 (not (eq action 'renamed-to)))))
182 (setq pending-event file-notify--pending-event
183 file-notify--pending-event nil)
184 (setcar (cdar pending-event) 'deleted))
186 ;; Map action. We ignore all events which cannot be mapped.
190 '(attribute-changed changed created deleted renamed))
193 (setq file1 (file-notify--event-file1-name event))
195 ((eq action 'ignored)
196 (setq stopped t actions nil))
197 ((memq action '(attrib link)) 'attribute-changed)
198 ((memq action '(create added)) 'created)
199 ((memq action '(modify modified write)) 'changed)
200 ((memq action '(delete delete-self move-self removed)) 'deleted)
201 ;; Make the event pending.
202 ((memq action '(moved-from renamed-from))
203 (setq file-notify--pending-event
204 `((,desc ,action ,file ,(file-notify--event-cookie event))
207 ;; Look for pending event.
208 ((memq action '(moved-to renamed-to))
209 (if (null file-notify--pending-event)
212 file (file-notify--event-file-name
213 (car file-notify--pending-event)))
214 ;; If the source is handled by another watch, we
215 ;; must fire the rename event there as well.
216 (when (not (equal (file-notify--descriptor desc file1)
217 (file-notify--descriptor
218 (caar file-notify--pending-event)
219 (file-notify--event-file-name
220 file-notify--pending-event))))
222 `((,(caar file-notify--pending-event)
223 renamed ,file ,file1)
224 ,(cadr file-notify--pending-event))))
225 (setq file-notify--pending-event nil)
228 ;; Apply pending callback.
232 (file-notify--descriptor
234 (file-notify--event-file-name file-notify--pending-event)))
235 (funcall (cadr pending-event) (car pending-event))
236 (setq pending-event nil))
238 ;; Check for stopped.
239 ;;(message "file-notify-callback %S %S" file registered)
245 (memq action '(deleted renamed))
246 (= (length (cdr registered)) 1)
248 (file-name-nondirectory file)
249 (or (file-name-nondirectory (car registered))
250 (car (cadr registered)))))))
255 ;; If there is no relative file name for that watch,
256 ;; we watch the whole directory.
260 (nth 0 entry) (file-name-nondirectory file))
264 (nth 0 entry) (file-name-nondirectory file1)))))
268 `(,(file-notify--descriptor desc file) ,action ,file ,file1))
271 `(,(file-notify--descriptor desc file) ,action ,file)))))
273 ;; Modify `file-notify-descriptors'.
275 (file-notify--rm-descriptor
276 (file-notify--descriptor desc file) file)))))
278 ;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
279 ;; for every `file-notify-add-watch', while `inotify' returns a unique
280 ;; descriptor per inode only.
281 (defun file-notify-add-watch (file flags callback)
282 "Add a watch for filesystem events pertaining to FILE.
283 This arranges for filesystem events pertaining to FILE to be reported
284 to Emacs. Use `file-notify-rm-watch' to cancel the watch.
286 The returned value is a descriptor for the added watch. If the
287 file cannot be watched for some reason, this function signals a
288 `file-notify-error' error.
290 FLAGS is a list of conditions to set what will be watched for. It can
291 include the following symbols:
293 `change' -- watch for file changes
294 `attribute-change' -- watch for file attributes changes, like
295 permissions or modification time
297 If FILE is a directory, `change' watches for file creation or
298 deletion in that directory. This does not work recursively.
300 When any event happens, Emacs will call the CALLBACK function passing
301 it a single argument EVENT, which is of the form
303 (DESCRIPTOR ACTION FILE [FILE1])
305 DESCRIPTOR is the same object as the one returned by this function.
306 ACTION is the description of the event. It could be any one of the
309 `created' -- FILE was created
310 `deleted' -- FILE was deleted
311 `changed' -- FILE has changed
312 `renamed' -- FILE has been renamed to FILE1
313 `attribute-changed' -- a FILE attribute was changed
314 `stopped' -- watching FILE has been stopped
316 FILE is the name of the file whose event is being reported."
318 (unless (stringp file)
319 (signal 'wrong-type-argument `(,file)))
320 (setq file (expand-file-name file))
321 (unless (and (consp flags)
322 (null (delq 'change (delq 'attribute-change (copy-tree flags)))))
323 (signal 'wrong-type-argument `(,flags)))
324 (unless (functionp callback)
325 (signal 'wrong-type-argument `(,callback)))
327 (let* ((handler (find-file-name-handler file 'file-notify-add-watch))
328 (dir (directory-file-name
329 (if (file-directory-p file)
331 (file-name-directory file))))
332 desc func l-flags registered)
334 (unless (file-directory-p dir)
335 (signal 'file-notify-error `("Directory does not exist" ,dir)))
338 ;; A file name handler could exist even if there is no local
339 ;; file notification support.
341 handler 'file-notify-add-watch dir flags callback))
343 ;; Check, whether Emacs has been compiled with file notification
345 (unless file-notify--library
346 (signal 'file-notify-error
347 '("No file notification package available")))
349 ;; Determine low-level function to be called.
352 ((eq file-notify--library 'inotify) 'inotify-add-watch)
353 ((eq file-notify--library 'kqueue) 'kqueue-add-watch)
354 ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
355 ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
357 ;; Determine respective flags.
358 (if (eq file-notify--library 'gfilenotify)
359 (setq l-flags (append '(watch-mounts send-moved) flags))
360 (when (memq 'change flags)
364 ((eq file-notify--library 'inotify)
365 '(create delete delete-self modify move-self move))
366 ((eq file-notify--library 'kqueue)
367 '(delete write extend rename))
368 ((eq file-notify--library 'w32notify)
369 '(file-name directory-name size last-write-time)))))
370 (when (memq 'attribute-change flags)
372 ((eq file-notify--library 'inotify) 'attrib)
373 ((eq file-notify--library 'kqueue) 'attrib)
374 ((eq file-notify--library 'w32notify) 'attributes))
377 ;; Call low-level function.
378 (setq desc (funcall func dir l-flags 'file-notify-callback)))
380 ;; Modify `file-notify-descriptors'.
381 (setq registered (gethash desc file-notify-descriptors))
385 (,(unless (file-directory-p file) (file-name-nondirectory file))
388 file-notify-descriptors)
390 ;; Return descriptor.
391 (file-notify--descriptor
392 desc (unless (file-directory-p file) (file-name-nondirectory file)))))
394 (defun file-notify-rm-watch (descriptor)
395 "Remove an existing watch specified by its DESCRIPTOR.
396 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
397 (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
398 (file (if (consp descriptor) (cdr descriptor)))
399 (registered (gethash desc file-notify-descriptors))
400 (dir (car registered))
401 (handler (and (stringp dir)
402 (find-file-name-handler dir 'file-notify-rm-watch))))
405 ;; Call low-level function.
407 (and (= (length (cdr registered)) 1)
408 (assoc file (cdr registered))))
411 ;; A file name handler could exist even if there is no local
412 ;; file notification support.
413 (funcall handler 'file-notify-rm-watch descriptor)
417 ((eq file-notify--library 'inotify) 'inotify-rm-watch)
418 ((eq file-notify--library 'kqueue) 'kqueue-rm-watch)
419 ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
420 ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
422 (file-notify-error nil)))
424 ;; Modify `file-notify-descriptors'.
425 (file-notify--rm-descriptor descriptor))))
427 (defun file-notify-valid-p (descriptor)
428 "Check a watch specified by its DESCRIPTOR.
429 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
430 (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
431 (file (if (consp descriptor) (cdr descriptor)))
432 (registered (gethash desc file-notify-descriptors))
433 (dir (car registered))
437 (setq handler (find-file-name-handler dir 'file-notify-valid-p))
439 (and (or ;; It is a directory.
441 ;; The file is registered.
442 (assoc file (cdr registered)))
444 ;; A file name handler could exist even if there is no
445 ;; local file notification support.
446 (funcall handler 'file-notify-valid-p descriptor)
449 ((eq file-notify--library 'inotify) 'inotify-valid-p)
450 ((eq file-notify--library 'kqueue) 'kqueue-valid-p)
451 ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
452 ((eq file-notify--library 'w32notify) 'w32notify-valid-p))
457 (provide 'filenotify)
459 ;;; filenotify.el ends here