[elpa] externals/dtache 81d7fbcdca 082/158: Integrate dtache with start-process

[ELPA Syncer]

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

    Integrate dtache with start-process
    
    This patch opens up the possibility for users to conveniently enable
    dtache for specific commands.
---
 README.org        | 23 ++++++++++++++++-------
 dtache-compile.el | 41 +++++++++++++++++++----------------------
 dtache.el         | 42 +++++++++++++++++++++++++++++++++---------
 3 files changed, 68 insertions(+), 38 deletions(-)

diff --git a/README.org b/README.org
index 59def66344..a04eed7d51 100644
--- a/README.org
+++ b/README.org
@@ -313,16 +313,25 @@ The =dtache= package supports 
[[https://www.gnu.org/software/emacs/manual/html_n
 #+end_src
 ** Enhance a command with dtache
 
-A part from the extensions provided with this package the users of =dtache= 
can leverage the package to instruct other commands to use =dtache=. Here is an 
example where the package =dired-rsync= is modified to utilize =dtache=.
+A part from the extensions provided with this package the users of =dtache= 
can leverage the package to instruct other commands to use =dtache=. Here is an 
example with a command from the package 
[[https://github.com/stsquad/dired-rsync][dired-rsync]].
 
 #+begin_src elisp
-  (defun my/dtache-dired-rsync-advice (orig-fun &rest args)
-    "Always run `dired-rsync' with `dtache'."
-    (pcase-let* ((`(,command ,details) args)
-                 (dtache--dtach-mode 'new))
-      (apply orig-fun `(,(dtache-dtach-command command t) ,details))))
+  (defun my/dtache-dired-rsync ()
+    "Run `dired-rsync' with `dtache'."
+    (interactive)
+    (let* ((dtache-enabled t)
+           (dtache--dtach-mode 'new))
+      (call-interactively #'dired-rsync)))
+#+end_src
+
+Or enhancing the built in =dired-do-async-shell-command=.
 
-  (advice-add #'dired-rsync--do-run :around #'my/dtache-dired-rsync-advice)
+#+begin_src elisp
+  (defun my/dtache-dired-do-async-shell-command ()
+    (interactive)
+    (let* ((dtache-enabled t)
+           (dtache--dtach-mode 'create))
+      (call-interactively #'dired-do-async-shell-command)))
 #+end_src
 
 * Versions
diff --git a/dtache-compile.el b/dtache-compile.el
index 301e54b3b5..a3200ab8f3 100644
--- a/dtache-compile.el
+++ b/dtache-compile.el
@@ -30,8 +30,6 @@
 
 ;;;; Variables
 
-(defvar dtache-compile-command nil
-  "This variable has value t if `compile' is supposed to run with `dtache'.")
 (defvar dtache-compile-session-action '(:attach dtache-compile-attach :view 
dtache-compile-session))
 
 ;;;; Commands
@@ -41,7 +39,7 @@
   "Run COMMAND through `compile' but in a 'dtache' session.
 Optionally enable COMINT if prefix-argument is provided."
   (interactive)
-  (let* ((dtache-compile-command t)
+  (let* ((dtache-enabled t)
          (dtache-session-action dtache-compile-session-action)
          (dtache-session-type 'compile)
          (dtache--dtach-mode 'create))
@@ -52,7 +50,7 @@ Optionally enable COMINT if prefix-argument is provided."
   "Re-compile by running `compile' but in a 'dtache' session.
 Optionally EDIT-COMMAND."
   (interactive)
-  (let* ((dtache-compile-command t)
+  (let* ((dtache-enabled t)
          (dtache-session-action dtache-compile-session-action)
          (dtache-session-type 'compile)
          (dtache--dtach-mode 'create))
@@ -62,25 +60,24 @@ Optionally EDIT-COMMAND."
 
 (defun dtache-compile-advice (compilation-start &rest args)
   "Optionally create a `dtache' session before running COMPILATION-START with 
ARGS."
-  (if (not dtache-compile-command)
-      (apply compilation-start args)
-    (pcase-let ((`(,command ,mode ,_ ,highlight-regexp) args)
-                (buffer-name "*dtache-compilation*"))
-      (if (and (not (eq dtache--dtach-mode 'attach))
-               (dtache-redirect-only-p command))
-          (dtache-start-session command t)
-        (cl-letf* ((name-function (lambda (_) buffer-name))
-                   (dtache--current-session (or dtache--current-session
-                                                (dtache-create-session 
command)))
-                   (dtache-command (dtache-dtach-command 
dtache--current-session t)))
-          (apply compilation-start `(,dtache-command
-                                     ,(or mode 'dtache-compilation-mode)
-                                     ,name-function
-                                     ,highlight-regexp)))))))
+  (if dtache-enabled
+      (pcase-let ((`(,command ,mode ,_ ,highlight-regexp) args)
+                  (buffer-name "*dtache-compilation*"))
+        (if (and (not (eq dtache--dtach-mode 'attach))
+                 (dtache-redirect-only-p command))
+            (dtache-start-session command t)
+          (cl-letf* ((name-function (lambda (_) buffer-name))
+                     (dtache--current-session (or dtache--current-session
+                                                  (dtache-create-session 
command))))
+            (apply compilation-start `(,command
+                                       ,(or mode 'dtache-compilation-mode)
+                                       ,name-function
+                                       ,highlight-regexp)))))
+    (apply compilation-start args)))
 
 (defun dtache-compile-maybe-start (_proc)
   "Maybe run when compilation starts."
-  (when dtache-compile-command
+  (when dtache-enabled
     (setq dtache--buffer-session dtache--current-session)
     (dtache-compile--replace-modesetter)
     (add-hook 'comint-preoutput-filter-functions 
#'dtache--dtache-env-message-filter 0 t)
@@ -89,10 +86,10 @@ Optionally EDIT-COMMAND."
 (defun dtache-compile-attach (session)
   "Attach to SESSION with `compile'."
   (when (dtache-valid-session session)
-    (let* ((dtache-compile-command t)
+    (let* ((dtache-enabled t)
            (dtache--dtach-mode 'attach)
            (dtache--current-session session))
-      (compilation-start nil))))
+      (compilation-start (dtache--session-command session)))))
 
 (defun dtache-compile-open (session)
   "Open SESSION with `dtache-compile'."
diff --git a/dtache.el b/dtache.el
index e3dd277203..93088bbfb1 100644
--- a/dtache.el
+++ b/dtache.el
@@ -81,11 +81,11 @@
   "An alist of annotators for metadata.")
 (defvar dtache-timer-configuration '(:seconds 10 :repeat 60 :function 
run-with-timer)
   "A property list defining how often to run a timer.")
-
 (defvar dtache-session-action nil
   "A property list of actions for a session.")
 (defvar dtache-shell-command-action '(:attach dtache-shell-command-attach 
:view dtache-view-dwim)
   "Actions for a session created with `dtache-shell-command'.")
+(defvar dtache-enabled nil)
 
 (defvar dtache-annotation-format
   `((:width 3 :function dtache--active-str :face dtache-active-face)
@@ -446,17 +446,17 @@ Optionally SUPPRESS-OUTPUT."
                (dtache-redirect-only-p command)))
       (let* ((inhibit-message t)
              (dtache--dtach-mode 'new)
-             (dtach-command (dtache-dtach-command command)))
-        (apply #'start-file-process
-               `("dtache" nil ,dtache-dtach-program ,@dtach-command)))
+             (dtache--current-session (dtache-create-session command)))
+        (apply #'start-file-process-shell-command
+               `("dtache" nil ,command)))
     (cl-letf* ((inhibit-message t)
                ((symbol-function #'set-process-sentinel) #'ignore)
                (dtache--dtach-mode (or dtache--dtach-mode 'create))
                (buffer "*Dtache Shell Command*")
-               (session (or dtache--current-session (dtache-create-session 
command)))
-               (dtach-command (dtache-dtach-command session t)))
-      (funcall #'async-shell-command dtach-command buffer)
-      (with-current-buffer buffer (setq dtache--buffer-session session)))))
+               (dtache--current-session (or dtache--current-session 
(dtache-create-session command)))
+               (dtache-enabled t))
+      (funcall #'async-shell-command command buffer)
+      (with-current-buffer buffer (setq dtache--buffer-session 
dtache--current-session)))))
 
 (defun dtache-update-sessions ()
   "Update `dtache' sessions.
@@ -554,6 +554,9 @@ Optionally make the path LOCAL to host."
                  (seq-filter #'dtache--session-active)
                  (seq-do #'dtache-start-session-monitor))
 
+    ;; Advices
+    (advice-add #'start-process :around #'dtache-start-process-advice)
+
     ;; Add `dtache-shell-mode'
     (add-hook 'shell-mode-hook #'dtache-shell-mode)))
 
@@ -627,7 +630,7 @@ If session is not valid trigger an automatic cleanup on 
SESSION's host."
   (when (dtache-valid-session session)
     (let* ((dtache--current-session session)
            (dtache--dtach-mode 'attach))
-      (dtache-start-session nil))))
+      (dtache-start-session (dtache--session-command session)))))
 
 (defun dtache-delete-sessions ()
   "Delete all `dtache' sessions."
@@ -636,6 +639,27 @@ If session is not valid trigger an automatic cleanup on 
SESSION's host."
 
 ;;;;; Other
 
+(defun dtache-start-process-advice (start-process-fun name buffer &rest args)
+  "Optionally make `start-process' use `dtache'."
+  (if dtache-enabled
+      (with-connection-local-variables
+       (let* ((command
+               (string-remove-prefix
+                ;; If start-process called from e.g. 
`start-file-process-shell-command'
+                ;; we need to strip the shell command and switch at the start.
+                (format (format "%s %s " shell-file-name shell-command-switch))
+                (string-join args " ")))
+              (dtache--current-session
+               (if (and dtache--current-session
+                        (string=
+                         (dtache--session-command dtache--current-session)
+                         command))
+                   dtache--current-session
+                 (dtache-create-session command)))
+              (dtach-command `(,dtache-dtach-program ,@(dtache-dtach-command 
dtache--current-session))))
+         (apply start-process-fun `(,name ,buffer ,@dtach-command))))
+    (apply start-process-fun `(,name ,buffer ,@args))))
+
 (defun dtache-start-session-monitor (session)
   "Start to monitor SESSION activity."
   (if (file-remote-p (dtache--session-working-directory session))