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