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