emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/dtache 884bf8e44d 072/158: Improve dtache function


From: ELPA Syncer
Subject: [elpa] externals/dtache 884bf8e44d 072/158: Improve dtache function
Date: Wed, 19 Jan 2022 18:57:59 -0500 (EST)

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

    Improve dtache function
    
    This patch contains multiple additions to dtache:
    - dtache-compile.el is introduced
    - a universal detach command is added
    - attach functions for shell-command/compile are added
    - dwim command is improved with dtache-type-open-dispatch
---
 CHANELOG.org        |   3 ++
 README.org          |  64 +++++++++--------------
 dtache-compile.el   | 144 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 dtache-eshell.el    |  16 ++++--
 dtache-shell.el     |   7 +--
 dtache.el           | 129 ++++++++++++++++++++++++++++++++--------------
 test/dtache-test.el |  39 ++++++++------
 7 files changed, 302 insertions(+), 100 deletions(-)

diff --git a/CHANELOG.org b/CHANELOG.org
index 94e7becad3..21b066228f 100644
--- a/CHANELOG.org
+++ b/CHANELOG.org
@@ -4,6 +4,9 @@
 
 * Development
 
+- Add dtache-type-open-dispatch variable for users to customize how to open a 
function which doesn't have an open function implemented. This together with 
the new attach functions for shell-command/compile makes it possible to 
seamlessly reattach to sessions started with shell-command/compile.
+- Add a generic detach command, =dtache-detach-session=. This command is 
supposed to be used to detach from sessions in all supported modes.
+- Add =dtache-compile.el=. This library provides commands =dtache-compile= and 
=dtache-compile-recompile= which are supposed to be used instead of 
=compile=/=recompile=.
 - Improve =dtache-shell-command=, the command is now very similar to 
=async-shell-command= and can be considered a replacement of the latter.
 - Add integration with the =consult= package through =dtache-consult.el=.
 - Add support for =eshell= through the =dtache-eshell= package.
diff --git a/README.org b/README.org
index 780fb1f65f..8387cba06f 100644
--- a/README.org
+++ b/README.org
@@ -58,6 +58,9 @@ A minimal configuration for =dtache=.
 #+begin_src elisp :lexical t :results none
   (use-package dtache
     :hook (after-init . dtache-initialize)
+    :bind (([remap async-shell-command] . dtache-shell-command)
+           :map dtache-shell-mode-map
+           ("C-c C-q" . dtache-detach-session))
     :config
     (setq dtache-db-directory user-emacs-directory)
     (setq dtache-session-directory (expand-file-name "dtache" 
(temporary-file-directory))))
@@ -76,7 +79,7 @@ There are tree different ways to create a dtache session.
 
 The =dtache-shell-command= is for the Emacs users that are accustomed to 
running shell commands from =M-x shell-command= or =M-x async-shell-command=. 
The =dtache-start-session= is supposed to be called from custom user functions, 
or for other packages to integrate towards. The user can also choose to 
override built in functions with it, for example =compile=. Lastly there is the 
=dtache-shell-create-session= command which is supposed to be bound to a key. 
It is a command that the user c [...]
 
-To detach from a session you started with =dtache-shell-command= you should 
bind the command =dtache-shell-detach= to something convenient in the 
=dtache-shell-mode-map=.
+To detach from a session you started with =dtache-shell-command= you should 
bind the command =dtache-detach-session= to something convenient in the 
=dtache-shell-mode-map=.
 
 ** Interacting with a session
 
@@ -118,10 +121,9 @@ A =use-package= configuration of the =dtache-shell= 
package. This package provid
 #+begin_src elisp :lexical t :results none
   (use-package dtache-shell
     :hook (after-init . dtache-shell-setup)
-    :general
-    (:keymaps 'dtache-shell-mode-map
-              "<S-return>" #'dtache-shell-create-session
-              "<C-return>" #'dtache-shell-attach)
+    :bind (:map dtache-shell-mode-map
+           (("<S-return>" . dtache-shell-create-session)
+            ("<C-return>" . dtache-shell-attach)))
     :config
     (setq dtache-shell-history-file "~/.bash_history"))
 #+end_src
@@ -133,7 +135,7 @@ These are commands that the package provides and which the 
user is expected to b
 | dtache-shell-create | Create a session      |
 | dtache-shell-attach | Attach to a session   |
 
-To detach from a session use the command =dtache-shell-detach=. As instructed 
earlier you can bind this command in the =dtache-shell-mode-map=.
+To detach from a session use the command =dtache-detach-session=. As 
instructed earlier you can bind this command in the =dtache-shell-mode-map=.
 
 ** Dtache-eshell
 
@@ -142,10 +144,10 @@ A =use-package= configuration of the =dtache-eshell= 
package. This package provi
 #+begin_src elisp :lexical t :results none
   (use-package dtache-eshell
     :hook (after-init . dtache-eshell-setup)
-    :general
-    (:keymaps 'dtache-eshell-mode-map
-              "<S-return>" #'dtache-eshell-create-session
-              "<C-return>" #'dtache-eshell-attach))
+    :bind (:map dtache-eshell-mode-map
+           (("<S-return>" . dtache-eshell-create-session)
+            ("<C-return>" . dtache-eshell-attach)
+            ("C-c C-q" . dtache-detach-session))))
 #+end_src
 
 These are commands that the package provides and which the user is expected to 
bind to convenient keys. The package provides a minor mode that will be enabled 
in =eshell=.
@@ -157,6 +159,19 @@ These are commands that the package provides and which the 
user is expected to b
 
 To detach from a session simply use =C-c C-c=. In this 
[[https://niklaseklund.gitlab.io/blog/posts/dtache_eshell/][blog post]] there 
are examples and more information about the extension.
 
+** TODO Compile
+
+Add text here.
+
+#+begin_src elisp
+  (use-package dtache-compile
+    :hook (after-init . dtache-compile-setup)
+    :bind (([remap compile] . dtache-compile)
+           ([remap recompile] . dtache-compile-recompile)
+           :map dtache-compilation-mode-map
+           ("C-c C-q" . dtache-detach-session)))
+#+end_src
+
 ** Consult
 
 A =use-package= configuration of the =dtache-consult= package. This package 
provides the integration with the [[https://github.com/minad/consult][consult]] 
package.
@@ -292,35 +307,6 @@ The =dtache= package supports 
[[https://www.gnu.org/software/emacs/manual/html_n
    '(:application tramp :protocol "ssh") 'remote-dtache)
 #+end_src
 
-** Replace compile with dtache
-*** Unconditionally
-
-=Dtache= can be seen as a replacement for =compile=. To unconditionally 
replace the latter with the former one can apply this advice.
-
-#+begin_src elisp :lexical t :results none
-  (defun my/dtache-compile-override (command &optional _)
-    "Run COMMAND with `dtache'."
-    (dtache-start-session command))
-
-  (advice-add 'compile :override #'my/dtache-compile-override)
-#+end_src
-
-*** Selectively
-
-Maybe you like the behavior of =compile= but for some specific commands you 
would like to replace the usage of =compile= with =dtache=. That can be done 
with the following advice, in this case replacing the usage of =compile= within 
function =foo=.
-
-#+begin_src elisp :lexical t :results none
-  (defun my/dtache-replace-compile-advice (orig-fun &rest args)
-    "Replace `compile' with `dtache'.
-  This is done before ORIG-FUN is passed ARGS."
-    (cl-letf* (((symbol-function 'compile)
-                (lambda (command &optional _)
-                  (dtache-start-session command))))
-      (apply orig-fun args)))
-
-  (advice-add #'foo :around #'my/dtache-replace-compile-advice)
-#+end_src
-
 ** Customize an individual session
 
 =Dtache= tries to leave possibilities for the users to customize the usage. 
One key feature is that the customization can happen on session level. Meaning 
that the user can choose to customize a session right before it is started. The 
customization will then be embedded into the session object and persist for as 
long as the session exists.
diff --git a/dtache-compile.el b/dtache-compile.el
new file mode 100644
index 0000000000..2fef2a6b9a
--- /dev/null
+++ b/dtache-compile.el
@@ -0,0 +1,144 @@
+;;; dtache-compile.el --- Dtache integration with compile -*- lexical-binding: 
t -*-
+
+;; Copyright (C) 2022 Niklas Eklund
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package integrates `dtache' with `compile'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'compile)
+(require 'dtache)
+
+;;;; Variables
+
+(defvar dtache-compile-command nil
+  "This variable has value t if `compile' is supposed to run with `dtache'.")
+(defvar dtache-compile-history nil
+  "History of commands run with `dtache-compile'.")
+
+;;;; Commands
+
+;;;###autoload
+(defun dtache-compile ()
+  "Run COMMAND through `compile' but in a 'dtache' session.
+Optionally enable COMINT if prefix-argument is provided."
+  (interactive)
+  (let* ((dtache-compile-command t)
+         (dtache-session-type 'compile)
+         (dtache--dtach-mode 'create))
+    (call-interactively #'compile)))
+
+;;;###autoload
+(defun dtache-compile-recompile (&optional edit-command)
+  "Re-compile by running `compile' but in a 'dtache' session.
+Optionally EDIT-COMMAND."
+  (interactive)
+  (let* ((dtache-compile-command t)
+         (dtache-session-type 'compile)
+         (dtache--dtach-mode 'create))
+    (recompile edit-command)))
+
+;;;###autoload
+(defun dtache-compile-attach (session)
+  "Attach to SESSION with `compile'."
+  (interactive
+   (list (dtache-completing-read (dtache-get-sessions))))
+  (let* ((dtache-compile-command t)
+         (dtache--dtach-mode 'attach)
+         (dtache--current-session session))
+    (compilation-start nil)))
+
+;;;;; Functions
+
+(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)))))))
+
+(defun dtache-compile-maybe-start (_proc)
+  "Maybe run when compilation starts."
+  (when dtache-compile-command
+    (setq dtache--buffer-session dtache--current-session)
+    (dtache-compile--replace-modesetter)
+    (add-hook 'comint-preoutput-filter-functions 
#'dtache--dtache-env-message-filter 0 t)
+    (add-hook 'comint-preoutput-filter-functions 
#'dtache--dtach-eof-message-filter 0 t)))
+
+;;;###autoload
+(defun dtache-compile-setup ()
+  "Setup `dtache-compile'."
+  (advice-add #'compilation-start :around #'dtache-compile-advice)
+  (add-hook 'compilation-start-hook #'dtache-compile-maybe-start))
+
+;;;;; Support functions
+
+(defun dtache-compile--replace-modesetter ()
+  "Replace the modsetter inserted by `compilation-start'."
+  (save-excursion
+    (let ((buffer-read-only nil)
+          (regexp (rx (regexp "^dtach ") (or "-c" "-a") (regexp 
".*\.socket.*$"))))
+      (goto-char (point-min))
+      (when (re-search-forward regexp nil t)
+        (kill-region (match-beginning 0) (match-end 0))
+        (insert (dtache--session-command dtache--current-session))))))
+
+(defun dtache-compile--compilation-dtache-filter ()
+  "Filter to modify the output in a compilation buffer."
+  (let ((begin compilation-filter-start)
+        (end (copy-marker (point))))
+    (save-excursion
+      (goto-char begin)
+      (when (re-search-forward "\n?Dtache session.*\n?" end t)
+        (delete-region (match-beginning 0) (match-end 0))))))
+
+(defun dtache-compile--compilation-eof-filter ()
+  "Filter to modify the output in a compilation buffer."
+  (let ((begin compilation-filter-start)
+        (end (copy-marker (point))))
+    (save-excursion
+      (goto-char begin)
+      (when (re-search-forward (format "\n?%s\n" dtache--dtach-eof-message) 
end t)
+        (delete-region (match-beginning 0) (match-end 0))))))
+
+;;;;; Major modes
+
+;;;###autoload
+(define-derived-mode dtache-compilation-mode compilation-mode "Dtache 
Compilation"
+  "Major mode for tailing dtache logs."
+  (add-hook 'compilation-filter-hook #'dtache-compile--compilation-eof-filter 
0 t)
+  (add-hook 'compilation-filter-hook 
#'dtache-compile--compilation-dtache-filter 0 t))
+
+(provide 'dtache-compile)
+
+;;; dtache-compile.el ends here
diff --git a/dtache-eshell.el b/dtache-eshell.el
index 3f2a7232d0..ba2ad76bf5 100644
--- a/dtache-eshell.el
+++ b/dtache-eshell.el
@@ -59,10 +59,18 @@
            (command (mapconcat #'identity
                                `(,eshell-last-command-name
                                  ,@eshell-last-arguments)
-                               " ")))
-      (setq eshell-last-arguments (dtache-dtach-command command)))
+                               " "))
+           (session (dtache-create-session command)))
+      (setq eshell-last-arguments (dtache-dtach-command session))
+      (setq dtache--buffer-session session))
     (setq eshell-last-command-name "dtach")))
 
+(defun dtache-eshell-get-dtach-process ()
+  "Return `eshell' process if `dtache' is running."
+  (when-let* ((process (and eshell-process-list (caar eshell-process-list))))
+    (and (string= (process-name process) "dtach")
+         process)))
+
 ;;;; Commands
 
 ;;;###autoload
@@ -82,9 +90,8 @@ If prefix-argument directly DETACH from the session."
   (interactive
    (list (dtache-eshell-select-session)))
   (cl-letf* ((dtache--dtach-mode 'attach)
-             (socket (dtache-session-file session 'socket t))
              (input
-              (format "%s %s %s" dtache-dtach-program (dtache--dtach-arg) 
socket))
+              (dtache-dtach-command session t))
              ((symbol-function #'eshell-add-to-history) #'ignore))
     (eshell-kill-input)
     ;; Hide the input from the user
@@ -94,6 +101,7 @@ If prefix-argument directly DETACH from the session."
       (setq end (point))
       (overlay-put (make-overlay begin end) 'invisible t)
       (insert " "))
+    (setq dtache--buffer-session session)
     (call-interactively #'eshell-send-input)))
 
 ;;;; Minor mode
diff --git a/dtache-shell.el b/dtache-shell.el
index d9481f4a24..1ba19a4b10 100644
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -102,6 +102,7 @@ cluttering the comint-history with dtach commands."
       (cl-letf ((dtache-shell--current-session session)
                 (comint-input-sender #'dtache-shell--attach-input-sender)
                 ((symbol-function 'comint-add-to-input-history) (lambda (_) 
t)))
+        (setq dtache--buffer-session session)
         (comint-kill-input)
         (comint-send-input))
     (dtache-open-session session)))
@@ -111,9 +112,8 @@ cluttering the comint-history with dtach commands."
 (defun dtache-shell--attach-input-sender (proc _string)
   "Attach to `dtache--session' and send the attach command to PROC."
   (let* ((dtache--dtach-mode 'attach)
-         (socket (dtache-session-file dtache-shell--current-session 'socket t))
          (input
-          (format "%s %s %s" dtache-dtach-program (dtache--dtach-arg) socket)))
+          (dtache-dtach-command dtache-shell--current-session t)))
     (comint-simple-send proc input)))
 
 (defun dtache-shell--create-input-sender (proc string)
@@ -131,7 +131,8 @@ cluttering the comint-history with dtach commands."
                    dtache-shell-new-block-list)
                   'create
                 dtache--dtach-mode))
-             (dtach-command (dtache-dtach-command (substring-no-properties 
string) t)))
+             (session (dtache-create-session (substring-no-properties string)))
+             (dtach-command (dtache-dtach-command session t)))
        (comint-simple-send proc dtach-command)
      (comint-simple-send proc string))))
 
diff --git a/dtache.el b/dtache.el
index 83077e8c41..cd67544df4 100644
--- a/dtache.el
+++ b/dtache.el
@@ -49,6 +49,8 @@
 (require 'simple)
 (require 'tramp)
 
+(declare-function dtache-eshell-get-dtach-process "dtache-eshell")
+
 ;;;; Variables
 
 (defvar dtache-session-directory nil
@@ -85,6 +87,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-type-open-dispatch '((shell-command . 
dtache-shell-command-attach)
+                                    (shell . dtache-shell-command-attach)
+                                    (eshell . dtache-shell-command-attach)
+                                    (compile . dtache-compile-attach))
+  "How to open an active session based on type.")
 
 (defvar dtache-annotation-format
   `((:width 3 :function dtache--active-str :face dtache-active-face)
@@ -162,9 +169,14 @@
   "Mode of operation for dtach.")
 (defvar dtache--sessions nil
   "A list of sessions.")
+(defvar dtache--buffer-session nil
+  "The `dtache-session' session in current buffer.")
+(defvar dtache--current-session nil
+  "The current session.")
+(make-variable-buffer-local 'dtache--buffer-session)
 (defvar dtache--session-candidates nil
   "An alist of session candidates.")
-(defconst dtache--dtach-eof-message "\\[EOF - dtach terminating\\]\^M"
+(defconst dtache--dtach-eof-message "\\[EOF - dtach terminating\\]"
   "Message printed when `dtach' terminates.")
 (defconst dtache--dtach-detached-message "\\[detached\\]\^M"
   "Message printed when detaching from `dtach'.")
@@ -207,7 +219,17 @@ If called with prefix-argument the output is suppressed."
                                              default-directory))
                           "Dtache shell command: ")
                         nil 'dtache-shell-command-history)))
-  (dtache-start-session command current-prefix-arg))
+  (let ((dtache-session-type 'shell-command))
+    (dtache-start-session command current-prefix-arg)))
+
+;;;###autoload
+(defun dtache-shell-command-attach (session)
+  "Attach to `dtache' SESSION."
+  (interactive
+   (list (dtache-completing-read (dtache-get-sessions))))
+  (let* ((dtache--current-session session)
+         (dtache--dtach-mode 'attach))
+    (dtache-start-session nil)))
 
 ;;;###autoload
 (defun dtache-open-session (session)
@@ -355,16 +377,32 @@ If called with prefix-argument the output is suppressed."
     (ediff-buffers buffer1 buffer2)))
 
 ;;;###autoload
-(defun dtache-shell-detach ()
-  "Detach from session."
+(defun dtache-detach-session ()
+  "Detach from current session.
+
+This command is only activated if `dtache--buffer-session' is set and
+`dtache--session-active-p' returns t."
   (interactive)
-  (let ((proc (get-buffer-process (current-buffer)))
-        (input dtache--dtach-detach-character))
-    (comint-simple-send proc input)
-    (when (string-match "\*Dtache Shell Command" (buffer-name))
-      (let ((kill-buffer-query-functions nil))
-        (kill-buffer-and-window)
-        (message "[detached]")))))
+  (if (dtache-session-p dtache--buffer-session)
+      (if (dtache--session-active-p dtache--buffer-session)
+          (if-let ((process (and (eq major-mode 'eshell-mode)
+                                 (dtache-eshell-get-dtach-process))))
+              (progn
+                (setq dtache--buffer-session nil)
+                (process-send-string process dtache--dtach-detach-character))
+            (let ((proc (get-buffer-process (current-buffer)))
+                  (input dtache--dtach-detach-character))
+              (comint-simple-send proc input)
+              (setq dtache--buffer-session nil)
+              (when
+                  (cond ((string-match "\*Dtache Shell Command" (buffer-name)) 
t)
+                        ((string-match "\*dtache-compilation" (buffer-name)) t)
+                        (t nil))
+                (let ((kill-buffer-query-functions nil))
+                  (kill-buffer-and-window)
+                  (message "[detached]")))))
+        (setq dtache--buffer-session nil))
+    (message "No `dtache-session' found in buffer.")))
 
 ;;;###autoload
 (defun dtache-quit-tail-output ()
@@ -408,19 +446,23 @@ nil before closing."
   "Start a `dtache' session running COMMAND.
 
 Optionally SUPPRESS-OUTPUT."
-  (if (or suppress-output
-          (dtache-redirect-only-p command))
+  (if (and (not (eq dtache--dtach-mode 'attach))
+           (or suppress-output
+               (dtache-redirect-only-p command)))
       (let* ((inhibit-message t)
              (dtache--dtach-mode 'new)
-             (dtach-command (dtache-dtach-command command)))
+             (session (dtache-create-session command))
+             (dtach-command (dtache-dtach-command session)))
         (apply #'start-file-process
                `("dtache" nil ,dtache-dtach-program ,@dtach-command)))
     (cl-letf* ((inhibit-message t)
                ((symbol-function #'set-process-sentinel) #'ignore)
-               (dtache-session-type 'standard)
-               (dtache--dtach-mode 'create)
-               (dtach-command (dtache-dtach-command command t)))
-      (funcall #'async-shell-command dtach-command "*Dtache Shell Command*"))))
+               (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)))))
 
 (defun dtache-update-sessions ()
   "Update `dtache' sessions.
@@ -564,7 +606,10 @@ Optionally make the path LOCAL to host."
 (defun dtache-open-dwim (session)
   "Open SESSION in a do what I mean fashion."
   (cond ((dtache--session-active session)
-         (dtache-tail-output session))
+         (if-let ((open-fun (alist-get
+                             (dtache--session-type session) 
dtache-type-open-dispatch)))
+             (funcall open-fun session)
+           (dtache-tail-output session)))
         ((eq 'success (dtache--session-status session))
          (dtache-open-output session))
         ((eq 'failure (dtache--session-status session))
@@ -588,27 +633,35 @@ Optionally make the path LOCAL to host."
         (dtache--session-macos-monitor session)
       (dtache--session-filenotify-monitor session))))
 
-(defun dtache-dtach-command (command &optional concat)
-  "Return a list of arguments to run COMMAND with dtach.
+(defun dtache-dtach-command (session &optional concat)
+  "Return a list of arguments to run SESSION.
 
 Optionally CONCAT the command return command into a string."
   (with-connection-local-variables
-   (let* ((session (dtache-create-session command))
-          (socket (dtache-session-file session 'socket t))
-          (dtache--dtach-mode (if (dtache--session-redirect-only session)
-                                  'new
-                                dtache--dtach-mode)))
-     (if concat
-         (mapconcat 'identity
-                    `(,dtache-dtach-program
-                      ,(dtache--dtach-arg)
-                      ,socket "-z"
-                      ,dtache-shell-program "-c"
-                      ,(shell-quote-argument (dtache--magic-command session)))
-                    " ")
-       `(,(dtache--dtach-arg) ,socket "-z"
-         ,dtache-shell-program "-c"
-         ,(dtache--magic-command session))))))
+   (let* ((dtache--dtach-mode (cond ((eq dtache--dtach-mode 'attach) 'attach)
+                                    ((dtache--session-redirect-only session) 
'new)
+                                    (t dtache--dtach-mode)))
+          (socket (dtache-session-file session 'socket t)))
+     (setq dtache--buffer-session session)
+     (if (eq dtache--dtach-mode 'attach)
+         (if concat
+             (mapconcat 'identity
+                        `(,dtache-dtach-program
+                          ,(dtache--dtach-arg)
+                          ,socket)
+                        " ")
+           `(,(dtache--dtach-arg) ,socket))
+       (if concat
+             (mapconcat 'identity
+                        `(,dtache-dtach-program
+                          ,(dtache--dtach-arg)
+                          ,socket "-z"
+                          ,dtache-shell-program "-c"
+                          ,(shell-quote-argument (dtache--magic-command 
session)))
+                        " ")
+           `(,(dtache--dtach-arg) ,socket "-z"
+             ,dtache-shell-program "-c"
+             ,(dtache--magic-command session)))))))
 
 (defun dtache-redirect-only-p (command)
   "Return t if COMMAND should run in degreaded mode."
@@ -924,7 +977,7 @@ the current time is used."
 
 (defun dtache--dtach-eof-message-filter (str)
   "Remove `dtache--dtach-eof-message' in STR."
-  (replace-regexp-in-string (format "\n?%s\n" dtache--dtach-eof-message) "" 
str))
+  (replace-regexp-in-string (format "\n?%s\^M\n" dtache--dtach-eof-message) "" 
str))
 
 (defun dtache--dtach-detached-message-filter (str)
   "Remove `dtache--dtach-detached-message' in STR."
diff --git a/test/dtache-test.el b/test/dtache-test.el
index 50d9b823fd..a56ce06f46 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -69,25 +69,32 @@
    (cl-letf* ((dtach-program "dtach")
               (dtache-env "dtache-env")
               (dtache-shell-program "bash")
-              (dtache--dtach-mode 'create)
               (session (dtache-create-session "ls -la"))
               ((symbol-function #'dtache-create-session)
                (lambda (_)
-                 session))
-              (expected `("-c" ,(dtache-session-file session 'socket t)
-                          "-z" ,dtache-shell-program
-                          "-c"
-                          ,(format "{ dtache-env ls\\ -la; } 2>&1 | tee %s"
-                                   (dtache-session-file session 'log t))))
-              (expected-concat (format "%s -c %s -z %s -c %s"
-                                       dtach-program
-                                       (dtache-session-file session 'socket t)
-                                       dtache-shell-program
-                                       (shell-quote-argument
-                                        (format "{ dtache-env ls\\ -la; } 2>&1 
| tee %s"
-                                                (dtache-session-file session 
'log t))))))
-     (should (equal expected (dtache-dtach-command "ls -la")))
-     (should (equal expected-concat (dtache-dtach-command "ls -la" t))))))
+                 session)))
+     (let* ((dtache--dtach-mode 'create)
+            (expected `("-c" ,(dtache-session-file session 'socket t)
+                        "-z" ,dtache-shell-program
+                        "-c"
+                        ,(format "{ dtache-env ls\\ -la; } 2>&1 | tee %s"
+                                 (dtache-session-file session 'log t))))
+            (expected-concat (format "%s -c %s -z %s -c %s"
+                                     dtach-program
+                                     (dtache-session-file session 'socket t)
+                                     dtache-shell-program
+                                     (shell-quote-argument
+                                      (format "{ dtache-env ls\\ -la; } 2>&1 | 
tee %s"
+                                              (dtache-session-file session 
'log t))))))
+       (should (equal expected (dtache-dtach-command session)))
+       (should (equal expected-concat (dtache-dtach-command session t))))
+     (let* ((dtache--dtach-mode 'attach)
+            (expected `("-a" ,(dtache-session-file session 'socket t)))
+            (expected-concat (format "%s -a %s"
+                                     dtach-program
+                                     (dtache-session-file session 'socket t))))
+       (should (equal expected (dtache-dtach-command session)))
+       (should (equal expected-concat (dtache-dtach-command session t)))))))
 
 (ert-deftest dtache-test-metadata ()
   ;; No annotators



reply via email to

[Prev in Thread] Current Thread [Next in Thread]