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