[elpa] externals/dtache d0ec7b9777 156/158: Add support for filenotify on macOS

[ELPA Syncer]

branch: externals/dtache
commit d0ec7b9777575153f0c34ebb27fddb72d6ba9cda
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>

    Add support for filenotify on macOS
    
    The package has been rewritten to watch for changes to the session
    directories in order to detect when a session socket is
    deleted. Previously the sockets was watched individually.
    
    This change allows dtache to fully support users on macOS, which it
    previously couldn't.
---
 CHANELOG.org        |   1 +
 README.org          |   4 ++
 dtache.el           | 113 ++++++++++++++++++++++++----------------------------
 test/dtache-test.el |   6 +--
 4 files changed, 61 insertions(+), 63 deletions(-)

diff --git a/CHANELOG.org b/CHANELOG.org
index 50eca3a1e9..1c23e826f0 100644
--- a/CHANELOG.org
+++ b/CHANELOG.org
@@ -4,6 +4,7 @@
 
 * Development
 
+- =dtache= now has full on macOS. The previous issue of not being able to 
utilize =filenotify= has been resolved.
 - =dtache= now uses =notifications= library to issue notifications by default.
 - =dtache= now uses =filenotify= for notifications except on local macOS hosts.
 
diff --git a/README.org b/README.org
index 13383fadef..ac9c899bcb 100644
--- a/README.org
+++ b/README.org
@@ -345,3 +345,7 @@ I have signed the papers for a 
[[https://www.gnu.org/software/emacs/manual/html_
 * Credits
 
 I got inspired when reading about =Ambrevar's= pursuits on 
[[https://ambrevar.xyz/emacs-eshell/][using eshell as his main shell]]. I 
discovered his 
[[https://github.com/Ambrevar/dotfiles/blob/master/.emacs.d/lisp/package-eshell-detach.el][package-eshell-detach]]
 which got me into the idea of using =dtach= as a base for detached shell 
commands.
+
+[[https://gitlab.com/ntdef][Troy de Freitas]] for solving the problem of 
getting =dtache= to work with =filenotify= on macOS.
+
+
diff --git a/dtache.el b/dtache.el
index f36d4289a9..1961d592e9 100644
--- a/dtache.el
+++ b/dtache.el
@@ -74,11 +74,6 @@
   :type 'string
   :group 'dtache)
 
-(defcustom dtache-timer-configuration '(:seconds 10 :repeat 60 :function 
run-with-timer)
-  "A property list defining how often to run a timer."
-  :type 'plist
-  :group 'dtache)
-
 (defcustom dtache-env nil
   "The name of, or path to, the `dtache' environment script."
   :type 'string
@@ -211,6 +206,8 @@ This version is encoded as [package-version].[revision].")
   "Sessions are initialized.")
 (defvar dtache--sessions nil
   "A list of sessions.")
+(defvar dtache--watched-session-directories nil
+  "An alist where values are a (directory . descriptor).")
 (defvar dtache--buffer-session nil
   "The `dtache-session' session in current buffer.")
 (defvar dtache--current-session nil
@@ -514,12 +511,12 @@ compilation or `shell-command' the command will also kill 
the window."
                                   :time `(:start ,(time-to-seconds 
(current-time)) :end 0.0 :duration 0.0 :offset 0.0)
                                   :status 'unknown
                                   :log-size 0
-                                  :directory (file-name-as-directory 
dtache-session-directory)
+                                  :directory (concat (file-remote-p 
default-directory) dtache-session-directory)
                                   :host (dtache--host)
                                   :metadata (dtache-metadata)
                                   :state 'active)))
      (dtache--db-insert-entry session)
-     (dtache--start-session-monitor session)
+     (dtache--watch-session-directory (dtache--session-directory session))
      session)))
 
 (defun dtache-start-session (command &optional suppress-output)
@@ -595,13 +592,15 @@ Optionally SUPPRESS-OUTPUT."
                   (dtache--update-session session))))
             (dtache--db-get-sessions))
 
-    ;; Start monitors
+    ;; Watch session directories
     (thread-last (dtache--db-get-sessions)
                  (seq-filter (lambda (it) (eq 'active (dtache--session-state 
it))))
                  (seq-remove (lambda (it) (when (dtache--session-missing-p it)
                                             (dtache--db-remove-entry it)
                                             t)))
-                 (seq-do #'dtache--start-session-monitor))
+                 (seq-map #'dtache--session-directory)
+                 (seq-uniq)
+                 (seq-do #'dtache--watch-session-directory))
 
     ;; Add `dtache-shell-mode'
     (add-hook 'shell-mode-hook #'dtache-shell-mode)))
@@ -820,36 +819,6 @@ Optionally CONCAT the command return command into a 
string."
      "")
    "\n"))
 
-(defun dtache--session-timer-monitor (session)
-  "Configure a timer to monitor SESSION activity.
-The timer object is configured according to `dtache-timer-configuration'."
-  (with-connection-local-variables
-   (let* ((timer)
-          (callback
-           (lambda ()
-             (when (dtache--state-transition-p session)
-               (setf (dtache--session-time session)
-                     (dtache--update-session-time session t))
-               (dtache--session-state-transition-update session)
-               (cancel-timer timer)))))
-     (setq timer
-           (funcall (plist-get dtache-timer-configuration :function)
-                    (plist-get dtache-timer-configuration :seconds)
-                    (plist-get dtache-timer-configuration :repeat)
-                    callback)))))
-
-(defun dtache--session-filenotify-monitor (session)
-  "Configure `filenotify' to monitor SESSION activity."
-  (file-notify-add-watch
-   (dtache--session-file session 'socket)
-   '(change)
-   (lambda (event)
-     (pcase-let ((`(,_ ,action ,_) event))
-       (when (eq action 'deleted)
-         (setf (dtache--session-time session)
-               (dtache--update-session-time session))
-         (dtache--session-state-transition-update session))))))
-
 (defun dtache--session-deduplicate (sessions)
   "Make car of SESSIONS unique by adding an identifier to it."
   (let* ((ht (make-hash-table :test #'equal :size (length sessions)))
@@ -865,12 +834,6 @@ The timer object is configured according to 
`dtache-timer-configuration'."
         (setcar session (format "%s%s" (car session) (make-string 
identifier-width ?\s)))))
     (seq-reverse reverse-sessions)))
 
-(defun dtache--session-macos-monitor (session)
-  "Configure a timer to monitor SESSION activity on macOS."
-  (let ((dtache-timer-configuration
-         '(:seconds 0.5 :repeat 0.5 :function run-with-idle-timer)))
-    (dtache--session-timer-monitor session)))
-
 (defun dtache--decode-session (item)
   "Return the session assicated with ITEM."
   (cdr (assoc item dtache--session-candidates)))
@@ -914,13 +877,11 @@ Optionally make the path LOCAL to host."
            (pcase file
              ('socket ".socket")
              ('log ".log"))))
-         (remote (file-remote-p (dtache--session-working-directory session)))
-         (directory (concat
-                     remote
-                     (dtache--session-directory session))))
-    (if (and local remote)
-        (string-remove-prefix remote (expand-file-name file-name directory))
-      (expand-file-name file-name directory))))
+         (remote-local-path (file-remote-p (expand-file-name file-name 
(dtache--session-directory session)) 'localname))
+         (full-path (expand-file-name file-name (dtache--session-directory 
session))))
+    (if (and local remote-local-path)
+        remote-local-path
+      full-path)))
 
 (defun dtache--cleanup-host-sessions (host)
   "Run cleanuup on HOST sessions."
@@ -1131,14 +1092,46 @@ log to deduce the end time."
   "Remove `dtache--dtach-detached-message' in STR."
   (replace-regexp-in-string (format "\n?%s\n" dtache--dtach-detached-message) 
"" str))
 
-(defun dtache--start-session-monitor (session)
-  "Start to monitor SESSION activity."
-  (let ((default-directory (dtache--session-working-directory session)))
-    (if (and (not(file-remote-p default-directory))
-             (eq system-type 'darwin))
-        ;; macOS requires a timer based solution
-        (dtache--session-macos-monitor session)
-      (dtache--session-filenotify-monitor session))))
+(defun dtache--watch-session-directory (session-directory)
+  "Watch for events in SESSION-DIRECTORY."
+  (unless (alist-get session-directory dtache--watched-session-directories
+                     nil nil #'string=)
+    (push
+     `(,session-directory . ,(file-notify-add-watch
+                              session-directory
+                              '(change)
+                              #'dtache--session-directory-event))
+     dtache--watched-session-directories)))
+
+(defun dtache--session-directory-event (event)
+  "Act on an EVENT in a directory in `dtache--watched-session-directories'.
+
+If event is caused by the deletion of a socket, locate the related
+session and trigger a state transition."
+  (pcase-let* ((`(,_ ,action ,file) event))
+    (when (and (eq action 'deleted)
+               (string= "socket" (file-name-extension file)))
+      (let* ((id (intern (file-name-base file)))
+             (session (dtache--db-get-session id))
+             (session-directory (dtache--session-directory session)))
+
+        ;; Update session
+        (setf (dtache--session-time session)
+              (dtache--update-session-time session))
+        (dtache--session-state-transition-update session)
+
+        ;; Remove session directory from `dtache--watch-session-directory'
+        ;; if there is no active session associated with the directory
+        (unless
+            (thread-last (dtache--db-get-sessions)
+                         (seq-filter (lambda (it) (eq 'active 
(dtache--session-state it))))
+                         (seq-map #'dtache--session-directory)
+                         (seq-uniq)
+                         (seq-filter (lambda (it) (string= it 
session-directory))))
+          (file-notify-rm-watch
+           (alist-get session-directory dtache--watched-session-directories))
+          (setq dtache--watched-session-directories
+                (assoc-delete-all session-directory 
dtache--watched-session-directories)))))))
 
 ;;;;; UI
 
diff --git a/test/dtache-test.el b/test/dtache-test.el
index bb8e58b422..68822aadae 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -112,15 +112,15 @@
 (ert-deftest dtache-test-session-file ()
   ;; Local files
   (cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory) 
(concat directory file)))
-             ((symbol-function #'file-remote-p) (lambda (_directory) nil))
+             ((symbol-function #'file-remote-p) (lambda (_directory 
_localname) "/home/user/tmp"))
              (session (dtache--session-create :id 's12345 :directory 
"/home/user/tmp/")))
     (should (string= "/home/user/tmp/s12345.log" (dtache--session-file session 
'log)))
     (should (string= "/home/user/tmp/s12345.socket" (dtache--session-file 
session 'socket))))
 
   ;; Remote files
   (cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory) 
(concat directory file)))
-             ((symbol-function #'file-remote-p) (lambda (_directory) 
"/ssh:foo:"))
-             (session (dtache--session-create :id 's12345 :directory 
"/home/user/tmp/")))
+             ((symbol-function #'file-remote-p) (lambda (_directory 
_localname) "/ssh:foo:/home/user/tmp/"))
+             (session (dtache--session-create :id 's12345 :directory 
"/ssh:foo:/home/user/tmp/")))
     (should (string= "/ssh:foo:/home/user/tmp/s12345.log" 
(dtache--session-file session 'log)))
     (should (string= "/ssh:foo:/home/user/tmp/s12345.socket" 
(dtache--session-file session 'socket)))))