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 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.
 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 (or (and (not handler) (eq file-notify--library 'w32notify))
 241                        (file-directory-p file))
 242                    file
 243                  (file-name-directory file))))
 244         desc func l-flags)
 245
 246     ;; Check, whether this has been registered already.
 247 ;    (maphash
 248 ;     (lambda (key value)
 249 ;       (when (equal (cons file callback) value) (setq desc key)))
 250 ;     file-notify-descriptors)
 251
 252     (unless desc
 253       (if handler
 254           ;; A file name handler could exist even if there is no local
 255           ;; file notification support.
 256           (setq desc (funcall
 257                       handler 'file-notify-add-watch dir flags callback))
 258
 259         ;; Check, whether Emacs has been compiled with file
 260         ;; notification support.
 261         (unless file-notify--library
 262           (signal 'file-notify-error
 263                   '("No file notification package available")))
 264
 265         ;; Determine low-level function to be called.
 266         (setq func
 267               (cond
 268                ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
 269                ((eq file-notify--library 'inotify) 'inotify-add-watch)
 270                ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
 271
 272         ;; Determine respective flags.
 273         (if (eq file-notify--library '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--library 'inotify) '(create modify move delete))
 280               ((eq file-notify--library '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--library 'inotify) 'attrib)
 287               ((eq file-notify--library '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--library 'gfilenotify) 'gfile-rm-watch)
 315           ((eq file-notify--library 'inotify) 'inotify-rm-watch)
 316           ((eq file-notify--library '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