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