branch: externals/dtache
commit d0ec7b9777575153f0c34ebb27fddb72d6ba9cda
Author: Niklas Eklund <niklas.ekl...@posteo.net>
Commit: Niklas Eklund <niklas.ekl...@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)))))
