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 (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 cookie 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-supported-p (file)
 194   "Returns non-nil if filesystem pertaining to FILE could be watched."
 195   (unless (stringp file)
 196     (signal 'wrong-type-argument (list file)))
 197   (setq file (expand-file-name file))
 198
 199   (let ((handler (find-file-name-handler file 'file-notify-supported-p)))
 200     (if handler
 201         (funcall handler 'file-notify-supported-p file)
 202       (and file-notify--library t))))
 203
 204 (defun file-notify-add-watch (file flags callback)
 205   "Add a watch for filesystem events pertaining to FILE.
 206 This arranges for filesystem events pertaining to FILE to be reported
 207 to Emacs.  Use `file-notify-rm-watch' to cancel the watch.
 208
 209 The returned value is a descriptor for the added watch.  If the
 210 file cannot be watched for some reason, this function signals a
 211 `file-notify-error' error.
 212
 213 FLAGS is a list of conditions to set what will be watched for.  It can
 214 include the following symbols:
 215
 216   `change'           -- watch for file changes
 217   `attribute-change' -- watch for file attributes changes, like
 218                         permissions or modification time
 219
 220 If FILE is a directory, 'change' watches for file creation or
 221 deletion in that directory.
 222
 223 When any event happens, Emacs will call the CALLBACK function passing
 224 it a single argument EVENT, which is of the form
 225
 226   (DESCRIPTOR ACTION FILE [FILE1])
 227
 228 DESCRIPTOR is the same object as the one returned by this function.
 229 ACTION is the description of the event.  It could be any one of the
 230 following:
 231
 232   `created'           -- FILE was created
 233   `deleted'           -- FILE was deleted
 234   `changed'           -- FILE has changed
 235   `renamed'           -- FILE has been renamed to FILE1
 236   `attribute-changed' -- a FILE attribute was changed
 237
 238 FILE is the name of the file whose event is being reported."
 239   ;; Check arguments.
 240   (unless (stringp file)
 241     (signal 'wrong-type-argument (list file)))
 242   (setq file (expand-file-name file))
 243   (unless (and (consp flags)
 244                (null (delq 'change (delq 'attribute-change (copy-tree flags)))))
 245     (signal 'wrong-type-argument (list flags)))
 246   (unless (functionp callback)
 247     (signal 'wrong-type-argument (list callback)))
 248
 249   (let* ((handler (find-file-name-handler file 'file-notify-add-watch))
 250          (dir (directory-file-name
 251                (if (or (and (not handler) (eq file-notify--library 'w32notify))
 252                        (file-directory-p file))
 253                    file
 254                  (file-name-directory file))))
 255         desc func l-flags)
 256
 257     ;; Check, whether this has been registered already.
 258 ;    (maphash
 259 ;     (lambda (key value)
 260 ;       (when (equal (cons file callback) value) (setq desc key)))
 261 ;     file-notify-descriptors)
 262
 263     (unless desc
 264       (if handler
 265           ;; A file name handler could exist even if there is no local
 266           ;; file notification support.
 267           (setq desc (funcall
 268                       handler 'file-notify-add-watch dir flags callback))
 269
 270         ;; Check, whether Emacs has been compiled with file
 271         ;; notification support.
 272         (unless file-notify--library
 273           (signal 'file-notify-error
 274                   '("No file notification package available")))
 275
 276         ;; Determine low-level function to be called.
 277         (setq func (cond
 278                     ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
 279                     ((eq file-notify--library 'inotify) 'inotify-add-watch)
 280                     ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
 281
 282         ;; Determine respective flags.
 283         (if (eq file-notify--library 'gfilenotify)
 284             (setq l-flags '(watch-mounts send-moved))
 285           (when (memq 'change flags)
 286             (setq
 287              l-flags
 288              (cond
 289               ((eq file-notify--library 'inotify) '(create modify move delete))
 290               ((eq file-notify--library 'w32notify)
 291                '(file-name directory-name size last-write-time)))))
 292           (when (memq 'attribute-change flags)
 293             (add-to-list
 294              'l-flags
 295              (cond
 296               ((eq file-notify--library 'inotify) 'attrib)
 297               ((eq file-notify--library 'w32notify) 'attributes)))))
 298
 299         ;; Call low-level function.
 300         (setq desc (funcall func dir l-flags 'file-notify-callback))))
 301
 302     ;; Return descriptor.
 303     (puthash desc
 304              (list (directory-file-name
 305                     (if (file-directory-p dir) dir (file-name-directory dir)))
 306                    (unless (file-directory-p file)
 307                      (file-name-nondirectory file))
 308                    callback)
 309              file-notify-descriptors)
 310     desc))
 311
 312 (defun file-notify-rm-watch (descriptor)
 313   "Remove an existing watch specified by its DESCRIPTOR.
 314 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
 315   (let ((file (car (gethash descriptor file-notify-descriptors)))
 316         handler)
 317
 318     (when (stringp file)
 319       (setq handler (find-file-name-handler file 'file-notify-rm-watch))
 320       (if handler
 321           (funcall handler 'file-notify-rm-watch descriptor)
 322         (funcall
 323          (cond
 324           ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
 325           ((eq file-notify--library 'inotify) 'inotify-rm-watch)
 326           ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
 327          descriptor)))
 328
 329     (remhash descriptor file-notify-descriptors)))
 330
 331 ;; The end:
 332 (provide 'filenotify)
 333
 334 ;;; filenotify.el ends here