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