lisp/filenotify.el

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