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 `gfilenotify', `inotify' and
30 (defconst file-notify--library
32 ((featurep 'gfilenotify
) 'gfilenotify
)
33 ((featurep 'inotify
) 'inotify
)
34 ((featurep 'w32notify
) 'w32notify
))
35 "Non-nil when Emacs has been compiled with file notification support.
36 The value is the name of the low-level file notification package
37 to be used for local file systems. Remote file notifications
38 could use another implementation.")
40 (defvar file-notify-descriptors
(make-hash-table :test
'equal
)
41 "Hash table for registered file notification descriptors.
42 A key in this hash table is the descriptor as returned from
43 `gfilenotify', `inotify', `w32notify' or a file name handler.
44 The value in the hash table is a list
46 (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...)
48 Several values for a given DIR happen only for `inotify', when
49 different files from the same directory are watched.")
51 ;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
53 (defun file-notify-handle-event (event)
54 "Handle file system monitoring event.
55 If EVENT is a filewatch event, call its callback. It has the format
57 (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
59 Otherwise, signal a `file-notify-error'."
61 (if (and (eq (car event
) 'file-notify
)
62 (>= (length event
) 3))
63 (funcall (nth 2 event
) (nth 1 event
))
64 (signal 'file-notify-error
65 (cons "Not a valid file-notify event" event
))))
67 ;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil.
68 (defvar file-notify--pending-event nil
69 "A pending file notification events for a future `renamed' action.
70 It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
72 (defun file-notify--event-file-name (event)
73 "Return file name of file notification event, or nil."
75 (or (and (stringp (nth 2 event
)) (nth 2 event
)) "")
76 (car (gethash (car event
) file-notify-descriptors
))))
78 ;; Only `gfilenotify' could return two file names.
79 (defun file-notify--event-file1-name (event)
80 "Return second file name of file notification event, or nil.
81 This is available in case a file has been moved."
82 (and (stringp (nth 3 event
))
84 (nth 3 event
) (car (gethash (car event
) file-notify-descriptors
)))))
86 ;; Cookies are offered by `inotify' only.
87 (defun file-notify--event-cookie (event)
88 "Return cookie of file notification event, or nil.
89 This is available in case a file has been moved."
92 ;; `inotify' returns the same descriptor when the file (directory)
93 ;; uses the same inode. We want to distinguish, and apply a virtual
94 ;; descriptor which make the difference.
95 (defun file-notify--descriptor (descriptor)
96 "Return the descriptor to be used in `file-notify-*-watch'.
97 For `gfilenotify' and `w32notify' it is the same descriptor as
98 used in the low-level file notification package."
99 (if (and (natnump descriptor
) (eq file-notify--library
'inotify
))
101 (car (cadr (gethash descriptor file-notify-descriptors
))))
104 ;; The callback function used to map between specific flags of the
105 ;; respective file notifications, and the ones we return.
106 (defun file-notify-callback (event)
107 "Handle an EVENT returned from file notification.
108 EVENT is the cadr of the event in `file-notify-handle-event'
109 \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
110 (let* ((desc (car event
))
111 (registered (gethash desc file-notify-descriptors
))
112 (actions (nth 1 event
))
113 (file (file-notify--event-file-name event
))
114 file1 callback pending-event
)
116 ;; Make actions a list.
117 (unless (consp actions
) (setq actions
(cons actions nil
)))
119 ;; Loop over registered entries. In fact, more than one entry
120 ;; happens only for `inotify'.
121 (dolist (entry (cdr registered
))
123 ;; Check, that event is meant for us.
124 (unless (setq callback
(cdr entry
))
127 ;; Loop over actions. In fact, more than one action happens only
129 (dolist (action actions
)
131 ;; Send pending event, if it doesn't match.
132 (when (and file-notify--pending-event
133 ;; The cookie doesn't match.
134 (not (eq (file-notify--event-cookie
135 (car file-notify--pending-event
))
136 (file-notify--event-cookie event
)))
139 (and (eq (nth 1 (car file-notify--pending-event
))
141 (not (eq action
'moved-to
)))
143 (and (eq (nth 1 (car file-notify--pending-event
))
145 (not (eq action
'renamed-to
)))))
146 (setq pending-event file-notify--pending-event
147 file-notify--pending-event nil
)
148 (setcar (cdar pending-event
) 'deleted
))
150 ;; Map action. We ignore all events which cannot be mapped.
154 ((memq action
'(attribute-changed changed created deleted
))
157 (setq file1
(file-notify--event-file1-name event
))
160 ;; inotify, w32notify.
161 ((eq action
'attrib
) 'attribute-changed
)
162 ((memq action
'(create added
)) 'created
)
163 ((memq action
'(modify modified
)) 'changed
)
164 ((memq action
'(delete delete-self move-self removed
)) 'deleted
)
165 ;; Make the event pending.
166 ((memq action
'(moved-from renamed-from
))
167 (setq file-notify--pending-event
168 `((,desc
,action
,file
,(file-notify--event-cookie event
))
171 ;; Look for pending event.
172 ((memq action
'(moved-to renamed-to
))
173 (if (null file-notify--pending-event
)
176 file
(file-notify--event-file-name
177 (car file-notify--pending-event
)))
178 ;; If the source is handled by another watch, we
179 ;; must fire the rename event there as well.
180 (when (not (equal (file-notify--descriptor desc
)
181 (file-notify--descriptor
182 (caar file-notify--pending-event
))))
184 `((,(caar file-notify--pending-event
)
185 renamed
,file
,file1
)
186 ,(cadr file-notify--pending-event
))))
187 (setq file-notify--pending-event nil
)
190 ;; Apply pending callback.
193 (car pending-event
) (file-notify--descriptor (caar pending-event
)))
194 (funcall (cadr pending-event
) (car pending-event
))
195 (setq pending-event nil
))
200 ;; If there is no relative file name for that watch,
201 ;; we watch the whole directory.
205 (nth 0 entry
) (file-name-nondirectory file
))
209 (nth 0 entry
) (file-name-nondirectory file1
)))))
213 `(,(file-notify--descriptor desc
) ,action
,file
,file1
))
216 `(,(file-notify--descriptor desc
) ,action
,file
))))))))
218 ;; `gfilenotify' and `w32notify' return a unique descriptor for every
219 ;; `file-notify-add-watch', while `inotify' returns a unique
220 ;; descriptor per inode only.
221 (defun file-notify-add-watch (file flags callback
)
222 "Add a watch for filesystem events pertaining to FILE.
223 This arranges for filesystem events pertaining to FILE to be reported
224 to Emacs. Use `file-notify-rm-watch' to cancel the watch.
226 The returned value is a descriptor for the added watch. If the
227 file cannot be watched for some reason, this function signals a
228 `file-notify-error' error.
230 FLAGS is a list of conditions to set what will be watched for. It can
231 include the following symbols:
233 `change' -- watch for file changes
234 `attribute-change' -- watch for file attributes changes, like
235 permissions or modification time
237 If FILE is a directory, `change' watches for file creation or
238 deletion in that directory. This does not work recursively.
240 When any event happens, Emacs will call the CALLBACK function passing
241 it a single argument EVENT, which is of the form
243 (DESCRIPTOR ACTION FILE [FILE1])
245 DESCRIPTOR is the same object as the one returned by this function.
246 ACTION is the description of the event. It could be any one of the
249 `created' -- FILE was created
250 `deleted' -- FILE was deleted
251 `changed' -- FILE has changed
252 `renamed' -- FILE has been renamed to FILE1
253 `attribute-changed' -- a FILE attribute was changed
255 FILE is the name of the file whose event is being reported."
257 (unless (stringp file
)
258 (signal 'wrong-type-argument
(list file
)))
259 (setq file
(expand-file-name file
))
260 (unless (and (consp flags
)
261 (null (delq 'change
(delq 'attribute-change
(copy-tree flags
)))))
262 (signal 'wrong-type-argument
(list flags
)))
263 (unless (functionp callback
)
264 (signal 'wrong-type-argument
(list callback
)))
266 (let* ((handler (find-file-name-handler file
'file-notify-add-watch
))
267 (dir (directory-file-name
268 (if (file-directory-p file
)
270 (file-name-directory file
))))
271 desc func l-flags registered
)
274 ;; A file name handler could exist even if there is no local
275 ;; file notification support.
277 handler
'file-notify-add-watch dir flags callback
))
279 ;; Check, whether Emacs has been compiled with file
280 ;; notification support.
281 (unless file-notify--library
282 (signal 'file-notify-error
283 '("No file notification package available")))
285 ;; Determine low-level function to be called.
288 ((eq file-notify--library
'gfilenotify
) 'gfile-add-watch
)
289 ((eq file-notify--library
'inotify
) 'inotify-add-watch
)
290 ((eq file-notify--library
'w32notify
) 'w32notify-add-watch
)))
292 ;; Determine respective flags.
293 (if (eq file-notify--library
'gfilenotify
)
294 (setq l-flags
'(watch-mounts send-moved
))
295 (when (memq 'change flags
)
299 ((eq file-notify--library
'inotify
) '(create modify move delete
))
300 ((eq file-notify--library
'w32notify
)
301 '(file-name directory-name size last-write-time
)))))
302 (when (memq 'attribute-change flags
)
304 ((eq file-notify--library
'inotify
) 'attrib
)
305 ((eq file-notify--library
'w32notify
) 'attributes
))
308 ;; Call low-level function.
309 (setq desc
(funcall func dir l-flags
'file-notify-callback
)))
311 ;; Modify `file-notify-descriptors'.
312 (setq registered
(gethash desc file-notify-descriptors
))
316 (,(unless (file-directory-p file
) (file-name-nondirectory file
))
319 file-notify-descriptors
)
321 ;; Return descriptor.
322 (file-notify--descriptor desc
)))
324 (defun file-notify-rm-watch (descriptor)
325 "Remove an existing watch specified by its DESCRIPTOR.
326 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
327 (let* ((desc (if (consp descriptor
) (car descriptor
) descriptor
))
328 (file (if (consp descriptor
) (cdr descriptor
)))
329 (dir (car (gethash desc file-notify-descriptors
)))
333 (setq handler
(find-file-name-handler dir
'file-notify-rm-watch
))
335 ;; Modify `file-notify-descriptors'.
337 (remhash desc file-notify-descriptors
)
339 (setq registered
(gethash desc file-notify-descriptors
))
341 (delete (assoc file
(cdr registered
)) (cdr registered
)))
342 (if (null (cdr registered
))
343 (remhash desc file-notify-descriptors
)
344 (puthash desc registered file-notify-descriptors
)))
346 ;; Call low-level function.
347 (when (null (cdr registered
))
350 ;; A file name handler could exist even if there is no local
351 ;; file notification support.
352 (funcall handler
'file-notify-rm-watch desc
)
356 ((eq file-notify--library
'gfilenotify
) 'gfile-rm-watch
)
357 ((eq file-notify--library
'inotify
) 'inotify-rm-watch
)
358 ((eq file-notify--library
'w32notify
) 'w32notify-rm-watch
))
360 (file-notify-error nil
))))))
362 (defun file-notify-valid-p (descriptor)
363 "Check a watch specified by its DESCRIPTOR.
364 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
365 (let* ((desc (if (consp descriptor
) (car descriptor
) descriptor
))
366 (file (if (consp descriptor
) (cdr descriptor
)))
367 (registered (gethash desc file-notify-descriptors
))
368 (dir (car registered
))
372 (setq handler
(find-file-name-handler dir
'file-notify-valid-p
))
374 (and (or ;; It is a directory.
376 ;; The file is registered.
377 (assoc file
(cdr registered
)))
379 ;; A file name handler could exist even if there is no
380 ;; local file notification support.
381 (funcall handler
'file-notify-valid-p descriptor
)
384 ((eq file-notify--library
'gfilenotify
) 'gfile-valid-p
)
385 ((eq file-notify--library
'inotify
) 'inotify-valid-p
)
386 ((eq file-notify--library
'w32notify
) 'w32notify-valid-p
))
391 (provide 'filenotify
)
393 ;;; filenotify.el ends here