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