| 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 | |
| 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.") |
| 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)) |
| 95 | file1 callback) |
| 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 |
| 210 | deletion in that directory. This does not work recursively. |
| 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 |
| 240 | (if (file-directory-p file) |
| 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. |
| 260 | (unless file-notify--library |
| 261 | (signal 'file-notify-error |
| 262 | '("No file notification package available"))) |
| 263 | |
| 264 | ;; Determine low-level function to be called. |
| 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))) |
| 270 | |
| 271 | ;; Determine respective flags. |
| 272 | (if (eq file-notify--library 'gfilenotify) |
| 273 | (setq l-flags '(watch-mounts send-moved)) |
| 274 | (when (memq 'change flags) |
| 275 | (setq |
| 276 | l-flags |
| 277 | (cond |
| 278 | ((eq file-notify--library 'inotify) '(create modify move delete)) |
| 279 | ((eq file-notify--library 'w32notify) |
| 280 | '(file-name directory-name size last-write-time))))) |
| 281 | (when (memq 'attribute-change flags) |
| 282 | (add-to-list |
| 283 | 'l-flags |
| 284 | (cond |
| 285 | ((eq file-notify--library 'inotify) 'attrib) |
| 286 | ((eq file-notify--library 'w32notify) 'attributes))))) |
| 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 |
| 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)) |
| 316 | descriptor))) |
| 317 | |
| 318 | (remhash descriptor file-notify-descriptors))) |
| 319 | |
| 320 | ;; The end: |
| 321 | (provide 'filenotify) |
| 322 | |
| 323 | ;;; filenotify.el ends here |