;;; dired-fnotify.el --- autoupdate directory buffers on filesystem change

;; Author: Noah Friedman <friedman@splode.com>
;; Created: 2015-11-05
;; Public domain.

;; $Id: dired-fnotify.el,v 1.6 2019/08/07 01:56:27 friedman Exp $

;;; Commentary:
;;; Code:

(require 'dired)
(require 'filenotify)  ;; Emacs 24 or later

(defgroup dired-fnotify nil
  "Autoupdate dired buffers on filesystem change."
  :group 'dired)

(defcustom dired-fnotify-min-revert-interval 1
  "Suspend autoupdate if more than `dired-fnotify-max-interval-count' \
events occur in the span of this many seconds."
  :type 'integer
  :group 'dired-fnotify)

(defcustom dired-fnotify-max-interval-count  5
  "Maximum number of events which can occur in `dired-fnotify-min-revert-interval' seconds.
If more than this many events occur, event notification is temporarily suspended."
  :type 'integer
  :group 'dired-fnotify)

(defcustom dired-fnotify-restart-idle-delay  2
  "Number of seconds Emacs must be idle before event notifications are re-enabled."
  :type 'integer
  :group 'dired-fnotify)

(defcustom dired-fnotify-watch-events
  '(change attribute-change)
  "Events categories which to receive notifications.
This list is limited to the type of events `filenotify' (which see) can
monitor, regardless of backend that it uses."
  :type    '(repeat symbol)
  :options '(change attribute-change)
  :group   'dired-fnotify)

(defcustom dired-fnotify-revert-actions
  '(created deleted changed renamed attribute-changed)
  "Events types for which to refresh dired buffer.
This list is limited to the type of actions `filenotify' (which see)
defines, regardless of backend that it uses."
  :type    '(repeat symbol)
  :options '(created deleted changed renamed attribute-changed)
  :group   'dired-fnotify)


(defvar dired-fnotify-descriptor-alist nil)

(defconst dired-fnotify-idx-fd      0)
(defconst dired-fnotify-idx-ltime   1)
(defconst dired-fnotify-idx-count   2)
(defconst dired-fnotify-idx-buffers 3)

(defun dired-fnotify-fdassoc (fd)
  (if (stringp fd)
      (assoc fd dired-fnotify-descriptor-alist)
    (let ((found nil))
      (catch 'done
        (mapc (lambda (elt)
                (when (equal (aref (cdr elt) dired-fnotify-idx-fd) fd)
                  (setq found elt)
                  (throw 'done t)))
          dired-fnotify-descriptor-alist))
      found)))

;; This can signal can error if there is no notification facility
;; available, such as on remote systems via tramp.
;; In that case, just skip it.
(defun dired-fnotify-make-watchfd (dir)
  (condition-case nil
      (file-notify-add-watch dir dired-fnotify-watch-events 'dired-fnotify-callback)
    (error nil)))

(defun dired-fnotify-create-watch (dir)
  (let ((dvec (cdr (assoc dir dired-fnotify-descriptor-alist))))
    (unless (and dvec (aref dvec dired-fnotify-idx-fd))
      (let ((watch (dired-fnotify-make-watchfd dir)))
        (if dvec
            (aset dvec dired-fnotify-idx-fd watch)
          (setq dvec (vector watch (float-time) 0 nil))
          (push (cons dir dvec) dired-fnotify-descriptor-alist))))
    dvec))

(defun dired-fnotify-stop-watch (fd)
  (condition-case nil
      (file-notify-rm-watch fd)
    (error nil))
  (let ((dvec (cdr (dired-fnotify-fdassoc fd))))
    (aset dvec dired-fnotify-idx-fd    nil)
    (aset dvec dired-fnotify-idx-count 0)))

(defun dired-fnotify-restart (dir)
  (let* ((dvec (dired-fnotify-create-watch dir))
         (fd (aref dvec dired-fnotify-idx-fd)))
    (dired-fnotify-revert-buffers fd)))

(defun diref-fnotify-scan-for-restart ()
  (mapc (lambda (elt)
          (let ((dvec (cdr elt)))
            (unless (aref dvec dired-fnotify-idx-fd)
              (dired-fnotify-restart (car elt)))))
    dired-fnotify-descriptor-alist))

(defun dired-fnotify-remove-watch (dir)
  (let* ((elt (assoc dir dired-fnotify-descriptor-alist))
         (dvec (cdr elt))
         (fd (if dvec
                 (aref dvec dired-fnotify-idx-fd))))
    (when fd
      (condition-case err
          (file-notify-rm-watch fd)
        (error (message "%s" err)
               nil)))
    (when elt
      (setq dired-fnotify-descriptor-alist
            (delq elt dired-fnotify-descriptor-alist)))))

(defun dired-fnotify-revert-buffers (spec)
  (cond ((bufferp spec)
         (setq spec (cons spec nil)))
        ((and (consp spec)
              (bufferp (car spec))))
        (t
         (setq spec (aref (cdr (dired-fnotify-fdassoc spec))
                          dired-fnotify-idx-buffers))))
  (save-current-buffer
    (condition-case nil
        (mapc (lambda (buffer)
                (when (buffer-live-p buffer)
                  (set-buffer buffer)
                  (when (eq major-mode 'dired-mode)
                    (revert-buffer))))
          spec)
      (error nil))))

(defun dired-fnotify-callback (event)
  (let ((inhibit-quit nil)
        (fd (car event))
        (action (cadr event))
        elt)
    (when (and (or (eq dired-fnotify-revert-actions t)
                   (memq action dired-fnotify-revert-actions))
               (setq elt (dired-fnotify-fdassoc fd)))
      (let* ((dvec  (cdr elt))
             (prev  (aref dvec dired-fnotify-idx-ltime))
             (now   (float-time))
             (count (aref dvec dired-fnotify-idx-count)))

        (aset dvec dired-fnotify-idx-ltime now)
        (aset dvec dired-fnotify-idx-count 0)

        (cond ((> (- now prev) dired-fnotify-min-revert-interval)
               (dired-fnotify-revert-buffers fd))

              ((> count dired-fnotify-max-interval-count)
               (dired-fnotify-stop-watch fd)
               (dired-fnotify-schedule-restart (car elt)))

              (t
               (aset dvec dired-fnotify-idx-count (1+ count))
               (dired-fnotify-revert-buffers fd)))))))

(defun dired-fnotify-schedule-restart (dir)
  (run-with-timer dired-fnotify-restart-idle-delay nil
                  'dired-fnotify-restart dir))


(defun dired-fnotify-add-dired-watch ()
  (let ((buffer (current-buffer))
        elt buflist)
    (mapc (lambda (dir)
            (setq dir (expand-file-name (car dir)))
            (let* ((dvec (dired-fnotify-create-watch dir))
                   (buflist (aref dvec dired-fnotify-idx-buffers)))
              (unless (memq buffer buflist)
                (aset dvec dired-fnotify-idx-buffers
                      (cons buffer buflist)))))
      dired-subdir-alist)))

(defun dired-fnotify-gc-dired-watch ()
  (when (eq major-mode 'dired-mode)
    (let ((buffer (current-buffer)))
      (mapc (lambda (elt)
              (let* ((dvec (cdr elt))
                     (buflist (delq buffer
                                    (aref dvec dired-fnotify-idx-buffers))))
                (if (null buflist)
                    (dired-fnotify-remove-watch (car elt))
                  (aset dvec dired-fnotify-idx-buffers buflist))))
        dired-fnotify-descriptor-alist))))

;;;###autoload
(define-minor-mode dired-fnotify-mode
  "Auto-refresh dired buffer whenever a filesystem change in the current directory occurs."
  :group      'dired
  :global     nil
  :lighter    " Fnotify"
  :init-value nil
  (when (eq major-mode 'dired-mode)
    (cond
     (dired-fnotify-mode
      (add-hook 'dired-after-readin-hook 'dired-fnotify-add-dired-watch nil t)
      (add-hook 'kill-buffer-hook        'dired-fnotify-gc-dired-watch  nil t)
      (dired-fnotify-add-dired-watch)
      (dired-fnotify-revert-buffers (current-buffer)))
     (t
      (remove-hook 'dired-after-readin-hook 'dired-fnotify-add-dired-watch t)
      (remove-hook 'kill-buffer-hook        'dired-fnotify-gc-dired-watch  t)
      (dired-fnotify-gc-dired-watch)))))

(provide 'dired-fnotify)

;;; dired-fnotify.el ends here.