lisp/filenotify.el

   1 ;;; filenotify.el --- watch files for changes on disk
   2
   3 ;; Copyright (C) 2013-2014 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