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

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

[elpa] externals/dtache a36e89486f 055/158: Add package dtache-eshell


From: ELPA Syncer
Subject: [elpa] externals/dtache a36e89486f 055/158: Add package dtache-eshell
Date: Wed, 19 Jan 2022 18:57:53 -0500 (EST)

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

    Add package dtache-eshell
    
    This patch adds the dtache-eshell package which is an integration of
    dtache into eshell. This package is similar in functionality to the
    dtache-shell package.
    
    The only difference from a users perspective is that the user doesn't
    need to use a special binding to detach from a session. C-c C-c will
    do that for you.
---
 CHANELOG.org                                       |   1 +
 README.org                                         |  80 ++++++----
 dtache-eshell.el                                   | 123 +++++++++++++++
 dtache-shell.el                                    |  39 +----
 dtache.el                                          | 172 ++++++++++++---------
 ...{dtache-shell-test.el => dtache-eshell-test.el} |  24 +--
 test/dtache-shell-test.el                          |  12 --
 test/dtache-test.el                                | 101 ++++++------
 8 files changed, 341 insertions(+), 211 deletions(-)

diff --git a/CHANELOG.org b/CHANELOG.org
index 128aadf69f..679db88233 100644
--- a/CHANELOG.org
+++ b/CHANELOG.org
@@ -4,6 +4,7 @@
 
 * Development
 
+- Add support for =eshell= through the =dtache-eshell= package.
 - macOS (monitor) support is added to the package.
 
 * Version 0.2 (2021-12-23)
diff --git a/README.org b/README.org
index edc4bd5872..e0eea597fb 100644
--- a/README.org
+++ b/README.org
@@ -132,6 +132,28 @@ These are commands that the package provides and which the 
user is expected to b
 | dtache-shell-attach | Attach to a session   |
 | dtache-shell-detach | Detach from a session |
 
+** Dtache-eshell
+
+A =use-package= configuration of the =dtache-eshell= package. This package 
provides the integration with =eshell=, but since not all Emacs users use 
=eshell=, this package is made optional.
+
+#+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))
+#+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=.
+
+| Command                      | Description         |
+|------------------------------+---------------------|
+| dtache-eshell-create-session | Create a session    |
+| dtache-eshell-attach         | Attach to a session |
+
+To detach from a session simply use =C-c C-c=.
+
 ** Embark
 
 The user have the possibility to integrate =dtache= with the package 
[[https://github.com/oantolin/embark/][embark]]. The =dtache-action-map= can be 
reused for this purpose, so the user doesn't need to bind it to any key. 
Instead the user simply adds the following to their =dtache= configuration in 
order to get embark actions for =dtache-open-session=.
@@ -141,6 +163,35 @@ The user have the possibility to integrate =dtache= with 
the package [[https://g
   (add-to-list 'embark-keymap-alist '(dtache . embark-dtache-map))
 #+end_src
 
+** Alert
+
+By default =dtache= uses the echo area to notify the user when a session has 
finished. An alternative is to utilize the 
[[https://github.com/jwiegley/alert][alert]] package to get a system 
notification instead.
+
+#+begin_src elisp :lexical t :results none
+  (defun my/dtache-session-finish-alert (session)
+    "Send an alert notification when SESSION finish."
+    (let ((status (dtache--session-status session))
+          (title
+           (pcase (dtache--session-status session)
+             ('success "Dtache finished!")
+             ('failure "Dtache failed!"))))
+      (alert (dtache--session-command session)
+             :title title
+             :severity (pcase status
+                         ('success 'moderate)
+                         ('failure 'high))
+             :category 'compile
+             :id (pcase status
+                   ('success 'compile-ok)
+                   ('failure 'compile-fail)))))
+#+end_src
+
+With the usage of =advice= the user can override the default implantation with 
the alert version.
+
+#+begin_src elisp :lexical t :results none
+  (advice-add 'dtache-session-finish-notification :override 
#'my/dtache-session-finish-alert)
+#+end_src
+
 * Customization
 ** Completion annotations
 
@@ -202,35 +253,6 @@ Some programs doesn't play well with =tee=, which =dtache= 
relies upon to redire
 
 Here a command beginning with =ls= would from now on be using redirect only.
 * Tips & Tricks
-** System notifications
-
-By default =dtache= uses the echo area to notify the user when a session has 
finished. An alternative is to utilize the 
[[https://github.com/jwiegley/alert][alert]] package to get a system 
notification instead.
-
-#+begin_src elisp :lexical t :results none
-  (defun dtache-session-finish-alert (session)
-    "Send an alert notification when SESSION finish."
-    (let ((status (dtache--session-status session))
-          (title
-           (pcase (dtache--session-status session)
-             ('success "Dtache finished!")
-             ('failure "Dtache failed!"))))
-      (alert (dtache--session-command session)
-             :title title
-             :severity (pcase status
-                         ('success 'moderate)
-                         ('failure 'high))
-             :category 'compile
-             :id (pcase status
-                   ('success 'compile-ok)
-                   ('failure 'compile-fail)))))
-#+end_src
-
-With the usage of =advice= the user can override the default implantation with 
the alert version.
-
-#+begin_src elisp :lexical t :results none
-  (advice-add 'dtache-session-finish-notification :override 
#'my/dtache-session-finish-alert)
-#+end_src
-
 ** Remote support
 
 The =dtache= package supports 
[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Connection-Local-Variables.html][Connection
 Local Variables]] which allows you to change the variables used by =dtache= 
when running on a remote host. This useful when the user needs to alter dtache 
settings when running on a remote host.
diff --git a/dtache-eshell.el b/dtache-eshell.el
new file mode 100644
index 0000000000..a74eaca3f0
--- /dev/null
+++ b/dtache-eshell.el
@@ -0,0 +1,123 @@
+;;; dtache-eshell.el --- Dtache integration in eshell -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; URL: https://www.gitlab.com/niklaseklund/dtache.git
+;; Version: 0.2
+;; Package-Requires: ((emacs "27.1"))
+;; Keywords: convenience processes
+
+;; 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 provides integration of `dtache' in `eshell'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'dtache)
+(require 'eshell)
+(require 'esh-mode)
+(require 'em-hist)
+
+;;;; Variables
+
+(defvar dtache-eshell-command nil)
+
+;;;; Functions
+
+(defun dtache-eshell-setup ()
+  "Setup `dtache-eshell'."
+  (add-hook 'eshell-prepare-command-hook #'dtache-eshell-maybe-create-session)
+  (add-hook 'eshell-mode-hook #'dtache-eshell-mode))
+
+(defun dtache-eshell-select-session ()
+  "Return selected session."
+  (let* ((current-host (dtache--host))
+         (sessions
+          (thread-last (dtache-get-sessions)
+            (seq-filter (lambda (it)
+                          (string= (dtache--session-host it) current-host)))
+            (seq-filter #'dtache--session-active-p))))
+    (dtache-completing-read sessions)))
+
+(defun dtache-eshell-maybe-create-session ()
+  "Create a session if `dtache-eshell-command' value is t."
+  (when dtache-eshell-command
+    (let* ((dtache--dtach-mode 'create)
+           (command (mapconcat #'identity
+                               `(,eshell-last-command-name
+                                 ,@eshell-last-arguments)
+                               " ")))
+      (setq eshell-last-arguments (dtache-dtach-command command)))
+    (setq eshell-last-command-name "dtach")))
+
+;;;; Commands
+
+;;;###autoload
+(defun dtache-eshell-create-session (&optional detach)
+  "Create a session and attach to it.
+
+If prefix-argument directly DETACH from the session."
+  (interactive "P")
+  (let* ((dtache-session-type 'eshell)
+         (dtache--dtach-mode (if detach 'new 'create))
+         (dtache-eshell-command t))
+    (call-interactively #'eshell-send-input)))
+
+;;;###autoload
+(defun dtache-eshell-attach (session)
+  "Attach to 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))
+             ((symbol-function #'eshell-add-to-history) #'ignore))
+    (eshell-kill-input)
+    ;; Hide the input from the user
+    (let ((begin (point))
+          (end))
+      (insert input)
+      (setq end (point))
+      (overlay-put (make-overlay begin end) 'invisible t)
+      (insert " "))
+    (call-interactively #'eshell-send-input)))
+
+;;;; Support functions
+
+;;;; Minor mode
+
+(define-minor-mode dtache-eshell-mode
+  "Integrate `dtache' in eshell-mode."
+  :lighter "dtache-eshell"
+  :keymap (let ((map (make-sparse-keymap)))
+            map)
+  (with-connection-local-variables
+   (if dtache-eshell-mode
+       (progn
+         (add-hook 'eshell-preoutput-filter-functions 
#'dtache--dtache-env-message-filter)
+         (add-hook 'eshell-preoutput-filter-functions 
#'dtache--dtach-eof-message-filter))
+     (remove-hook 'eshell-preoutput-filter-functions 
#'dtache--dtache-env-message-filter)
+     (remove-hook 'eshell-preoutput-filter-functions 
#'dtache--dtach-eof-message-filter))))
+
+(provide 'dtache-eshell)
+
+;;; dtache-eshell.el ends here
diff --git a/dtache-shell.el b/dtache-shell.el
old mode 100755
new mode 100644
index fded894e84..945ffeffdb
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -46,10 +46,6 @@
 
 (defconst dtache-shell-detach-character "\C-\\"
   "Character used to detach from a session.")
-(defconst dtache-shell-eof-message "\\[EOF - dtach terminating\\]\^M"
-  "Message printed when `dtach' finishes.")
-(defconst dtache-shell-detached-message "\\[detached\\]\^M"
-  "Message printed when `dtach' finishes.")
 
 ;;;;; Private
 
@@ -69,18 +65,6 @@ This function also makes sure that the HISTFILE is disabled 
for local shells."
   "Add hook to save history when killing `shell' buffer."
   (add-hook 'kill-buffer-hook #'dtache-shell-save-history 0 t))
 
-(defun dtache-shell-filter-dtach-eof (string)
-  "Remove eof message from dtach in STRING."
-  (if (string-match dtache-shell-eof-message string)
-      (replace-regexp-in-string (format "%s\n" dtache-shell-eof-message) "" 
string)
-    string))
-
-(defun dtache-shell-filter-dtach-detached (string)
-  "Remove detached message from dtach in STRING."
-  (if (string-match dtache-shell-detached-message string)
-      (replace-regexp-in-string (format "%s\n" dtache-shell-detached-message) 
"" string)
-    string))
-
 (defun dtache-shell-setup ()
   "Setup `dtache-shell'."
   (add-hook 'shell-mode-hook #'dtache-shell-save-history)
@@ -89,10 +73,9 @@ This function also makes sure that the HISTFILE is disabled 
for local shells."
 
 (defun dtache-shell-select-session ()
   "Return selected session."
-  (dtache-update-sessions)
   (let* ((current-host (dtache--host))
          (sessions
-          (thread-last (dtache--db-get-sessions)
+          (thread-last (dtache-get-sessions)
             (seq-filter (lambda (it)
                           (string= (dtache--session-host it) current-host)))
             (seq-filter #'dtache--session-active-p))))
@@ -147,13 +130,9 @@ 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
-          (concat
-           (dtache--session-session-directory dtache-shell--current-session)
-           (symbol-name (dtache--session-id dtache-shell--current-session))
-           ".socket"))
+         (socket (dtache-session-file dtache-shell--current-session 'socket t))
          (input
-          (concat dtache-dtach-program " " (dtache--dtach-arg) " " socket)))
+          (format "%s %s %s" dtache-dtach-program (dtache--dtach-arg) socket)))
     (comint-simple-send proc input)))
 
 (defun dtache-shell--create-input-sender (proc string)
@@ -171,9 +150,7 @@ cluttering the comint-history with dtach commands."
                    dtache-shell-new-block-list)
                   'create
                 dtache--dtach-mode))
-             (session (dtache-create-session
-                       (substring-no-properties string)))
-             (command (dtache-dtach-command session))
+             (command (dtache-dtach-command (substring-no-properties string)))
              (shell-command
               (mapconcat 'identity `(,dtache-dtach-program
                                      ,@(butlast command)
@@ -211,11 +188,11 @@ cluttering the comint-history with dtach commands."
   (with-connection-local-variables
    (if dtache-shell-mode
        (when dtache-shell-silence-dtach-messages
-         (add-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-eof 0 t)
-         (add-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-detached 0 t))
+         (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))
      (when dtache-shell-silence-dtach-messages
-       (remove-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-eof t)
-       (remove-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-detached 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)
 
diff --git a/dtache.el b/dtache.el
index 1c361b1d63..1167110031 100644
--- a/dtache.el
+++ b/dtache.el
@@ -157,6 +157,10 @@
   "Mode of operation for dtach.")
 (defvar dtache--sessions nil
   "A list of sessions.")
+(defconst dtache--dtach-eof-message "\\[EOF - dtach terminating\\]\^M"
+  "Message printed when `dtach' finishes.")
+(defconst dtache--dtach-detached-message "\\[detached\\]\^M"
+  "Message printed when `dtach' finishes.")
 
 ;;;; Data structures
 
@@ -200,7 +204,7 @@
 (defun dtache-open-session (session)
   "Open a `dtache' SESSION."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (if-let ((open-function
             (dtache--session-open-function session)))
       (funcall open-function session)
@@ -210,7 +214,7 @@
 (defun dtache-compile-session (session)
   "Open log of SESSION in `compilation-mode'."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (let ((buffer-name "*dtache-session-output*")
         (file
          (dtache-session-file session 'log))
@@ -234,7 +238,7 @@
 (defun dtache-rerun-session (session)
   "Rerun SESSION."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (let* ((default-directory
            (dtache--session-working-directory session))
          (dtache-open-session-function
@@ -249,7 +253,7 @@
 (defun dtache-copy-session-output (session)
   "Copy SESSION's log."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (with-temp-buffer
     (insert (dtache-session-output session))
     (kill-new (buffer-string))))
@@ -258,21 +262,21 @@
 (defun dtache-copy-session-command (session)
   "Copy SESSION command."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (kill-new (dtache--session-command session)))
 
 ;;;###autoload
 (defun dtache-insert-session-command (session)
   "Insert SESSION."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (insert (dtache--session-command session)))
 
 ;;;###autoload
 (defun dtache-delete-session (session)
   "Delete SESSION."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (if (dtache--session-active-p session)
       (message "Kill session first before removing it.")
     (dtache--db-remove-entry session)))
@@ -281,7 +285,7 @@
 (defun dtache-kill-session (session)
   "Send a TERM signal to SESSION."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (let* ((pid (dtache--session-pid session)))
     (when pid
       (dtache--kill-processes pid))))
@@ -290,7 +294,7 @@
 (defun dtache-open-output (session)
   "Open SESSION's output."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (let* ((buffer-name "*dtache-session-output*")
          (file-path
           (dtache-session-file session 'log))
@@ -311,7 +315,7 @@
 (defun dtache-tail-output (session)
   "Tail SESSION's output."
   (interactive
-   (list (dtache-select-session)))
+   (list (dtache-completing-read)))
   (if (dtache--session-active-p session)
       (let* ((file-path
               (dtache-session-file session 'log))
@@ -327,8 +331,8 @@
   "Diff SESSION1 with SESSION2."
   (interactive
    (list
-    (dtache-select-session)
-    (dtache-select-session)))
+    (dtache-completing-read)
+    (dtache-completing-read)))
   (let ((buffer1 "*dtache-session-output-1*")
         (buffer2 "*dtache-session-output-2*"))
     (with-current-buffer (get-buffer-create buffer1)
@@ -382,16 +386,10 @@ nil before closing."
 (defun dtache-start-session (command)
   "Start a `dtache' session running COMMAND."
   (let* ((dtache--dtach-mode 'new)
-         (session (dtache-create-session command))
-         (dtache-command (dtache-dtach-command session)))
+         (dtache-command (dtache-dtach-command command)))
     (apply #'start-file-process
            `("dtache" nil ,dtache-dtach-program ,@dtache-command))))
 
-(defun dtache-select-session ()
-  "Return selected session."
-  (dtache-update-sessions)
-  (dtache-completing-read (dtache--db-get-sessions)))
-
 (defun dtache-update-sessions ()
   "Update `dtache' sessions.
 
@@ -405,19 +403,24 @@ Sessions running on  current host or localhost are 
updated."
                   (dtache-update-session it)))
             (dtache--db-get-sessions))))
 
-(defun dtache-session-file (session file)
-  "Return the path to SESSION's FILE."
-  (let ((file-name
-         (concat
-          (symbol-name
-           (dtache--session-id session))
-          (pcase file
-            ('socket ".socket")
-            ('log ".log"))))
-        (directory (concat
-                    (file-remote-p (dtache--session-working-directory session))
-                    (dtache--session-session-directory session))))
-    (expand-file-name file-name directory)))
+(defun dtache-session-file (session file &optional local)
+  "Return the full path to SESSION's FILE.
+
+Optionally make the path LOCAL to host."
+  (let* ((file-name
+          (concat
+           (symbol-name
+            (dtache--session-id session))
+           (pcase file
+             ('socket ".socket")
+             ('log ".log"))))
+         (remote (file-remote-p (dtache--session-working-directory session)))
+         (directory (concat
+                     remote
+                     (dtache--session-session-directory session))))
+    (if (and local remote)
+        (string-remove-prefix remote (expand-file-name file-name directory))
+      (expand-file-name file-name directory))))
 
 (defun dtache-session-candidates (sessions)
   "Return an alist of SESSIONS candidates."
@@ -547,28 +550,12 @@ Sessions running on  current host or localhost are 
updated."
          (dtache-open-output session))
         (t (message "Dtache session is in an unexpected state."))))
 
-;;;;; Other
+(defun dtache-get-sessions ()
+  "Update and return sessions."
+  (dtache-update-sessions)
+  (dtache--db-get-sessions))
 
-(defun dtache-completing-read (sessions)
-  "Select a session from SESSIONS through `completing-read'."
-  (let* ((candidates (dtache-session-candidates sessions))
-         (metadata `(metadata
-                     (category . dtache)
-                     (cycle-sort-function . identity)
-                     (display-sort-function . identity)
-                     (annotation-function . ,(lambda (s)
-                                               (dtache-session-annotation (cdr 
(assoc s candidates)))))
-                     (affixation-function .
-                                          ,(lambda (cands)
-                                             (seq-map (lambda (s)
-                                                        `(,s nil 
,(dtache-session-annotation (cdr (assoc s candidates)))))
-                                                      cands)))))
-         (collection (lambda (string predicate action)
-                       (if (eq action 'metadata)
-                           metadata
-                         (complete-with-action action candidates string 
predicate))))
-         (cand (completing-read "Select session: " collection nil t)))
-    (cdr (assoc cand candidates))))
+;;;;; Other
 
 (defun dtache-start-session-monitor (session)
   "Start to monitor SESSION activity."
@@ -578,18 +565,17 @@ Sessions running on  current host or localhost are 
updated."
         (dtache--session-macos-monitor session)
       (dtache--session-filenotify-monitor session))))
 
-(defun dtache-dtach-command (session)
-  "Return a dtach command for SESSION."
+(defun dtache-dtach-command (command)
+  "Return a dtach command for COMMAND."
   (with-connection-local-variables
-   (let* ((directory (dtache--session-session-directory session))
-          (file-name (symbol-name (dtache--session-id session)))
-          (socket (concat directory file-name ".socket"))
-          ;; Construct the command line
-          (command (dtache--magic-command session))
+   (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" 
,command))))
+     `(,(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."
@@ -626,6 +612,28 @@ Sessions running on  current host or localhost are 
updated."
                               short-home
                               (expand-file-name default-directory))))
 
+(defun dtache-completing-read (&optional sessions)
+  "Select a session from SESSIONS through `completing-read'."
+  (let* ((sessions (or sessions (dtache-get-sessions)))
+         (candidates (dtache-session-candidates sessions))
+         (metadata `(metadata
+                     (category . dtache)
+                     (cycle-sort-function . identity)
+                     (display-sort-function . identity)
+                     (annotation-function . ,(lambda (s)
+                                               (dtache-session-annotation (cdr 
(assoc s candidates)))))
+                     (affixation-function .
+                                          ,(lambda (cands)
+                                             (seq-map (lambda (s)
+                                                        `(,s nil 
,(dtache-session-annotation (cdr (assoc s candidates)))))
+                                                      cands)))))
+         (collection (lambda (string predicate action)
+                       (if (eq action 'metadata)
+                           metadata
+                         (complete-with-action action candidates string 
predicate))))
+         (cand (completing-read "Select session: " collection nil t)))
+    (cdr (assoc cand candidates))))
+
 ;;;; Support functions
 
 ;;;;; Session
@@ -827,18 +835,16 @@ Sessions running on  current host or localhost are 
updated."
 
 If SESSION is redirect-only fallback to a command that doesn't rely on tee.
 Otherwise use tee to log stdout and stderr individually."
-  (let* ((command
-          (if dtache-env
-              (string-join
-               `(,dtache-env
-                 ,(shell-quote-argument (dtache--session-command session))) " 
")
-            `(,dtache-shell-program "-c" ,(shell-quote-argument 
(dtache--session-command session)))))
-         (directory (dtache--session-session-directory session))
-         (file-name (symbol-name (dtache--session-id session)))
-         (log (concat directory file-name ".log")))
-    (if (dtache--session-redirect-only session)
-        (format "{ %s; } &> %s" command log)
-      (format "{ %s; } 2>&1 | tee %s" command log))))
+  (let* ((log (dtache-session-file session 'log t))
+         (redirect
+          (if (dtache--session-redirect-only session)
+              (format "&> %s" log)
+            (format "2>&1 | tee %s" log)))
+         (env (if dtache-env dtache-env (format "%s -c" dtache-shell-program)))
+         (command
+          (shell-quote-argument
+           (dtache--session-command session))))
+    (format "{ %s %s; } %s" env command redirect)))
 
 (defun dtache--host ()
   "Return name of host."
@@ -862,16 +868,28 @@ the current time is used."
   (let ((current-time (current-time-string)))
     (secure-hash 'md5 (concat command current-time))))
 
+(defun dtache--dtache-env-message-filter (str)
+  "Remove `dtache-env' message in STR."
+  (replace-regexp-in-string "\n?Dtache session.*\n?" "" str))
+
+(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))
+
+(defun dtache--dtach-detached-message-filter (str)
+  "Remove `dtache--dtach-detached-message' in STR."
+  (replace-regexp-in-string (format "\n?%s\n" dtache--dtach-detached-message) 
"" str))
+
 ;;;;; UI
 
 (defun dtache--metadata-str (session)
   "Return SESSION's metadata as a string."
   (string-join
    (thread-last (dtache--session-metadata session)
-     (seq-filter (lambda (it) (cdr it)))
-     (seq-map
-      (lambda (it)
-        (concat (symbol-name (car it)) ": " (cdr it)))))
+                (seq-filter (lambda (it) (cdr it)))
+                (seq-map
+                 (lambda (it)
+                   (concat (symbol-name (car it)) ": " (cdr it)))))
    " "))
 
 (defun dtache--duration-str (session)
diff --git a/test/dtache-shell-test.el b/test/dtache-eshell-test.el
similarity index 58%
copy from test/dtache-shell-test.el
copy to test/dtache-eshell-test.el
index 7746f6f45e..e3574c972a 100644
--- a/test/dtache-shell-test.el
+++ b/test/dtache-eshell-test.el
@@ -1,6 +1,6 @@
-;;; dtache-shell-test.el --- Tests for dtache-shell.el -*- lexical-binding: t; 
-*-
+;;; dtache-eshell-test.el --- Tests for dtache-eshell.el -*- lexical-binding: 
t; -*-
 
-;; Copyright (C) 2020-2021  Niklas Eklund
+;; Copyright (C) 2021  Niklas Eklund
 
 ;; Author: Niklas Eklund <niklas.eklund@posteo.net>
 ;; Url: https://gitlab.com/niklaseklund/dtache
@@ -22,27 +22,15 @@
 
 ;;; Commentary:
 
-;; Tests for `dtache-shell'.
+;; Tests for `dtache-eshell'.
 
 ;;; Code:
 
 (require 'ert)
-(require 'dtache-shell)
+(require 'dtache-eshell)
 
 ;;;; Tests
 
-(ert-deftest dtache-shell-test-filter-eof ()
-  (let ((str "
-[EOF - dtach terminating]
-user@machine "))
-    (should (string= "
\nuser@machine " (dtache-shell-filter-dtach-eof str)))))
+(provide 'dtache-eshell-test)
 
-(ert-deftest dtache-shell-test-filter-detached ()
-  (let ((str "
-[detached]
-user@machine "))
-    (should (string= "
\nuser@machine " (dtache-shell-filter-dtach-detached str)))))
-
-(provide 'dtache-shell-test)
-
-;;; dtache-shell-test.el ends here
+;;; dtache-eshell-test.el ends here
diff --git a/test/dtache-shell-test.el b/test/dtache-shell-test.el
index 7746f6f45e..5e5e38e27b 100644
--- a/test/dtache-shell-test.el
+++ b/test/dtache-shell-test.el
@@ -31,18 +31,6 @@
 
 ;;;; Tests
 
-(ert-deftest dtache-shell-test-filter-eof ()
-  (let ((str "
-[EOF - dtach terminating]
-user@machine "))
-    (should (string= "
\nuser@machine " (dtache-shell-filter-dtach-eof str)))))
-
-(ert-deftest dtache-shell-test-filter-detached ()
-  (let ((str "
-[detached]
-user@machine "))
-    (should (string= "
\nuser@machine " (dtache-shell-filter-dtach-detached str)))))
-
 (provide 'dtache-shell-test)
 
 ;;; dtache-shell-test.el ends here
diff --git a/test/dtache-test.el b/test/dtache-test.el
index 46134ab602..a90c94c1d4 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -70,15 +70,20 @@
 ;;;; Tests
 
 (ert-deftest dtache-test-dtach-command ()
-  (cl-letf* (((symbol-function #'dtache--magic-command) (lambda (_) "command"))
-             (dtache-shell-program "zsh")
-             (dtache-dtach-program "/usr/bin/dtach")
-             (dtache--dtach-mode 'create)
-             (actual
-              (dtache-dtach-command
-               (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/")))
-             (expected `(, "-c" "/tmp/dtache/s12345.socket" "-z" "zsh" "-c" 
"command")))
-    (should (equal expected actual))))
+  (dtache-test--with-temp-database
+   (cl-letf* ((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)))))
+     (should (equal expected (dtache-dtach-command "ls -la"))))))
 
 (ert-deftest dtache-test-metadata ()
   ;; No annotators
@@ -186,41 +191,29 @@
      (should (equal copy (car (dtache--db-get-sessions)))))))
 
 (ert-deftest dtache-test-magic-command ()
-  ;; Redirect only without dtache-env
-  (let* ((dtache-env nil)
-         (dtache-shell-program "bash")
-         (actual
-          (dtache--magic-command
-           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls" :redirect-only t)))
-         (expected "{ (bash -c ls); } &> /tmp/dtache/s12345.log"))
-    (should (string= actual expected)))
-
-  ;; Normal without dtache-env
-  (let* ((dtache-env nil)
-         (dtache-shell-program "bash")
-         (actual
-          (dtache--magic-command
-           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls")))
-         (expected "{ (bash -c ls); } 2>&1 | tee /tmp/dtache/s12345.log"))
-    (should (string= actual expected)))
-
-  ;; Redirect only with dtache-env
-  (let* ((dtache-env "dtache-env")
-         (dtache-shell-program "bash")
-         (actual
-          (dtache--magic-command
-           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls" :redirect-only t)))
-         (expected "{ dtache-env ls; } &> /tmp/dtache/s12345.log"))
-    (should (string= actual expected)))
-
-  ;; Normal with dtache-env
-  (let* ((dtache-env "dtache-env")
-         (dtache-shell-program "bash")
-         (actual
-          (dtache--magic-command
-           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls")))
-         (expected "{ dtache-env ls; } 2>&1 | tee /tmp/dtache/s12345.log"))
-    (should (string= actual expected))))
+  (let ((normal-session (dtache--session-create :session-directory 
"/tmp/dtache/"
+                                                :working-directory 
"/home/user/"
+                                                :command "ls -la"
+                                                :id 'foo123))
+        (redirect-session (dtache--session-create :session-directory 
"/tmp/dtache/"
+                                                :working-directory 
"/home/user/"
+                                                :command "ls -la"
+                                                :redirect-only t
+                                                :id 'foo123)))
+    ;; With dtache-env
+    (let ((dtache-env "dtache-env"))
+      (should (string= "{ dtache-env ls\\ -la; } 2>&1 | tee 
/tmp/dtache/foo123.log"
+                       (dtache--magic-command normal-session)))
+      (should (string= "{ dtache-env ls\\ -la; } &> /tmp/dtache/foo123.log"
+                       (dtache--magic-command redirect-session))))
+
+    ;; Without dtache-env
+    (let ((dtache-env nil)
+          (dtache-shell-program "bash"))
+      (should (string= "{ bash -c ls\\ -la; } 2>&1 | tee 
/tmp/dtache/foo123.log"
+                       (dtache--magic-command normal-session)))
+      (should (string= "{ bash -c ls\\ -la; } &> /tmp/dtache/foo123.log"
+                       (dtache--magic-command redirect-session))))))
 
 (ert-deftest dtache-test-redirect-only-p ()
   (let ((dtache-redirect-only-regexps '("ls")))
@@ -274,6 +267,26 @@
             (dtache--working-dir-str
              (dtache--session-create :working-directory "~/repo")))))
 
+;;;;; Output filters
+
+(ert-deftest dtache-test-dtach-eof-message-filter ()
+  (let ((str "
+[EOF - dtach terminating]
+user@machine "))
+    (should (string= "
user@machine " (dtache--dtach-eof-message-filter str)))))
+
+(ert-deftest dtache-test-dtach-detached-message-filter ()
+  (let ((str "
+[detached]
+user@machine "))
+    (should (string= "
user@machine " (dtache--dtach-detached-message-filter str)))))
+
+(ert-deftest dtache-test-dtache-env-message-filter ()
+  (let ((str "output\n\nDtache session exited abnormally with code 127"))
+    (should (string= "output\n" (dtache--dtache-env-message-filter str))))
+  (let ((str "output\n\nDtache session finished"))
+    (should (string= "output\n" (dtache--dtache-env-message-filter str)))))
+
 (provide 'dtache-test)
 
 ;;; dtache-test.el ends here



reply via email to

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