Improve responsiveness while in 'replace-buffer-contents'
[emacs.git] / src / gfilenotify.c
blob650df0fcbb549cf98fcd1849b24595eb76c28cf3
1 /* Filesystem notifications support with glib API.
2 Copyright (C) 2013-2018 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or (at
9 your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19 #include <config.h>
21 #ifdef HAVE_GFILENOTIFY
22 #include <stdio.h>
23 #include <gio/gio.h>
24 #include "lisp.h"
25 #include "coding.h"
26 #include "termhooks.h"
27 #include "keyboard.h"
30 /* This is a list, elements are quadruples (DESCRIPTOR FILE FLAGS CALLBACK) */
31 static Lisp_Object watch_list;
33 /* This is the callback function for arriving signals from
34 g_file_monitor. It shall create a Lisp event, and put it into
35 Emacs input queue. */
36 static gboolean
37 dir_monitor_callback (GFileMonitor *monitor,
38 GFile *file,
39 GFile *other_file,
40 GFileMonitorEvent event_type,
41 gpointer user_data)
43 Lisp_Object symbol, monitor_object, watch_object, flags;
44 char *name = g_file_get_parse_name (file);
45 char *oname = other_file ? g_file_get_parse_name (other_file) : NULL;
47 /* Determine event symbol. */
48 switch (event_type)
50 case G_FILE_MONITOR_EVENT_CHANGED:
51 symbol = Qchanged;
52 break;
53 case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT:
54 symbol = Qchanges_done_hint;
55 break;
56 case G_FILE_MONITOR_EVENT_DELETED:
57 symbol = Qdeleted;
58 break;
59 case G_FILE_MONITOR_EVENT_CREATED:
60 symbol = Qcreated;
61 break;
62 case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED:
63 symbol = Qattribute_changed;
64 break;
65 case G_FILE_MONITOR_EVENT_PRE_UNMOUNT:
66 symbol = Qpre_unmount;
67 break;
68 case G_FILE_MONITOR_EVENT_UNMOUNTED:
69 symbol = Qunmounted;
70 break;
71 case G_FILE_MONITOR_EVENT_MOVED:
72 symbol = Qmoved;
73 break;
74 default:
75 goto cleanup;
78 /* Determine callback function. */
79 monitor_object = make_pointer_integer (monitor);
80 eassert (INTEGERP (monitor_object));
81 watch_object = assq_no_quit (monitor_object, watch_list);
83 if (CONSP (watch_object))
85 struct input_event event;
86 Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil;
88 /* Check, whether event_type is expected. */
89 flags = XCAR (XCDR (XCDR (watch_object)));
90 if ((!NILP (Fmember (Qchange, flags)) &&
91 !NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint,
92 Qdeleted, Qcreated, Qmoved)))) ||
93 (!NILP (Fmember (Qattribute_change, flags)) &&
94 ((EQ (symbol, Qattribute_changed)))))
96 /* Construct an event. */
97 EVENT_INIT (event);
98 event.kind = FILE_NOTIFY_EVENT;
99 event.frame_or_window = Qnil;
100 event.arg = list2 (Fcons (monitor_object,
101 Fcons (symbol,
102 Fcons (build_string (name),
103 otail))),
104 XCAR (XCDR (XCDR (XCDR (watch_object)))));
106 /* Store it into the input event queue. */
107 kbd_buffer_store_event (&event);
108 /* XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg)); */
111 /* Cancel monitor if file or directory is deleted. */
112 if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved))) &&
113 (strcmp (name, SSDATA (XCAR (XCDR (watch_object)))) == 0) &&
114 !g_file_monitor_is_cancelled (monitor))
115 g_file_monitor_cancel (monitor);
118 /* Cleanup. */
119 cleanup:
120 g_free (name);
121 g_free (oname);
123 return TRUE;
126 DEFUN ("gfile-add-watch", Fgfile_add_watch, Sgfile_add_watch, 3, 3, 0,
127 doc: /* Add a watch for filesystem events pertaining to FILE.
129 This arranges for filesystem events pertaining to FILE to be reported
130 to Emacs. Use `gfile-rm-watch' to cancel the watch.
132 Value is a descriptor for the added watch. If the file cannot be
133 watched for some reason, this function signals a `file-notify-error' error.
135 FLAGS is a list of conditions to set what will be watched for. It can
136 include the following symbols:
138 `change' -- watch for file changes
139 `attribute-change' -- watch for file attributes changes, like
140 permissions or modification time
141 `watch-mounts' -- watch for mount events
142 `send-moved' -- pair `deleted' and `created' events caused by
143 file renames and send a single `renamed' event
144 instead
146 When any event happens, Emacs will call the CALLBACK function passing
147 it a single argument EVENT, which is of the form
149 (DESCRIPTOR ACTION FILE [FILE1])
151 DESCRIPTOR is the same object as the one returned by this function.
152 ACTION is the description of the event. It could be any one of the
153 following:
155 `changed' -- FILE has changed
156 `changes-done-hint' -- a hint that this was probably the last change
157 in a set of changes
158 `deleted' -- FILE was deleted
159 `created' -- FILE was created
160 `attribute-changed' -- a FILE attribute was changed
161 `pre-unmount' -- the FILE location will soon be unmounted
162 `unmounted' -- the FILE location was unmounted
163 `moved' -- FILE was moved to FILE1
165 FILE is the name of the file whose event is being reported. FILE1
166 will be reported only in case of the `moved' event. */)
167 (Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
169 Lisp_Object watch_object;
170 GFile *gfile;
171 GFileMonitor *monitor;
172 GFileMonitorFlags gflags = G_FILE_MONITOR_NONE;
173 GError *gerror = NULL;
175 /* Check parameters. */
176 CHECK_STRING (file);
177 file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
178 if (NILP (Ffile_exists_p (file)))
179 report_file_error ("File does not exist", file);
181 if (!FUNCTIONP (callback))
182 wrong_type_argument (Qinvalid_function, callback);
184 /* Assemble flags. */
185 if (!NILP (Fmember (Qwatch_mounts, flags)))
186 gflags |= G_FILE_MONITOR_WATCH_MOUNTS;
187 if (!NILP (Fmember (Qsend_moved, flags)))
188 gflags |= G_FILE_MONITOR_SEND_MOVED;
190 /* Create GFile name. */
191 gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
193 /* Enable watch. */
194 monitor = g_file_monitor (gfile, gflags, NULL, &gerror);
195 g_object_unref (gfile);
196 if (gerror)
198 char msg[1024];
199 strcpy (msg, gerror->message);
200 g_error_free (gerror);
201 xsignal1 (Qfile_notify_error, build_string (msg));
203 if (! monitor)
204 xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file);
206 Lisp_Object watch_descriptor = make_pointer_integer (monitor);
208 /* Check the dicey assumption that make_pointer_integer is safe. */
209 if (! INTEGERP (watch_descriptor))
211 g_object_unref (monitor);
212 xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"),
213 file);
216 /* The default rate limit is 800 msec. We adapt this. */
217 g_file_monitor_set_rate_limit (monitor, 100);
219 /* Subscribe to the "changed" signal. */
220 g_signal_connect (monitor, "changed",
221 (GCallback) dir_monitor_callback, NULL);
223 /* Store watch object in watch list. */
224 watch_object = list4 (watch_descriptor, file, flags, callback);
225 watch_list = Fcons (watch_object, watch_list);
227 return watch_descriptor;
230 DEFUN ("gfile-rm-watch", Fgfile_rm_watch, Sgfile_rm_watch, 1, 1, 0,
231 doc: /* Remove an existing WATCH-DESCRIPTOR.
233 WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */)
234 (Lisp_Object watch_descriptor)
236 Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
238 if (! CONSP (watch_object))
239 xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
240 watch_descriptor);
242 eassert (INTEGERP (watch_descriptor));
243 GFileMonitor *monitor = XINTPTR (watch_descriptor);
244 if (!g_file_monitor_is_cancelled (monitor) &&
245 !g_file_monitor_cancel (monitor))
246 xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"),
247 watch_descriptor);
249 /* Remove watch descriptor from watch list. */
250 watch_list = Fdelq (watch_object, watch_list);
252 /* Cleanup. */
253 g_object_unref (monitor);
255 return Qt;
258 DEFUN ("gfile-valid-p", Fgfile_valid_p, Sgfile_valid_p, 1, 1, 0,
259 doc: /* Check a watch specified by its WATCH-DESCRIPTOR.
261 WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'.
263 A watch can become invalid if the file or directory it watches is
264 deleted, or if the watcher thread exits abnormally for any other
265 reason. Removing the watch by calling `gfile-rm-watch' also makes it
266 invalid. */)
267 (Lisp_Object watch_descriptor)
269 Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
270 if (NILP (watch_object))
271 return Qnil;
272 else
274 GFileMonitor *monitor = XINTPTR (watch_descriptor);
275 return g_file_monitor_is_cancelled (monitor) ? Qnil : Qt;
279 DEFUN ("gfile-monitor-name", Fgfile_monitor_name, Sgfile_monitor_name, 1, 1, 0,
280 doc: /* Return the internal monitor name for WATCH-DESCRIPTOR.
282 The result is a symbol, either `GInotifyFileMonitor',
283 `GKqueueFileMonitor', `GFamFileMonitor', or `GPollFileMonitor'.
285 WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'.
286 If WATCH-DESCRIPTOR is not valid, nil is returned. */)
287 (Lisp_Object watch_descriptor)
289 if (NILP (Fgfile_valid_p (watch_descriptor)))
290 return Qnil;
291 else
293 GFileMonitor *monitor = XINTPTR (watch_descriptor);
294 return intern (G_OBJECT_TYPE_NAME (monitor));
299 void
300 globals_of_gfilenotify (void)
302 #if ! GLIB_CHECK_VERSION (2, 36, 0)
303 g_type_init ();
304 #endif
305 watch_list = Qnil;
308 void
309 syms_of_gfilenotify (void)
311 defsubr (&Sgfile_add_watch);
312 defsubr (&Sgfile_rm_watch);
313 defsubr (&Sgfile_valid_p);
314 defsubr (&Sgfile_monitor_name);
316 /* Filter objects. */
317 DEFSYM (Qchange, "change");
318 DEFSYM (Qattribute_change, "attribute-change");
319 DEFSYM (Qwatch_mounts, "watch-mounts"); /* G_FILE_MONITOR_WATCH_MOUNTS */
320 DEFSYM (Qsend_moved, "send-moved"); /* G_FILE_MONITOR_SEND_MOVED */
322 /* Event types. */
323 DEFSYM (Qchanged, "changed"); /* G_FILE_MONITOR_EVENT_CHANGED */
324 DEFSYM (Qchanges_done_hint, "changes-done-hint");
325 /* G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT */
326 DEFSYM (Qdeleted, "deleted"); /* G_FILE_MONITOR_EVENT_DELETED */
327 DEFSYM (Qcreated, "created"); /* G_FILE_MONITOR_EVENT_CREATED */
328 DEFSYM (Qattribute_changed, "attribute-changed");
329 /* G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED */
330 DEFSYM (Qpre_unmount, "pre-unmount"); /* G_FILE_MONITOR_EVENT_PRE_UNMOUNT */
331 DEFSYM (Qunmounted, "unmounted"); /* G_FILE_MONITOR_EVENT_UNMOUNTED */
332 DEFSYM (Qmoved, "moved"); /* G_FILE_MONITOR_EVENT_MOVED */
334 staticpro (&watch_list);
336 Fprovide (intern_c_string ("gfilenotify"), Qnil);
340 #endif /* HAVE_GFILENOTIFY */