[elpa] externals/dtache 73021b0522 067/158: Improve dtache-shell-command

[ELPA Syncer]

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

    Improve dtache-shell-command
    
    This patch updates the internals of the dtache-shell-command. The new
    approach is to utilize the async-shell-command and let dtache create
    the altered command to run.
    
    The dtache-shell-mode is moved from dtache-shell into dtache which
    makes it possible to enable the mode in dtache-initialize. This is
    necessary because async-shell-command is also run in shell-mode so the
    mode is utilized there as well, which makes it possible for users to
    reuse their detach binding that they use in M-x shell
---
 CHANELOG.org        |  1 +
 README.org          |  7 ++--
 dtache-shell.el     | 35 ++-----------------
 dtache.el           | 97 +++++++++++++++++++++++++++++++++++++++++------------
 test/dtache-test.el | 15 +++++++--
 5 files changed, 96 insertions(+), 59 deletions(-)

diff --git a/CHANELOG.org b/CHANELOG.org
index 357527d8e6..94e7becad3 100644
--- a/CHANELOG.org
+++ b/CHANELOG.org
@@ -4,6 +4,7 @@
 
 * Development
 
+- 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.
 - macOS (monitor) support is added to the package.
diff --git a/README.org b/README.org
index 7f5abf4caf..780fb1f65f 100644
--- a/README.org
+++ b/README.org
@@ -76,6 +76,8 @@ 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=.
+
 ** Interacting with a session
 
 To interact with a session =dtache= provides the command 
=dtache-open-session=. This provides a convenient completion interface, 
enriched with annotations to provide useful information about the sessions. The 
=dtache-open-session= command is implemented as a do what I mean command. This 
results in =dtache= performing different actions depending on the state of a 
session.
@@ -124,13 +126,14 @@ A =use-package= configuration of the =dtache-shell= 
package. This package provid
     (setq dtache-shell-history-file "~/.bash_history"))
 #+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 shell.
+These are commands that the package provides and which the user is expected to 
bind to convenient keys. The =dtache= package provides a minor mode named 
=dtache-shell-mode=, which will be enabled in shell.
 
 | Command             | Description           |
 |---------------------+-----------------------|
 | dtache-shell-create | Create a session      |
 | dtache-shell-attach | Attach to a session   |
-| dtache-shell-detach | Detach from 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=.
 
 ** Dtache-eshell
 
diff --git a/dtache-shell.el b/dtache-shell.el
index f74328e2a7..361ff9edff 100644
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -35,8 +35,6 @@
   "A list of regexps to block non-supported input.")
 (defvar dtache-shell-new-block-list '("^sudo.*")
   "A list of regexps to block from creating a session without attaching.")
-(defconst dtache-shell-detach-character "\C-\\"
-  "Character used to detach from a session.")
 
 ;;;;; Private
 
@@ -59,7 +57,6 @@ This function also makes sure that the HISTFILE is disabled 
for local shells."
 (defun dtache-shell-setup ()
   "Setup `dtache-shell'."
   (add-hook 'shell-mode-hook #'dtache-shell-save-history)
-  (add-hook 'shell-mode-hook #'dtache-shell-mode)
   (advice-add 'shell :around #'dtache-shell-override-history))
 
 (defun dtache-shell-select-session ()
@@ -92,14 +89,6 @@ This function also makes sure that the HISTFILE is disabled 
for local shells."
         (comint-input-sender #'dtache-shell--create-input-sender))
     (comint-send-input)))
 
-;;;###autoload
-(defun dtache-shell-detach ()
-  "Detach from session."
-  (interactive)
-  (let ((proc (get-buffer-process (current-buffer)))
-        (input dtache-shell-detach-character))
-    (comint-simple-send proc input)))
-
 ;;;###autoload
 (defun dtache-shell-attach (session)
   "Attach to SESSION.
@@ -141,13 +130,8 @@ cluttering the comint-history with dtach commands."
                    dtache-shell-new-block-list)
                   'create
                 dtache--dtach-mode))
-             (command (dtache-dtach-command (substring-no-properties string)))
-             (shell-command
-              (mapconcat 'identity `(,dtache-dtach-program
-                                     ,@(butlast command)
-                                     ,(shell-quote-argument (car (last 
command))))
-                         " ")))
-       (comint-simple-send proc shell-command)
+             (dtach-command (dtache-dtach-command (substring-no-properties 
string) t)))
+       (comint-simple-send proc dtach-command)
      (comint-simple-send proc string))))
 
 (defun dtache-shell--comint-read-input-ring-advice (orig-fun &rest args)
@@ -169,21 +153,6 @@ cluttering the comint-history with dtach commands."
            dtache-shell-history-file)))
      (comint-write-input-ring))))
 
-;;;; Minor mode
-
-(define-minor-mode dtache-shell-mode
-  "Integrate `dtache' in shell-mode."
-  :lighter "dtache-shell"
-  :keymap (let ((map (make-sparse-keymap)))
-            map)
-  (with-connection-local-variables
-   (if dtache-shell-mode
-       (progn
-         (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))
-     (remove-hook 'comint-preoutput-filter-functions 
#'dtache--dtache-env-message-filter t)
-     (remove-hook 'comint-preoutput-filter-functions 
#'dtache--dtach-eof-message-filter t))))
-
 (provide 'dtache-shell)
 
 ;;; dtache-shell.el ends here
diff --git a/dtache.el b/dtache.el
index 04b255ae2c..53f31add4b 100644
--- a/dtache.el
+++ b/dtache.el
@@ -46,6 +46,7 @@
 
 (require 'autorevert)
 (require 'filenotify)
+(require 'simple)
 (require 'tramp)
 
 ;;;; Variables
@@ -60,6 +61,8 @@
   "Shell to run the dtach command in.")
 (defvar dtache-env nil
   "The name of the `dtache' program.")
+(defvar dtache-shell-command-history nil
+  "History of commands run with `dtache-shell-command'.")
 (defvar dtache-max-command-length 90
   "Maximum length of displayed command.")
 (defvar dtache-redirect-only-regexps '()
@@ -165,6 +168,8 @@
   "Message printed when `dtach' terminates.")
 (defconst dtache--dtach-detached-message "\\[detached\\]\^M"
   "Message printed when detaching from `dtach'.")
+(defconst dtache--dtach-detach-character "\C-\\"
+  "Character used to detach from a session.")
 
 ;;;; Data structures
 
@@ -191,7 +196,9 @@
 
 ;;;###autoload
 (defun dtache-shell-command (command)
-  "Execute COMMAND asynchronously with `dtache'."
+  "Execute COMMAND asynchronously with `dtache'.
+
+If called with prefix-argument the output is suppressed."
   (interactive
    (list
     (read-shell-command (if shell-command-prompt-show-cwd
@@ -199,10 +206,8 @@
                                             (abbreviate-file-name
                                              default-directory))
                           "Dtache shell command: ")
-                        nil nil)))
-  (let* ((inhibit-message t)
-         (dtache-session-type 'standard))
-    (dtache-start-session command)))
+                        nil 'dtache-shell-command-history)))
+  (dtache-start-session command current-prefix-arg))
 
 ;;;###autoload
 (defun dtache-open-session (session)
@@ -349,6 +354,18 @@
       (insert (dtache-session-output session2)))
     (ediff-buffers buffer1 buffer2)))
 
+;;;###autoload
+(defun dtache-shell-detach ()
+  "Detach from session."
+  (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]")))))
+
 ;;;###autoload
 (defun dtache-quit-tail-output ()
   "Quit `dtache' tail log.
@@ -387,12 +404,23 @@ nil before closing."
     (dtache-start-session-monitor session)
     session))
 
-(defun dtache-start-session (command)
-  "Start a `dtache' session running COMMAND."
-  (let* ((dtache--dtach-mode 'new)
-         (dtache-command (dtache-dtach-command command)))
-    (apply #'start-file-process
-           `("dtache" nil ,dtache-dtach-program ,@dtache-command))))
+(defun dtache-start-session (command &optional suppress-output)
+  "Start a `dtache' session running COMMAND.
+
+Optionally SUPPRESS-OUTPUT."
+  (if (or 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)))
+    (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*"))))
 
 (defun dtache-update-sessions ()
   "Update `dtache' sessions.
@@ -478,16 +506,19 @@ Optionally make the path LOCAL to host."
                        (dtache--session-missing-p session))
                   (dtache--db-remove-entry session)
 
-                  ;; Update local active sessions
-                  (when (and (string= "localhost" (dtache--session-host 
session))
-                             (dtache--session-active session))
-                    (dtache-update-session session))))
+                ;; Update local active sessions
+                (when (and (string= "localhost" (dtache--session-host session))
+                           (dtache--session-active session))
+                  (dtache-update-session session))))
             (dtache--db-get-sessions))
 
     ;; Start monitors
     (thread-last (dtache--db-get-sessions)
                  (seq-filter #'dtache--session-active)
-                 (seq-do #'dtache-start-session-monitor))))
+                 (seq-do #'dtache-start-session-monitor))
+
+    ;; Add `dtache-shell-mode'
+    (add-hook 'shell-mode-hook #'dtache-shell-mode)))
 
 (defun dtache-cleanup-host-sessions (host)
   "Run cleanuup on HOST sessions."
@@ -556,17 +587,27 @@ Optionally make the path LOCAL to host."
         (dtache--session-macos-monitor session)
       (dtache--session-filenotify-monitor session))))
 
-(defun dtache-dtach-command (command)
-  "Return a dtach command for COMMAND."
+(defun dtache-dtach-command (command &optional concat)
+  "Return a list of arguments to run COMMAND with dtach.
+
+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)))
-     `(,(dtache--dtach-arg) ,socket "-z"
-       ,dtache-shell-program "-c"
-       ,(dtache--magic-command session)))))
+     (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."
@@ -946,6 +987,20 @@ the current time is used."
         (string-remove-prefix remote working-directory)
         working-directory)))
 
+;;;; Minor modes
+
+(define-minor-mode dtache-shell-mode
+  "Integrate `dtache' in shell-mode."
+  :lighter "dtache-shell"
+  :keymap (let ((map (make-sparse-keymap)))
+            map)
+  (if dtache-shell-mode
+      (progn
+        (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))
+    (remove-hook 'comint-preoutput-filter-functions 
#'dtache--dtache-env-message-filter t)
+    (remove-hook 'comint-preoutput-filter-functions 
#'dtache--dtach-eof-message-filter t)))
+
 ;;;; Major modes
 
 (defvar dtache-log-mode-map
diff --git a/test/dtache-test.el b/test/dtache-test.el
index c9567533a6..50d9b823fd 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -66,7 +66,8 @@
 
 (ert-deftest dtache-test-dtach-command ()
   (dtache-test--with-temp-database
-   (cl-letf* ((dtache-env "dtache-env")
+   (cl-letf* ((dtach-program "dtach")
+              (dtache-env "dtache-env")
               (dtache-shell-program "bash")
               (dtache--dtach-mode 'create)
               (session (dtache-create-session "ls -la"))
@@ -77,8 +78,16 @@
                           "-z" ,dtache-shell-program
                           "-c"
                           ,(format "{ dtache-env ls\\ -la; } 2>&1 | tee %s"
-                                   (dtache-session-file session 'log t)))))
-     (should (equal expected (dtache-dtach-command "ls -la"))))))
+                                   (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))))))
 
 (ert-deftest dtache-test-metadata ()
   ;; No annotators