branch: externals/detached
commit 236f6c95afe531f6f5a8b50a83e6386a95aaf570
Author: Niklas Eklund <niklas.ekl...@posteo.net>
Commit: Niklas Eklund <niklas.ekl...@posteo.net>
Improve implementation
---
detached.el | 62 ++++++++++++++++++++++++++++-----------------------
test/detached-test.el | 51 ++++++++++++++++++++++++++++--------------
2 files changed, 68 insertions(+), 45 deletions(-)
diff --git a/detached.el b/detached.el
index 90a4589478..defcb21cb0 100644
--- a/detached.el
+++ b/detached.el
@@ -735,13 +735,16 @@ Optionally SUPPRESS-OUTPUT."
(defun detached-start-detached-session (session)
"Start SESSION in detached mode."
- (detached--set-session-state session 'started)
- (let ((dtach-command (detached-session-start-command
- session
- :type 'string)))
- (if (detached-session-local-p session)
- (apply #'start-process-shell-command `("detached" nil ,dtach-command))
- (apply #'start-file-process-shell-command `("detached" nil
,dtach-command)))))
+ (detached--start-session-process session
+ (detached-session-start-command
+ session
+ :type 'string)))
+
+(defun detached--start-session-process (session start-command)
+ "Start SESSION with START-COMMAND."
+ (if (detached-session-local-p session)
+ (apply #'start-process-shell-command `("detached" nil ,start-command))
+ (apply #'start-file-process-shell-command `("detached" nil
,start-command))))
(defun detached-session-candidates (sessions)
"Return an alist of SESSIONS candidates."
@@ -914,24 +917,28 @@ This function uses the `notifications' library."
(error "Type not specified for session start command"))
(detached-connection-local-variables
(let* ((socket (detached--session-file session 'socket t))
+ (detached-session-mode (detached--session-initial-mode session))
(log (detached--session-file session 'log t))
+ (dtach-command-fun (lambda (session)
+ (let ((detached-session-mode
(detached--session-initial-mode session)))
+ `(,detached-dtach-program
+ ,(detached--dtach-arg) ,socket "-z"
+ ,detached-shell-program "-c"
+ ,(if (eq type 'string)
+ (shell-quote-argument
(detached--detached-command session))
+ (detached--detached-command session))))))
(command
- (if (detached-session-degraded-p session)
- (progn
- (when (eq 'create-and-attach
- (detached--session-initial-mode session))
- (detached-start-detached-session session))
- `(,detached-tail-program
- "-F"
- "-n"
- ,(number-to-string detached-session-context-lines)
- ,log))
- `(,detached-dtach-program
- ,(detached--dtach-arg) ,socket "-z"
- ,detached-shell-program "-c"
- ,(if (eq type 'string)
- (shell-quote-argument (detached--detached-command session))
- (detached--detached-command session))))))
+ (if (eq 'create (detached--session-initial-mode session))
+ (funcall dtach-command-fun session)
+ (if (not (detached-session-degraded-p session))
+ (funcall dtach-command-fun session)
+ (detached--start-session-process session
+ (funcall dtach-command-fun
session))
+ `(,detached-tail-program
+ "-F"
+ "-n"
+ ,(number-to-string detached-session-context-lines)
+ ,log)))))
(detached--set-session-state session 'started)
(pcase type
('string (string-join command " "))
@@ -947,11 +954,10 @@ This function uses the `notifications' library."
(dtach-arg (detached--dtach-arg))
(command
(if (detached-session-degraded-p session)
- `(,detached-tail-program
- "-F"
- "-n"
- ,(number-to-string detached-session-context-lines)
- ,log)
+ `(,detached-tail-program "-F"
+ "-n"
+ ,(number-to-string
detached-session-context-lines)
+ ,log)
(append
(when detached-show-session-context
`(,detached-tail-program "-n"
diff --git a/test/detached-test.el b/test/detached-test.el
index 9a26dc4794..3a8e5fcb91 100644
--- a/test/detached-test.el
+++ b/test/detached-test.el
@@ -97,23 +97,40 @@
;;;;; Other
- (ert-deftest detached-test-tail-command ()
- (detached-test--with-temp-database
- (cl-letf* ((detached-tail-program "tail")
- (session (detached-create-session "ls -la"))
- (detached-show-session-context t)
- (detached-session-context-lines 20)
- ((symbol-function #'detached-create-session)
- (lambda (_)
- session)))
- (let* ((log (detached--session-file session 'log t))
- (expected `(,detached-tail-program
- "-F" "-n" ,(number-to-string
detached-session-context-lines)
- ,log))
- (expected-concat (string-join expected " ")))
- (let ((detached-session-mode 'create-and-attach))
- (should (equal expected (detached--tail-command session)))
- (should (equal expected-concat (detached--tail-command session
t))))))))
+;; (ert-deftest detached-test-session-start-command ()
+;; (detached-test--with-temp-database
+;; (cl-letf* ((detached-tail-program "tail")
+;; (detached-dtach-program "dtach")
+;; (detached-shell-program "bash")
+;; (detached-show-session-context t)
+;; (detached-session-context-lines 20))
+
+;; ;; ;; Create and attach
+;; ;; (let* ((session (detached-create-session "ls -la"))
+;; ;; (log (detached--session-file session 'log t))
+;; ;; (expected-list `(,detached-tail-program
+;; ;; "-F"
+;; ;; "-n" ,(number-to-string
detached-session-context-lines)
+;; ;; ,log)))
+;; ;; (setf (detached--session-initial-mode session) 'create-and-attach)
+;; ;; (should (equal expected-list (detached-session-start-command
session
+;; ;;
:type 'list))))
+
+;; ;; Create and attach to degraded session
+;; (let* ((detached-degraded-commands '("ls"))
+;; (session (detached-create-session "ls -la"))
+;; (log (detached--session-file session 'log t))
+;; (expected-list `(,detached-tail-program
+;; "-F"
+;; "-n" ,(number-to-string
detached-session-context-lines)
+;; ,log)))
+;; (setf (detached--session-initial-mode session) 'create-and-attach)
+;; (should (equal expected-list (detached-session-start-command session
+;; :type
'list))))
+
+;; ;; Create
+
+;; )))
(ert-deftest detached-test-dtach-command ()
(detached-test--with-temp-database
