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