branch: externals/dtache
commit f73aa7ef98de1801b33fb52b1639625067d66357
Author: Niklas Eklund <niklas.ekl...@posteo.net>
Commit: Niklas Eklund <niklas.ekl...@posteo.net>
Cleanup dtache-shell
---
dtache-shell.el | 33 ++++++++-------------------------
dtache.el | 44 ++++++++++++++++++++++++++++----------------
2 files changed, 36 insertions(+), 41 deletions(-)
diff --git a/dtache-shell.el b/dtache-shell.el
index e4043c5c1a..4fae7c4ea2 100644
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -31,17 +31,9 @@
(defvar dtache-shell-history-file nil
"File to store history.")
-(defvar dtache-shell-block-list '("^$")
- "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.")
(defvar dtache-shell-session-action '(:attach dtache-shell-command-attach
:view dtache-view-dwim)
"Actions for a session created with `dtache-shell'.")
-;;;;; Private
-
-(defvar dtache-shell--current-session nil "The current session.")
-
;;;; Functions
(defun dtache-shell-override-history (orig-fun &rest args)
@@ -95,7 +87,7 @@ cluttering the comint-history with dtach commands."
(when (dtache-valid-session session)
(if (and (dtache--session-active-p session)
(not (dtache--session-redirect-only session)))
- (cl-letf ((dtache-shell--current-session session)
+ (cl-letf ((dtache--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)
@@ -109,27 +101,18 @@ cluttering the comint-history with dtach commands."
"Attach to `dtache--session' and send the attach command to PROC."
(let* ((dtache-session-mode 'attach)
(input
- (dtache-dtach-command dtache-shell--current-session t)))
+ (dtache-dtach-command dtache--current-session t)))
(comint-simple-send proc input)))
(defun dtache-shell--create-input-sender (proc string)
"Create a dtache session based on STRING and send to PROC."
(with-connection-local-variables
- (if-let* ((supported-input
- (not (seq-find
- (lambda (blocked)
- (string-match-p blocked string))
- dtache-shell-block-list)))
- (dtache-session-mode
- (if (seq-find
- (lambda (blocked)
- (string-match-p blocked string))
- dtache-shell-new-block-list)
- 'create
- dtache-session-mode))
- (dtach-command (dtache-dtach-command (substring-no-properties
string) t)))
- (comint-simple-send proc dtach-command)
- (comint-simple-send proc string))))
+ (let* ((command (substring-no-properties string))
+ (dtache-session-mode (if (dtache-redirect-only-p command)
+ 'new
+ 'create))
+ (dtach-command (dtache-dtach-command command t)))
+ (comint-simple-send proc dtach-command))))
(defun dtache-shell--comint-read-input-ring-advice (orig-fun &rest args)
"Set `comint-input-ring-file-name' before calling ORIG-FUN with ARGS."
diff --git a/dtache.el b/dtache.el
index 207c60bdd3..cea1bda1bf 100644
--- a/dtache.el
+++ b/dtache.el
@@ -229,14 +229,8 @@ Optionally SUPPRESS-OUTPUT."
(list (dtache-completing-read (dtache-get-sessions))))
(when (dtache-valid-session session)
(if (dtache--session-active-p session)
- (if (dtache--session-redirect-only session)
- (dtache-tail-output session)
- (let ((attach (or (plist-get (dtache--session-action session)
:attach)
- #'dtache-tail-output)))
- (funcall attach session)))
- (let ((view (or (plist-get (dtache--session-action session) :view)
- #'dtache-view-dwim)))
- (funcall view session)))))
+ (dtache-attach-session session)
+ (dtache-view-session session))))
;;;###autoload
(defun dtache-post-compile-session (session)
@@ -453,15 +447,13 @@ Optionally SUPPRESS-OUTPUT."
(or dtache--current-session
(dtache-create-session command))))
(if-let ((run-in-background
- (and (not (eq dtache-session-mode 'attach))
- (or suppress-output
+ (and (or suppress-output
(eq dtache-session-mode 'new)
(dtache--session-redirect-only
dtache--current-session))))
(dtache-session-mode 'new))
- (apply #'start-file-process-shell-command
- `("dtache" nil ,command))
- (cl-letf* (((symbol-function #'set-process-sentinel) #'ignore)
- (dtache-session-mode (or dtache-session-mode 'create))
+ (apply #'start-file-process-shell-command `("dtache" nil ,command))
+ (cl-letf* ((dtache-session-mode 'create)
+ ((symbol-function #'set-process-sentinel) #'ignore)
(buffer "*Dtache Shell Command*"))
(funcall #'async-shell-command command buffer)
(with-current-buffer buffer (setq dtache--buffer-session
dtache--current-session))))))
@@ -637,14 +629,34 @@ If session is not valid trigger an automatic cleanup on
SESSION's host."
"Attach to `dtache' SESSION."
(when (dtache-valid-session session)
(let* ((dtache--current-session session)
- (dtache-session-mode 'attach))
- (dtache-start-session (dtache--session-command session)))))
+ (dtache-session-mode 'attach)
+ (inhibit-message t))
+ (if (dtache--session-redirect-only session)
+ (dtache-attach-session session)
+ (cl-letf* (((symbol-function #'set-process-sentinel) #'ignore)
+ (buffer "*Dtache Shell Command*"))
+ (funcall #'async-shell-command (dtache--session-command session)
buffer)
+ (with-current-buffer buffer (setq dtache--buffer-session
dtache--current-session)))))))
(defun dtache-delete-sessions ()
"Delete all `dtache' sessions."
(seq-do #'dtache--db-remove-entry
(dtache-get-sessions)))
+(defun dtache-attach-session (session)
+ "Attach to SESSION."
+ (if (dtache--session-redirect-only session)
+ (dtache-tail-output session)
+ (if-let ((attach-fun (plist-get (dtache--session-action session) :attach)))
+ (funcall attach-fun session)
+ (dtache-tail-output session))))
+
+(defun dtache-view-session (session)
+ "View SESSION."
+ (if-let ((view-fun (plist-get (dtache--session-action session) :view)))
+ (funcall view-fun session)
+ (dtache-view-dwim session)))
+
;;;;; Other
(defun dtache-start-process-advice (start-process-fun name buffer &rest args)
