Commit | Line | Data |
---|---|---|
864c58ca MA |
1 | ;;; filenotify.el --- watch files for changes on disk |
2 | ||
3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
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. | |
13 | ||
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. | |
18 | ||
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/>. | |
21 | ||
22 | ;;; Commentary | |
23 | ||
24 | ;; This package is an abstraction layer from the different low-level | |
25 | ;; file notification packages `gfilenotify', `inotify' and | |
26 | ;; `w32notify'. | |
27 | ||
28 | ;;; Code: | |
29 | ||
e06ec67f | 30 | (defconst file-notify--library |
864c58ca MA |
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.") | |
39 | ||
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 the cons cell (DIR FILE CALLBACK).") | |
45 | ||
46 | ;; This function is used by `gfilenotify', `inotify' and `w32notify' events. | |
47 | ;;;###autoload | |
48 | (defun file-notify-handle-event (event) | |
49 | "Handle file system monitoring event. | |
50 | If EVENT is a filewatch event, call its callback. | |
51 | Otherwise, signal a `file-notify-error'." | |
52 | (interactive "e") | |
53 | (if (and (eq (car event) 'file-notify) | |
54 | (>= (length event) 3)) | |
55 | (funcall (nth 2 event) (nth 1 event)) | |
56 | (signal 'file-notify-error | |
57 | (cons "Not a valid file-notify event" event)))) | |
58 | ||
59 | (defvar file-notify--pending-events nil | |
60 | "List of pending file notification events for a future `renamed' action. | |
61 | The entries are a list (DESCRIPTOR ACTION FILE COOKIE). ACTION | |
62 | is either `moved-from' or `renamed-from'.") | |
63 | ||
64 | (defun file-notify--event-file-name (event) | |
65 | "Return file name of file notification event, or nil." | |
66 | (expand-file-name | |
67 | (or (and (stringp (nth 2 event)) (nth 2 event)) "") | |
68 | (car (gethash (car event) file-notify-descriptors)))) | |
69 | ||
70 | ;; Only `gfilenotify' could return two file names. | |
71 | (defun file-notify--event-file1-name (event) | |
72 | "Return second file name of file notification event, or nil. | |
73 | This is available in case a file has been moved." | |
74 | (and (stringp (nth 3 event)) | |
75 | (expand-file-name | |
76 | (nth 3 event) (car (gethash (car event) file-notify-descriptors))))) | |
77 | ||
78 | ;; Cookies are offered by `inotify' only. | |
79 | (defun file-notify--event-cookie (event) | |
80 | "Return cookie of file notification event, or nil. | |
81 | This is available in case a file has been moved." | |
82 | (nth 3 event)) | |
83 | ||
84 | ;; The callback function used to map between specific flags of the | |
85 | ;; respective file notifications, and the ones we return. | |
86 | (defun file-notify-callback (event) | |
87 | "Handle an EVENT returned from file notification. | |
88 | EVENT is the same one as in `file-notify-handle-event' except the | |
89 | car of that event, which is the symbol `file-notify'." | |
90 | (let* ((desc (car event)) | |
91 | (registered (gethash desc file-notify-descriptors)) | |
92 | (pending-event (assoc desc file-notify--pending-events)) | |
93 | (actions (nth 1 event)) | |
94 | (file (file-notify--event-file-name event)) | |
45fdb482 | 95 | file1 callback) |
864c58ca MA |
96 | |
97 | ;; Make actions a list. | |
98 | (unless (consp actions) (setq actions (cons actions nil))) | |
99 | ||
100 | ;; Check, that event is meant for us. | |
101 | (unless (setq callback (nth 2 registered)) | |
102 | (setq actions nil)) | |
103 | ||
104 | ;; Loop over actions. In fact, more than one action happens only | |
105 | ;; for `inotify'. | |
106 | (dolist (action actions) | |
107 | ||
108 | ;; Send pending event, if it doesn't match. | |
109 | (when (and pending-event | |
110 | ;; The cookie doesn't match. | |
111 | (not (eq (file-notify--event-cookie pending-event) | |
112 | (file-notify--event-cookie event))) | |
113 | (or | |
114 | ;; inotify. | |
115 | (and (eq (nth 1 pending-event) 'moved-from) | |
116 | (not (eq action 'moved-to))) | |
117 | ;; w32notify. | |
118 | (and (eq (nth 1 pending-event) 'renamed-from) | |
119 | (not (eq action 'renamed-to))))) | |
120 | (funcall callback | |
121 | (list desc 'deleted | |
122 | (file-notify--event-file-name pending-event))) | |
123 | (setq file-notify--pending-events | |
124 | (delete pending-event file-notify--pending-events))) | |
125 | ||
126 | ;; Map action. We ignore all events which cannot be mapped. | |
127 | (setq action | |
128 | (cond | |
129 | ;; gfilenotify. | |
130 | ((memq action '(attribute-changed changed created deleted)) action) | |
131 | ((eq action 'moved) | |
132 | (setq file1 (file-notify--event-file1-name event)) | |
133 | 'renamed) | |
134 | ||
135 | ;; inotify. | |
136 | ((eq action 'attrib) 'attribute-changed) | |
137 | ((eq action 'create) 'created) | |
138 | ((eq action 'modify) 'changed) | |
139 | ((memq action '(delete 'delete-self move-self)) 'deleted) | |
140 | ;; Make the event pending. | |
141 | ((eq action 'moved-from) | |
142 | (add-to-list 'file-notify--pending-events | |
143 | (list desc action file | |
144 | (file-notify--event-cookie event))) | |
145 | nil) | |
146 | ;; Look for pending event. | |
147 | ((eq action 'moved-to) | |
148 | (if (null pending-event) | |
149 | 'created | |
150 | (setq file1 file | |
151 | file (file-notify--event-file-name pending-event) | |
152 | file-notify--pending-events | |
153 | (delete pending-event file-notify--pending-events)) | |
154 | 'renamed)) | |
155 | ||
156 | ;; w32notify. | |
157 | ((eq action 'added) 'created) | |
158 | ((eq action 'modified) 'changed) | |
159 | ((eq action 'removed) 'deleted) | |
160 | ;; Make the event pending. | |
161 | ((eq 'renamed-from action) | |
162 | (add-to-list 'file-notify--pending-events | |
163 | (list desc action file | |
164 | (file-notify--event-cookie event))) | |
165 | nil) | |
166 | ;; Look for pending event. | |
167 | ((eq 'renamed-to action) | |
168 | (if (null pending-event) | |
169 | 'created | |
170 | (setq file1 file | |
171 | file (file-notify--event-file-name pending-event) | |
172 | file-notify--pending-events | |
173 | (delete pending-event file-notify--pending-events)) | |
174 | 'renamed)))) | |
175 | ||
176 | ;; Apply callback. | |
177 | (when (and action | |
178 | (or | |
179 | ;; If there is no relative file name for that watch, | |
180 | ;; we watch the whole directory. | |
181 | (null (nth 1 registered)) | |
182 | ;; File matches. | |
183 | (string-equal | |
184 | (nth 1 registered) (file-name-nondirectory file)) | |
185 | ;; File1 matches. | |
186 | (and (stringp file1) | |
187 | (string-equal | |
188 | (nth 1 registered) (file-name-nondirectory file1))))) | |
189 | (if file1 | |
190 | (funcall callback (list desc action file file1)) | |
191 | (funcall callback (list desc action file))))))) | |
192 | ||
193 | (defun file-notify-add-watch (file flags callback) | |
194 | "Add a watch for filesystem events pertaining to FILE. | |
195 | This arranges for filesystem events pertaining to FILE to be reported | |
196 | to Emacs. Use `file-notify-rm-watch' to cancel the watch. | |
197 | ||
198 | The returned value is a descriptor for the added watch. If the | |
199 | file cannot be watched for some reason, this function signals a | |
200 | `file-notify-error' error. | |
201 | ||
202 | FLAGS is a list of conditions to set what will be watched for. It can | |
203 | include the following symbols: | |
204 | ||
205 | `change' -- watch for file changes | |
206 | `attribute-change' -- watch for file attributes changes, like | |
207 | permissions or modification time | |
208 | ||
209 | If FILE is a directory, 'change' watches for file creation or | |
a6e3a5d5 | 210 | deletion in that directory. This does not work recursively. |
864c58ca MA |
211 | |
212 | When any event happens, Emacs will call the CALLBACK function passing | |
213 | it a single argument EVENT, which is of the form | |
214 | ||
215 | (DESCRIPTOR ACTION FILE [FILE1]) | |
216 | ||
217 | DESCRIPTOR is the same object as the one returned by this function. | |
218 | ACTION is the description of the event. It could be any one of the | |
219 | following: | |
220 | ||
221 | `created' -- FILE was created | |
222 | `deleted' -- FILE was deleted | |
223 | `changed' -- FILE has changed | |
224 | `renamed' -- FILE has been renamed to FILE1 | |
225 | `attribute-changed' -- a FILE attribute was changed | |
226 | ||
227 | FILE is the name of the file whose event is being reported." | |
228 | ;; Check arguments. | |
229 | (unless (stringp file) | |
230 | (signal 'wrong-type-argument (list file))) | |
231 | (setq file (expand-file-name file)) | |
232 | (unless (and (consp flags) | |
233 | (null (delq 'change (delq 'attribute-change (copy-tree flags))))) | |
234 | (signal 'wrong-type-argument (list flags))) | |
235 | (unless (functionp callback) | |
236 | (signal 'wrong-type-argument (list callback))) | |
237 | ||
238 | (let* ((handler (find-file-name-handler file 'file-notify-add-watch)) | |
239 | (dir (directory-file-name | |
fb6a5d68 | 240 | (if (file-directory-p file) |
864c58ca MA |
241 | file |
242 | (file-name-directory file)))) | |
243 | desc func l-flags) | |
244 | ||
245 | ;; Check, whether this has been registered already. | |
246 | ; (maphash | |
247 | ; (lambda (key value) | |
248 | ; (when (equal (cons file callback) value) (setq desc key))) | |
249 | ; file-notify-descriptors) | |
250 | ||
251 | (unless desc | |
252 | (if handler | |
253 | ;; A file name handler could exist even if there is no local | |
254 | ;; file notification support. | |
255 | (setq desc (funcall | |
256 | handler 'file-notify-add-watch dir flags callback)) | |
257 | ||
258 | ;; Check, whether Emacs has been compiled with file | |
259 | ;; notification support. | |
e06ec67f | 260 | (unless file-notify--library |
864c58ca MA |
261 | (signal 'file-notify-error |
262 | '("No file notification package available"))) | |
263 | ||
264 | ;; Determine low-level function to be called. | |
d5d3c58a MA |
265 | (setq func |
266 | (cond | |
267 | ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) | |
268 | ((eq file-notify--library 'inotify) 'inotify-add-watch) | |
269 | ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) | |
864c58ca MA |
270 | |
271 | ;; Determine respective flags. | |
e06ec67f | 272 | (if (eq file-notify--library 'gfilenotify) |
864c58ca MA |
273 | (setq l-flags '(watch-mounts send-moved)) |
274 | (when (memq 'change flags) | |
275 | (setq | |
276 | l-flags | |
277 | (cond | |
e06ec67f MA |
278 | ((eq file-notify--library 'inotify) '(create modify move delete)) |
279 | ((eq file-notify--library 'w32notify) | |
864c58ca MA |
280 | '(file-name directory-name size last-write-time))))) |
281 | (when (memq 'attribute-change flags) | |
282 | (add-to-list | |
283 | 'l-flags | |
284 | (cond | |
e06ec67f MA |
285 | ((eq file-notify--library 'inotify) 'attrib) |
286 | ((eq file-notify--library 'w32notify) 'attributes))))) | |
864c58ca MA |
287 | |
288 | ;; Call low-level function. | |
289 | (setq desc (funcall func dir l-flags 'file-notify-callback)))) | |
290 | ||
291 | ;; Return descriptor. | |
292 | (puthash desc | |
293 | (list (directory-file-name | |
294 | (if (file-directory-p dir) dir (file-name-directory dir))) | |
295 | (unless (file-directory-p file) | |
296 | (file-name-nondirectory file)) | |
297 | callback) | |
298 | file-notify-descriptors) | |
299 | desc)) | |
300 | ||
301 | (defun file-notify-rm-watch (descriptor) | |
302 | "Remove an existing watch specified by its DESCRIPTOR. | |
303 | DESCRIPTOR should be an object returned by `file-notify-add-watch'." | |
304 | (let ((file (car (gethash descriptor file-notify-descriptors))) | |
305 | handler) | |
306 | ||
307 | (when (stringp file) | |
308 | (setq handler (find-file-name-handler file 'file-notify-rm-watch)) | |
309 | (if handler | |
310 | (funcall handler 'file-notify-rm-watch descriptor) | |
311 | (funcall | |
312 | (cond | |
e06ec67f MA |
313 | ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) |
314 | ((eq file-notify--library 'inotify) 'inotify-rm-watch) | |
315 | ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) | |
864c58ca MA |
316 | descriptor))) |
317 | ||
318 | (remhash descriptor file-notify-descriptors))) | |
319 | ||
320 | ;; The end: | |
321 | (provide 'filenotify) | |
322 | ||
323 | ;;; filenotify.el ends here |