Merge from origin/emacs-24
[emacs.git] / lisp / filenotify.el
blobc94f631dde8b1550fa631a7641280a96215cdd64
1 ;;; filenotify.el --- watch files for changes on disk
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/>.
22 ;;; Commentary
24 ;; This package is an abstraction layer from the different low-level
25 ;; file notification packages `gfilenotify', `inotify' and
26 ;; `w32notify'.
28 ;;; Code:
30 (defconst file-notify--library
31 (cond
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.
52 ;;;###autoload
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 COOKIE) CALLBACK)
59 Otherwise, signal a `file-notify-error'."
60 (interactive "e")
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 (defvar file-notify--pending-events nil
68 "List of pending file notification events for a future `renamed' action.
69 The entries are a list (DESCRIPTOR ACTION FILE COOKIE). ACTION
70 is either `moved-from' or `renamed-from'.")
72 (defun file-notify--event-file-name (event)
73 "Return file name of file notification event, or nil."
74 (expand-file-name
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))
83 (expand-file-name
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."
90 (nth 3 event))
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 file)
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))
100 (cons descriptor file)
101 descriptor))
103 ;; The callback function used to map between specific flags of the
104 ;; respective file notifications, and the ones we return.
105 (defun file-notify-callback (event)
106 "Handle an EVENT returned from file notification.
107 EVENT is the cdr of the event in `file-notify-handle-event'
108 \(DESCRIPTOR ACTIONS FILE COOKIE)."
109 (let* ((desc (car event))
110 (registered (gethash desc file-notify-descriptors))
111 (pending-event (assoc desc file-notify--pending-events))
112 (actions (nth 1 event))
113 (file (file-notify--event-file-name event))
114 file1 callback)
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))
125 (setq actions nil))
127 ;; Loop over actions. In fact, more than one action happens only
128 ;; for `inotify'.
129 (dolist (action actions)
131 ;; Send pending event, if it doesn't match.
132 (when (and pending-event
133 ;; The cookie doesn't match.
134 (not (eq (file-notify--event-cookie pending-event)
135 (file-notify--event-cookie event)))
137 ;; inotify.
138 (and (eq (nth 1 pending-event) 'moved-from)
139 (not (eq action 'moved-to)))
140 ;; w32notify.
141 (and (eq (nth 1 pending-event) 'renamed-from)
142 (not (eq action 'renamed-to)))))
143 (funcall callback
144 (list desc 'deleted
145 (file-notify--event-file-name pending-event)))
146 (setq file-notify--pending-events
147 (delete pending-event file-notify--pending-events)))
149 ;; Map action. We ignore all events which cannot be mapped.
150 (setq action
151 (cond
152 ;; gfilenotify.
153 ((memq action '(attribute-changed changed created deleted))
154 action)
155 ((eq action 'moved)
156 (setq file1 (file-notify--event-file1-name event))
157 'renamed)
159 ;; inotify.
160 ((eq action 'attrib) 'attribute-changed)
161 ((eq action 'create) 'created)
162 ((eq action 'modify) 'changed)
163 ((memq action '(delete 'delete-self move-self)) 'deleted)
164 ;; Make the event pending.
165 ((eq action 'moved-from)
166 (add-to-list 'file-notify--pending-events
167 (list desc action file
168 (file-notify--event-cookie event)))
169 nil)
170 ;; Look for pending event.
171 ((eq action 'moved-to)
172 (if (null pending-event)
173 'created
174 (setq file1 file
175 file (file-notify--event-file-name pending-event)
176 file-notify--pending-events
177 (delete pending-event file-notify--pending-events))
178 'renamed))
180 ;; w32notify.
181 ((eq action 'added) 'created)
182 ((eq action 'modified) 'changed)
183 ((eq action 'removed) 'deleted)
184 ;; Make the event pending.
185 ((eq action 'renamed-from)
186 (add-to-list 'file-notify--pending-events
187 (list desc action file
188 (file-notify--event-cookie event)))
189 nil)
190 ;; Look for pending event.
191 ((eq action 'renamed-to)
192 (if (null pending-event)
193 'created
194 (setq file1 file
195 file (file-notify--event-file-name pending-event)
196 file-notify--pending-events
197 (delete pending-event file-notify--pending-events))
198 'renamed))))
200 ;; Apply callback.
201 (when (and action
203 ;; If there is no relative file name for that watch,
204 ;; we watch the whole directory.
205 (null (nth 0 entry))
206 ;; File matches.
207 (string-equal
208 (nth 0 entry) (file-name-nondirectory file))
209 ;; File1 matches.
210 (and (stringp file1)
211 (string-equal
212 (nth 0 entry) (file-name-nondirectory file1)))))
213 (if file1
214 (funcall
215 callback
216 `(,(file-notify--descriptor desc (nth 0 entry))
217 ,action ,file ,file1))
218 (funcall
219 callback
220 `(,(file-notify--descriptor desc (nth 0 entry))
221 ,action ,file))))))))
223 ;; `gfilenotify' and `w32notify' return a unique descriptor for every
224 ;; `file-notify-add-watch', while `inotify' returns a unique
225 ;; descriptor per inode only.
226 (defun file-notify-add-watch (file flags callback)
227 "Add a watch for filesystem events pertaining to FILE.
228 This arranges for filesystem events pertaining to FILE to be reported
229 to Emacs. Use `file-notify-rm-watch' to cancel the watch.
231 The returned value is a descriptor for the added watch. If the
232 file cannot be watched for some reason, this function signals a
233 `file-notify-error' error.
235 FLAGS is a list of conditions to set what will be watched for. It can
236 include the following symbols:
238 `change' -- watch for file changes
239 `attribute-change' -- watch for file attributes changes, like
240 permissions or modification time
242 If FILE is a directory, `change' watches for file creation or
243 deletion in that directory. This does not work recursively.
245 When any event happens, Emacs will call the CALLBACK function passing
246 it a single argument EVENT, which is of the form
248 (DESCRIPTOR ACTION FILE [FILE1])
250 DESCRIPTOR is the same object as the one returned by this function.
251 ACTION is the description of the event. It could be any one of the
252 following:
254 `created' -- FILE was created
255 `deleted' -- FILE was deleted
256 `changed' -- FILE has changed
257 `renamed' -- FILE has been renamed to FILE1
258 `attribute-changed' -- a FILE attribute was changed
260 FILE is the name of the file whose event is being reported."
261 ;; Check arguments.
262 (unless (stringp file)
263 (signal 'wrong-type-argument (list file)))
264 (setq file (expand-file-name file))
265 (unless (and (consp flags)
266 (null (delq 'change (delq 'attribute-change (copy-tree flags)))))
267 (signal 'wrong-type-argument (list flags)))
268 (unless (functionp callback)
269 (signal 'wrong-type-argument (list callback)))
271 (let* ((handler (find-file-name-handler file 'file-notify-add-watch))
272 (dir (directory-file-name
273 (if (file-directory-p file)
274 file
275 (file-name-directory file))))
276 desc func l-flags registered)
278 (if handler
279 ;; A file name handler could exist even if there is no local
280 ;; file notification support.
281 (setq desc (funcall
282 handler 'file-notify-add-watch dir flags callback))
284 ;; Check, whether Emacs has been compiled with file
285 ;; notification support.
286 (unless file-notify--library
287 (signal 'file-notify-error
288 '("No file notification package available")))
290 ;; Determine low-level function to be called.
291 (setq func
292 (cond
293 ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
294 ((eq file-notify--library 'inotify) 'inotify-add-watch)
295 ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
297 ;; Determine respective flags.
298 (if (eq file-notify--library 'gfilenotify)
299 (setq l-flags '(watch-mounts send-moved))
300 (when (memq 'change flags)
301 (setq
302 l-flags
303 (cond
304 ((eq file-notify--library 'inotify) '(create modify move delete))
305 ((eq file-notify--library 'w32notify)
306 '(file-name directory-name size last-write-time)))))
307 (when (memq 'attribute-change flags)
308 (add-to-list
309 'l-flags
310 (cond
311 ((eq file-notify--library 'inotify) 'attrib)
312 ((eq file-notify--library 'w32notify) 'attributes)))))
314 ;; Call low-level function.
315 (setq desc (funcall func dir l-flags 'file-notify-callback)))
317 ;; Modify `file-notify-descriptors'.
318 (setq registered (gethash desc file-notify-descriptors))
319 (puthash
320 desc
321 `(,dir
322 (,(unless (file-directory-p file) (file-name-nondirectory file))
323 . ,callback)
324 . ,(cdr registered))
325 file-notify-descriptors)
327 ;; Return descriptor.
328 (file-notify--descriptor
329 desc (unless (file-directory-p file) (file-name-nondirectory file)))))
331 (defun file-notify-rm-watch (descriptor)
332 "Remove an existing watch specified by its DESCRIPTOR.
333 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
334 (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
335 (file (if (consp descriptor) (cdr descriptor)))
336 (dir (car (gethash desc file-notify-descriptors)))
337 handler registered)
339 (when (stringp dir)
340 (setq handler (find-file-name-handler dir 'file-notify-rm-watch))
342 ;; Modify `file-notify-descriptors'.
343 (if (not file)
344 (remhash desc file-notify-descriptors)
346 (setq registered (gethash desc file-notify-descriptors))
347 (setcdr registered
348 (delete (assoc file (cdr registered)) (cdr registered)))
349 (if (null (cdr registered))
350 (remhash desc file-notify-descriptors)
351 (puthash desc registered file-notify-descriptors)))
353 ;; Call low-level function.
354 (when (null (cdr registered))
355 (if handler
356 ;; A file name handler could exist even if there is no local
357 ;; file notification support.
358 (funcall handler 'file-notify-rm-watch desc)
360 (funcall
361 (cond
362 ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
363 ((eq file-notify--library 'inotify) 'inotify-rm-watch)
364 ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
365 desc))))))
367 ;; The end:
368 (provide 'filenotify)
370 ;;; filenotify.el ends here