don't use function-equal in nadvice
[bpt/emacs.git] / src / gfilenotify.c
1 /* Filesystem notifications support with glib API.
2 Copyright (C) 2013-2014 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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
9 (at your option) any later version.
10
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.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20
21 #ifdef HAVE_GFILENOTIFY
22 #include <stdio.h>
23 #include <gio/gio.h>
24 #include "lisp.h"
25 #include "coding.h"
26 #include "frame.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "process.h"
30
31 \f
32 /* Subroutines. */
33 static Lisp_Object Qgfile_add_watch;
34 static Lisp_Object Qgfile_rm_watch;
35
36 /* Filter objects. */
37 static Lisp_Object Qwatch_mounts; /* G_FILE_MONITOR_WATCH_MOUNTS */
38 static Lisp_Object Qsend_moved; /* G_FILE_MONITOR_SEND_MOVED */
39
40 /* Event types. */
41 static Lisp_Object Qchanged; /* G_FILE_MONITOR_EVENT_CHANGED */
42 static Lisp_Object Qchanges_done_hint; /* G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT */
43 static Lisp_Object Qdeleted; /* G_FILE_MONITOR_EVENT_DELETED */
44 static Lisp_Object Qcreated; /* G_FILE_MONITOR_EVENT_CREATED */
45 static Lisp_Object Qattribute_changed; /* G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED */
46 static Lisp_Object Qpre_unmount; /* G_FILE_MONITOR_EVENT_PRE_UNMOUNT */
47 static Lisp_Object Qunmounted; /* G_FILE_MONITOR_EVENT_UNMOUNTED */
48 static Lisp_Object Qmoved; /* G_FILE_MONITOR_EVENT_MOVED */
49
50 static Lisp_Object watch_list;
51
52 /* This is the callback function for arriving signals from
53 g_file_monitor. It shall create a Lisp event, and put it into
54 Emacs input queue. */
55 static gboolean
56 dir_monitor_callback (GFileMonitor *monitor,
57 GFile *file,
58 GFile *other_file,
59 GFileMonitorEvent event_type,
60 gpointer user_data)
61 {
62 Lisp_Object symbol, monitor_object, watch_object;
63 char *name = g_file_get_parse_name (file);
64 char *oname = other_file ? g_file_get_parse_name (other_file) : NULL;
65
66 /* Determine event symbol. */
67 switch (event_type)
68 {
69 case G_FILE_MONITOR_EVENT_CHANGED:
70 symbol = Qchanged;
71 break;
72 case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT:
73 symbol = Qchanges_done_hint;
74 break;
75 case G_FILE_MONITOR_EVENT_DELETED:
76 symbol = Qdeleted;
77 break;
78 case G_FILE_MONITOR_EVENT_CREATED:
79 symbol = Qcreated;
80 break;
81 case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED:
82 symbol = Qattribute_changed;
83 break;
84 case G_FILE_MONITOR_EVENT_PRE_UNMOUNT:
85 symbol = Qpre_unmount;
86 break;
87 case G_FILE_MONITOR_EVENT_UNMOUNTED:
88 symbol = Qunmounted;
89 break;
90 case G_FILE_MONITOR_EVENT_MOVED:
91 symbol = Qmoved;
92 break;
93 default:
94 goto cleanup;
95 }
96
97 /* Determine callback function. */
98 monitor_object = XIL ((intptr_t) monitor);
99 eassert (INTEGERP (monitor_object));
100 watch_object = assq_no_quit (monitor_object, watch_list);
101
102 if (CONSP (watch_object))
103 {
104 /* Construct an event. */
105 struct input_event event;
106 Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil;
107 EVENT_INIT (event);
108 event.kind = FILE_NOTIFY_EVENT;
109 event.frame_or_window = Qnil;
110 event.arg = list2 (Fcons (monitor_object,
111 Fcons (symbol,
112 Fcons (build_string (name),
113 otail))),
114 XCDR (watch_object));
115
116 /* Store it into the input event queue. */
117 kbd_buffer_store_event (&event);
118 }
119
120 /* Cleanup. */
121 cleanup:
122 g_free (name);
123 g_free (oname);
124
125 return TRUE;
126 }
127
128 DEFUN ("gfile-add-watch", Fgfile_add_watch, Sgfile_add_watch, 3, 3, 0,
129 doc: /* Add a watch for filesystem events pertaining to FILE.
130
131 This arranges for filesystem events pertaining to FILE to be reported
132 to Emacs. Use `gfile-rm-watch' to cancel the watch.
133
134 Value is a descriptor for the added watch. If the file cannot be
135 watched for some reason, this function signals a `file-notify-error' error.
136
137 FLAGS is a list of conditions to set what will be watched for. It can
138 include the following symbols:
139
140 'watch-mounts' -- watch for mount events
141 'send-moved' -- pair 'deleted' and 'created' events caused by file
142 renames and send a single 'renamed' event instead
143
144 When any event happens, Emacs will call the CALLBACK function passing
145 it a single argument EVENT, which is of the form
146
147 (DESCRIPTOR ACTION FILE [FILE1])
148
149 DESCRIPTOR is the same object as the one returned by this function.
150 ACTION is the description of the event. It could be any one of the
151 following:
152
153 'changed' -- FILE has changed
154 'changes-done-hint' -- a hint that this was probably the last change
155 in a set of changes
156 'deleted' -- FILE was deleted
157 'created' -- FILE was created
158 'attribute-changed' -- a FILE attribute was changed
159 'pre-unmount' -- the FILE location will soon be unmounted
160 'unmounted' -- the FILE location was unmounted
161 'moved' -- FILE was moved to FILE1
162
163 FILE is the name of the file whose event is being reported. FILE1
164 will be reported only in case of the 'moved' event. */)
165 (Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
166 {
167 Lisp_Object watch_descriptor, watch_object;
168 GFile *gfile;
169 GFileMonitor *monitor;
170 GFileMonitorFlags gflags = G_FILE_MONITOR_NONE;
171
172 /* Check parameters. */
173 CHECK_STRING (file);
174 file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
175 if (NILP (Ffile_exists_p (file)))
176 report_file_error ("File does not exist", file);
177
178 CHECK_LIST (flags);
179
180 if (!FUNCTIONP (callback))
181 wrong_type_argument (Qinvalid_function, callback);
182
183 /* Create GFile name. */
184 gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
185
186 /* Assemble flags. */
187 if (!NILP (Fmember (Qwatch_mounts, flags)))
188 gflags |= G_FILE_MONITOR_WATCH_MOUNTS;
189 if (!NILP (Fmember (Qsend_moved, flags)))
190 gflags |= G_FILE_MONITOR_SEND_MOVED;
191
192 /* Enable watch. */
193 monitor = g_file_monitor (gfile, gflags, NULL, NULL);
194 if (! monitor)
195 xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file);
196
197 /* On all known glib platforms, converting MONITOR directly to a
198 Lisp_Object value results is a Lisp integer, which is safe. This
199 assumption is dicey, though, so check it now. */
200 watch_descriptor = XIL ((intptr_t) monitor);
201 if (! INTEGERP (watch_descriptor))
202 {
203 g_object_unref (monitor);
204 xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"),
205 file);
206 }
207
208 g_signal_connect (monitor, "changed",
209 (GCallback) dir_monitor_callback, NULL);
210
211 /* Store watch object in watch list. */
212 watch_object = Fcons (watch_descriptor, callback);
213 watch_list = Fcons (watch_object, watch_list);
214
215 return watch_descriptor;
216 }
217
218 DEFUN ("gfile-rm-watch", Fgfile_rm_watch, Sgfile_rm_watch, 1, 1, 0,
219 doc: /* Remove an existing WATCH-DESCRIPTOR.
220
221 WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */)
222 (Lisp_Object watch_descriptor)
223 {
224 intptr_t int_monitor;
225 GFileMonitor *monitor;
226 Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
227
228 if (! CONSP (watch_object))
229 xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
230 watch_descriptor);
231
232 eassert (INTEGERP (watch_descriptor));
233 int_monitor = XLI (watch_descriptor);
234 monitor = (GFileMonitor *) int_monitor;
235 if (!g_file_monitor_cancel (monitor))
236 xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"),
237 watch_descriptor);
238
239 /* Remove watch descriptor from watch list. */
240 watch_list = Fdelq (watch_object, watch_list);
241
242 /* Cleanup. */
243 g_object_unref (monitor);
244
245 return Qt;
246 }
247
248 \f
249 void
250 globals_of_gfilenotify (void)
251 {
252 #if ! GLIB_CHECK_VERSION (2, 36, 0)
253 g_type_init ();
254 #endif
255 watch_list = Qnil;
256 }
257
258 void
259 syms_of_gfilenotify (void)
260 {
261 #include "gfilenotify.x"
262
263 DEFSYM (Qgfile_add_watch, "gfile-add-watch");
264 DEFSYM (Qgfile_rm_watch, "gfile-rm-watch");
265 DEFSYM (Qwatch_mounts, "watch-mounts");
266 DEFSYM (Qsend_moved, "send-moved");
267 DEFSYM (Qchanged, "changed");
268 DEFSYM (Qchanges_done_hint, "changes-done-hint");
269 DEFSYM (Qdeleted, "deleted");
270 DEFSYM (Qcreated, "created");
271 DEFSYM (Qattribute_changed, "attribute-changed");
272 DEFSYM (Qpre_unmount, "pre-unmount");
273 DEFSYM (Qunmounted, "unmounted");
274 DEFSYM (Qmoved, "moved");
275
276 staticpro (&watch_list);
277
278 Fprovide (intern_c_string ("gfilenotify"), Qnil);
279
280 }
281
282 #endif /* HAVE_GFILENOTIFY */