code.delx.au - gnu-emacs/blob - lisp/filenotify.el

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