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

   1 ;;; filenotify.el --- watch files for changes on disk  -*- lexical-binding:t -*-
   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 [FILE1-OR-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 ;; Needed for `inotify' and `w32notify'.  In the latter case, COOKIE is nil.
  68 (defvar file-notify--pending-event nil
  69   "A pending file notification events for a future `renamed' action.
  70 It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
  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)
  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
 101             (car (cadr (gethash descriptor file-notify-descriptors))))
 102     descriptor))
 103
 104 ;; The callback function used to map between specific flags of the
 105 ;; respective file notifications, and the ones we return.
 106 (defun file-notify-callback (event)
 107   "Handle an EVENT returned from file notification.
 108 EVENT is the cadr of the event in `file-notify-handle-event'
 109 \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
 110   (let* ((desc (car event))
 111          (registered (gethash desc file-notify-descriptors))
 112          (actions (nth 1 event))
 113          (file (file-notify--event-file-name event))
 114          file1 callback pending-event)
 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 file-notify--pending-event
 133                    ;; The cookie doesn't match.
 134                    (not (eq (file-notify--event-cookie
 135                              (car file-notify--pending-event))
 136                             (file-notify--event-cookie event)))
 137                    (or
 138                     ;; inotify.
 139                     (and (eq (nth 1 (car file-notify--pending-event))
 140                              'moved-from)
 141                          (not (eq action 'moved-to)))
 142                     ;; w32notify.
 143                     (and (eq (nth 1 (car file-notify--pending-event))
 144                              'renamed-from)
 145                          (not (eq action 'renamed-to)))))
 146           (setq pending-event file-notify--pending-event
 147                 file-notify--pending-event nil)
 148           (setcar (cdar pending-event) 'deleted))
 149
 150         ;; Map action.  We ignore all events which cannot be mapped.
 151         (setq action
 152               (cond
 153                ;; gfilenotify.
 154                ((memq action '(attribute-changed changed created deleted))
 155                 action)
 156                ((eq action 'moved)
 157                 (setq file1 (file-notify--event-file1-name event))
 158                 'renamed)
 159
 160                ;; inotify, w32notify.
 161                ((eq action 'attrib) 'attribute-changed)
 162                ((memq action '(create added)) 'created)
 163                ((memq action '(modify modified)) 'changed)
 164                ((memq action '(delete delete-self move-self removed)) 'deleted)
 165                ;; Make the event pending.
 166                ((memq action '(moved-from renamed-from))
 167                 (setq file-notify--pending-event
 168                       `((,desc ,action ,file ,(file-notify--event-cookie event))
 169                         ,callback))
 170                 nil)
 171                ;; Look for pending event.
 172                ((memq action '(moved-to renamed-to))
 173                 (if (null file-notify--pending-event)
 174                     'created
 175                   (setq file1 file
 176                         file (file-notify--event-file-name
 177                               (car file-notify--pending-event)))
 178                   ;; If the source is handled by another watch, we
 179                   ;; must fire the rename event there as well.
 180                   (when (not (equal (file-notify--descriptor desc)
 181                                     (file-notify--descriptor
 182                                      (caar file-notify--pending-event))))
 183                     (setq pending-event
 184                           `((,(caar file-notify--pending-event)
 185                              renamed ,file ,file1)
 186                             ,(cadr file-notify--pending-event))))
 187                   (setq file-notify--pending-event nil)
 188                   'renamed))))
 189
 190         ;; Apply pending callback.
 191         (when pending-event
 192           (setcar
 193            (car pending-event) (file-notify--descriptor (caar pending-event)))
 194           (funcall (cadr pending-event) (car pending-event))
 195           (setq pending-event nil))
 196
 197         ;; Apply callback.
 198         (when (and action
 199                    (or
 200                     ;; If there is no relative file name for that watch,
 201                     ;; we watch the whole directory.
 202                     (null (nth 0 entry))
 203                     ;; File matches.
 204                     (string-equal
 205                      (nth 0 entry) (file-name-nondirectory file))
 206                     ;; File1 matches.
 207                     (and (stringp file1)
 208                          (string-equal
 209                           (nth 0 entry) (file-name-nondirectory file1)))))
 210           (if file1
 211               (funcall
 212                callback
 213                `(,(file-notify--descriptor desc) ,action ,file ,file1))
 214             (funcall
 215              callback
 216              `(,(file-notify--descriptor desc) ,action ,file))))))))
 217
 218 ;; `gfilenotify' and `w32notify' return a unique descriptor for every
 219 ;; `file-notify-add-watch', while `inotify' returns a unique
 220 ;; descriptor per inode only.
 221 (defun file-notify-add-watch (file flags callback)
 222   "Add a watch for filesystem events pertaining to FILE.
 223 This arranges for filesystem events pertaining to FILE to be reported
 224 to Emacs.  Use `file-notify-rm-watch' to cancel the watch.
 225
 226 The returned value is a descriptor for the added watch.  If the
 227 file cannot be watched for some reason, this function signals a
 228 `file-notify-error' error.
 229
 230 FLAGS is a list of conditions to set what will be watched for.  It can
 231 include the following symbols:
 232
 233   `change'           -- watch for file changes
 234   `attribute-change' -- watch for file attributes changes, like
 235                         permissions or modification time
 236
 237 If FILE is a directory, `change' watches for file creation or
 238 deletion in that directory.  This does not work recursively.
 239
 240 When any event happens, Emacs will call the CALLBACK function passing
 241 it a single argument EVENT, which is of the form
 242
 243   (DESCRIPTOR ACTION FILE [FILE1])
 244
 245 DESCRIPTOR is the same object as the one returned by this function.
 246 ACTION is the description of the event.  It could be any one of the
 247 following:
 248
 249   `created'           -- FILE was created
 250   `deleted'           -- FILE was deleted
 251   `changed'           -- FILE has changed
 252   `renamed'           -- FILE has been renamed to FILE1
 253   `attribute-changed' -- a FILE attribute was changed
 254
 255 FILE is the name of the file whose event is being reported."
 256   ;; Check arguments.
 257   (unless (stringp file)
 258     (signal 'wrong-type-argument (list file)))
 259   (setq file (expand-file-name file))
 260   (unless (and (consp flags)
 261                (null (delq 'change (delq 'attribute-change (copy-tree flags)))))
 262     (signal 'wrong-type-argument (list flags)))
 263   (unless (functionp callback)
 264     (signal 'wrong-type-argument (list callback)))
 265
 266   (let* ((handler (find-file-name-handler file 'file-notify-add-watch))
 267          (dir (directory-file-name
 268                (if (file-directory-p file)
 269                    file
 270                  (file-name-directory file))))
 271         desc func l-flags registered)
 272
 273     (if handler
 274         ;; A file name handler could exist even if there is no local
 275         ;; file notification support.
 276         (setq desc (funcall
 277                     handler 'file-notify-add-watch dir flags callback))
 278
 279       ;; Check, whether Emacs has been compiled with file
 280       ;; notification support.
 281       (unless file-notify--library
 282         (signal 'file-notify-error
 283                 '("No file notification package available")))
 284
 285       ;; Determine low-level function to be called.
 286       (setq func
 287             (cond
 288              ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
 289              ((eq file-notify--library 'inotify) 'inotify-add-watch)
 290              ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
 291
 292       ;; Determine respective flags.
 293       (if (eq file-notify--library 'gfilenotify)
 294           (setq l-flags (append '(watch-mounts send-moved) flags))
 295         (when (memq 'change flags)
 296           (setq
 297            l-flags
 298            (cond
 299             ((eq file-notify--library 'inotify) '(create modify move delete))
 300             ((eq file-notify--library 'w32notify)
 301              '(file-name directory-name size last-write-time)))))
 302         (when (memq 'attribute-change flags)
 303           (push (cond
 304                  ((eq file-notify--library 'inotify) 'attrib)
 305                  ((eq file-notify--library 'w32notify) 'attributes))
 306                 l-flags)))
 307
 308       ;; Call low-level function.
 309       (setq desc (funcall func dir l-flags 'file-notify-callback)))
 310
 311     ;; Modify `file-notify-descriptors'.
 312     (setq registered (gethash desc file-notify-descriptors))
 313     (puthash
 314      desc
 315      `(,dir
 316        (,(unless (file-directory-p file) (file-name-nondirectory file))
 317         . ,callback)
 318        . ,(cdr registered))
 319      file-notify-descriptors)
 320
 321     ;; Return descriptor.
 322     (file-notify--descriptor desc)))
 323
 324 (defun file-notify-rm-watch (descriptor)
 325   "Remove an existing watch specified by its DESCRIPTOR.
 326 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
 327   (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
 328          (file (if (consp descriptor) (cdr descriptor)))
 329          (dir (car (gethash desc file-notify-descriptors)))
 330          (handler (and (stringp dir)
 331                        (find-file-name-handler dir 'file-notify-rm-watch)))
 332          (registered (gethash desc file-notify-descriptors)))
 333
 334     (when (stringp dir)
 335       ;; Call low-level function.
 336       (when (null (cdr registered))
 337         (condition-case nil
 338             (if handler
 339                 ;; A file name handler could exist even if there is no local
 340                 ;; file notification support.
 341                 (funcall handler 'file-notify-rm-watch desc)
 342
 343               (funcall
 344                (cond
 345                 ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
 346                 ((eq file-notify--library 'inotify) 'inotify-rm-watch)
 347                 ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
 348                desc))
 349           (file-notify-error nil)))
 350
 351       ;; Modify `file-notify-descriptors'.
 352       (if (not file)
 353           (remhash desc file-notify-descriptors)
 354
 355         (setcdr registered
 356                 (delete (assoc file (cdr registered)) (cdr registered)))
 357         (if (null (cdr registered))
 358             (remhash desc file-notify-descriptors)
 359           (puthash desc registered file-notify-descriptors))))))
 360
 361 (defun file-notify-valid-p (descriptor)
 362   "Check a watch specified by its DESCRIPTOR.
 363 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
 364   (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
 365          (file (if (consp descriptor) (cdr descriptor)))
 366          (registered (gethash desc file-notify-descriptors))
 367          (dir (car registered))
 368          handler)
 369
 370     (when (stringp dir)
 371       (setq handler (find-file-name-handler dir 'file-notify-valid-p))
 372
 373       (and (or ;; It is a directory.
 374                (not file)
 375                ;; The file is registered.
 376                (assoc file (cdr registered)))
 377            (if handler
 378                ;; A file name handler could exist even if there is no
 379                ;; local file notification support.
 380                (funcall handler 'file-notify-valid-p descriptor)
 381              (funcall
 382               (cond
 383                ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
 384                ((eq file-notify--library 'inotify) 'inotify-valid-p)
 385                ((eq file-notify--library 'w32notify) 'w32notify-valid-p))
 386               desc))
 387            t))))
 388
 389 ;; The end:
 390 (provide 'filenotify)
 391
 392 ;;; filenotify.el ends here