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