branch: externals/dtache
commit f6c9710c1b100adb5bbb58b3f648b2a2e649c3b6
Author: Niklas Eklund <niklas.ekl...@posteo.net>
Commit: Niklas Eklund <niklas.ekl...@posteo.net>
Merge develop branch into master
This commit contains:
- An updated README.org
- A documentation folder with a demo.org file
- Functionality to determine status of a session
- Add diff session command
- Improve string representations
- Introduce dtache-env script
---
README.org | 280 ++++++++++++++++++++--------------
documentation/demo.org | 204 +++++++++++++++++++++++++
dtache-shell.el | 2 +-
dtache.el | 405 ++++++++++++++++++++++++++-----------------------
embark-dtache.el | 9 +-
marginalia-dtache.el | 14 +-
test/dtache-test.el | 74 +++++----
7 files changed, 643 insertions(+), 345 deletions(-)
diff --git a/README.org b/README.org
index e106a27c14..405fdded31 100644
--- a/README.org
+++ b/README.org
@@ -7,33 +7,114 @@
:description: Why Dtache?
:end:
- =Dtache= allows a program to be seamlessly executed in an environment that
is isolated from =Emacs= which made possible by the
[[https://github.com/crigler/dtach][dtach]] program. This package makes sure
that, even though programs are running in isolated sessions, they get tightly
integrated with Emacs.
-
- The =dtache= package is split up into two, =dtache.el= and
=dtache-shell.el=. The former provides the backend implementation, whilst the
former provides the integration with =M-x shell=.
-
-** Screenshots
-
-TBD
+ =Dtache=, or =Detach Emacs=, is a package to run shell commands in sessions
that are isolated from Emacs. =Dtache= also provides a convenient user
interface to interact with the sessions.
+
+ The package sprung out of the realization that I would run certain shell
commands in a terminal outside of Emacs instead of using =M-x shell=. These
situations were I didn't chose Emacs was either:
+ - Because of performance reasons, the built in shell is not the fastest when
there is a lot of output
+ - Because of stability concerns, I didn't want to have Emacs freeze or crash
have an effect on the shell command I was running
+ - Because of remote capabilities, I would be using
[[https://github.com/tmux/tmux][Tmux]] on a remote host in order to run a
command and detach from it
+ But running shell commands outside of Emacs meant missing out on all the
nice features that comes from an Emacs workflow.
+
+ The solution for me has been =dtache=. The package allows users to start
sessions, which will keep on running, even if Emacs itself is shut down. This
is a feature provided by the program
[[https://github.com/crigler/dtach][dtach]]. The package takes all of the
previous benefits of using an external terminal and provides them in the
package and at the same time offers a lot of other capabilities, provided by
Emacs.
+
+** Features
+
+Here is a list of features that =dtache= provides for a session.
+
+ - =Output=: The user have access to all output from a session
+ - =Notification=: The user gets a notification when a session has finished
+ - =Status=: Sessions are automatically labeled success or failure
+ - =Remote=: Sessions can be started on remote hosts, effectively becoming a
lightweight alternative to Tmux
+ - =Duration=: The user is informed about for how long a session has run, or
ran, if the session has finished
+ - =Compile=: The user can chose to compile the output from a session, which
effectively mimics =M-x compile=
+ - =Tail=: The user can chose to tail the output of an active session
+ - =Metadata=: The user can add annotators which are used to capture metadata
about the environment from which the session was started
+ - =Diff=: The user can compare two sessions in order to see differences in
the session outputs
+ - =Rerun=: The user can chose to rerun a session, which will rerun the
command on the right host, in the correct working directory
+ - =Open=: The user can quickly open a session in a Do What I Mean fashion:
+ + If the session is active the output is tailed
+ + If the session has the status success the output is opened
+ + If the session has the status failure the session is compiled
+
+ To see examples of the features listed above please see the following
presentation =PLACEHOLDER=.
* Configuration
-** Use-package examples
-*** Dtache
+** Dtache
-Configuration for the =dtache= package. This package provides the backend for
=dtache=.
+A minimal configuration for =dtache=.
#+begin_src elisp
(use-package dtache
:hook (after-init . dtache-initialize)
:config
;; Configure `dtache'
- (setq dtache-db-directory (no-littering-expand-var-file-name "dtache"))
- (setq dtache-session-directory (expand-file-name "dtache"
(temporary-file-directory)))
+ (setq dtache-db-directory user-emacs-directory)
+ (setq dtache-session-directory (expand-file-name "dtache"
(temporary-file-directory))))
+#+end_src
+
+** The dtache-env script
+
+Create an executable shell script, named =dtache-env=, which will be used as a
wrapper for the shell commands we are running.
+
+#+begin_src sh
+ #!/usr/bin/env bash
+
+ dtache_command="$*"
+
+ if eval "$dtache_command"; then
+ echo -e "\nDtache session finished"
+ else
+ echo -e "\nDtache exited abnormally with code $?"
+ fi
+#+end_src
+
+Either put it somewhere in path or customize the =dtache-env= variable so that
it refers to the script.
- ;; Exclude dtache log files from `recentf'
- (add-to-list 'recentf-exclude (rx (regexp "dtache.*\.log"))))
+#+begin_src elisp
+ (setq dtache-env "/path/to/dtache-env")
#+end_src
-*** Dtache-shell
+This script is necessary in order for =dtache= to get information about the
exit status of a session.
+
+* Commands
+** Creating a session
+
+There are tree different ways to create a dtache session.
+
+| Function | Description |
+|-------------------------------+-----------------------------|
+| =dtache-shell-command= | Call with M-x |
+| =dtache-start-session= | Call from within a function |
+| =dtache-shell-create-session= | Call from inside M-x shell |
+
+** List sessions
+
+There are two convenient ways of listing sessions and acting upon one.
+
+| Function | Description |
+|------------------------+---------------------------------|
+| =dtache-list-sessions= | Tabulated list view of sessions |
+| =dtache-open-session= | Completion based selection |
+
+** Actions on sessions
+
+General commands that can be used either in =dtache-list-sessions= or in
=dtache-open-session= (using the embark extension).
+
+| Command | Description |
+|-------------------------------+---------------------------------------------|
+| dtache-open-output | Open a session's output |
+| dtache-tail-output | Tail the output of an active session |
+| dtache-diff-session | Diff a session with another session |
+| dtache-compile-session | Open the session output in compilation mode |
+| dtache-rerun-session | Rerun a session |
+| dtache-insert-session-command | Insert the session's command at point |
+| dtache-copy-session-command | Copy the session's shell command |
+| dtache-copy-session-output | Copy the session's output |
+| dtache-kill-session | Kill an active session |
+| dtache-remove-session | Remove an inactive session |
+
+* Extensions
+** Dtache-shell
Configuration for the =dtache-shell= package. This package provides the
integration with =M-x shell=.
@@ -48,40 +129,26 @@ Configuration for the =dtache-shell= package. This package
provides the integrat
(setq dtache-shell-history-file "~/.bash_history"))
#+end_src
-*** Metadata annotators
-
-Create a custom function that captures the branch name if the session is
started in a git repository.
-
-#+begin_src elisp
- (defun dtache--session-git-branch ()
- "Return current git branch."
- (let ((git-directory (locate-dominating-file "." ".git")))
- (when git-directory
- (let ((args '("name-rev" "--name-only" "HEAD")))
- (with-temp-buffer
- (apply #'process-file `("git" nil t nil ,@args))
- (string-trim (buffer-string)))))))
-#+end_src
-
-Configure the metadata annotators list so that it runs your annotator.
+Commands to be used in shell buffers.
-#+begin_src elisp
- (setq dtache-metadata-annotators-alist '((branch .
dtache--session-git-branch))
-#+end_src
+| Command | Description |
+|-------------------------+-----------------------------|
+| dtache-shell-create | Create a session |
+| dtache-shell-attach | Attach to a session |
+| dtache-shell-detach | Detach from a session |
-** Integration with other packages
-*** Embark
+** Embark
-Add [[https://github.com/oantolin/embark/][embark]] actions to =dtache=
session commands.
+Add [[https://github.com/oantolin/embark/][embark]] actions to
=dtache-open-session=.
#+begin_src elisp
(use-package embark-dtache
:after (dtache embark))
#+end_src
-*** Marginalia
+** Marginalia
- Add [[https://github.com/minad/marginalia/][marginalia]] annotations to
enrich the =dtache= session commands.
+ Add [[https://github.com/minad/marginalia/][marginalia]] annotations to
enrich =dtache-open-session=.
#+begin_src elisp
(use-package marginalia-dtache
@@ -90,105 +157,87 @@ Add [[https://github.com/oantolin/embark/][embark]]
actions to =dtache= session
(add-to-list 'marginalia-annotators-heavy '(dtache .
marginalia-dtache-annotate)))
#+end_src
-** Remote support
+* Tips & Tricks
+** System notifications
-The =dtache= package supports
[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Connection-Local-Variables.html][Connection
Local Variables]] which allows the user to change the variables used by
=dtache= when running on a remote host.
+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
- (connection-local-set-profile-variables
- 'remote-dtache
- '((dtache-shell . "/bin/bash")
- (dtache-shell-history-file . "~/.bash_history")
- (dtache-session-directory . "~/tmp")
- (dtache-dtach-program . "/home/user/.local/bin/dtach")))
-
- (connection-local-set-profiles
- '(:application tramp :protocol "ssh") 'remote-dtache)
+ (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
-** Degraded mode
-
-Occasionally the =dtache= user might run into shell commands that don't play
well with the package. The symptom is that the logs are not updated until the
session finish, which removes a lot of the use-case for dtache. To mitigate the
problem dtache can be instructed to run in a degraded mode for those commands.
This is done by adding a regexp that matches the troublesome command and add it
to the list =dtache-degraded-list=.
+With the usage of =advice= the user can override the default implantation with
the alert version.
#+begin_src elisp
- (setq dtache-degraded-list '("foo"))
+ (advice-add 'dtache-session-finish-notification :override
#'dtache-session-finish-alert)
#+end_src
-In degraded mode =dtache= will skip the usage of =tee= and instead redirect
all the outputs to the dtache log. Use =dtache-tail-log= to tail the output
from the session. It's still possible to attach in the terminal but there is no
output forwarded to it.
-
-** Notification
+** Metadata annotators
-Make =dtache= send a notification once a session is finished. This would only
make sense to add for sessions on the localhost. Add the following advice to
the config.
+The user can configure any number of annotators to run upon creation of a
session. Here is an example of an annotator which captures the branch name if
the session is started in a git repository.
#+begin_src elisp
- (defun dtache-session-finish-notification-a (session)
- "Send a notification when SESSION finish."
- (let* ((min-duration 5.0)
- (send-alert (> (dtache--session-duration session) min-duration)))
- (if send-alert
- (alert (format "Command: %s" (dtache--session-command session))
- :title (format "Dtache session finished!")
- :severity 'moderate
- :category 'compile
- :id 'compile-ok)
- (message "Dtache finished session: %s"
- (dtache--session-command session)))))
+ (defun dtache--session-git-branch ()
+ "Return current git branch."
+ (let ((git-directory (locate-dominating-file "." ".git")))
+ (when git-directory
+ (let ((args '("name-rev" "--name-only" "HEAD")))
+ (with-temp-buffer
+ (apply #'process-file `("git" nil t nil ,@args))
+ (string-trim (buffer-string)))))))
#+end_src
+The user only needs to add this function to the list of annotators.
+
#+begin_src elisp
- (advice-add 'dtache-session-finish-notification :override
#'dtache-session-finish-notification-a)
+ (setq dtache-metadata-annotators-alist '((branch .
dtache--session-git-branch))
#+end_src
-** Evil bindings
+** Remote support
-#+begin_src elisp
- (general-def '(normal motion) dtache-sessions-mode-map
- "<return>" #'dtache-open-session
- "e" #'dtache-open-stderr
- "c" #'dtache-compile-session
- "d" #'dtache-remove-session
- "gr" #'dtache-list-sessions
- "K" #'dtache-kill-session
- "L" #'dtache-open-log
- "o" #'dtache-open-stdout
- "r" #'dtache-rerun-session
- "t" #'dtache-tail-log
- "w" #'dtache-copy-session-command
- "W" #'dtache-copy-session-log)
- (general-def '(motion normal) dtache-log-mode-map
- "q" #'kill-buffer-and-window)
- (general-def '(motion normal) dtache-tail-mode-map
- "q" #'dtache-quit-tail-log)
-#+end_src
+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.
-* Commands
+#+begin_src elisp
+ (connection-local-set-profile-variables
+ 'remote-dtache
+ '((dtache-env . "~/bin/dtache-env")
+ (dtache-shell-program . "/bin/bash")
+ (dtache-shell-history-file . "~/.bash_history")
+ (dtache-session-directory . "~/tmp")
+ (dtache-dtach-program . "/home/user/.local/bin/dtach")))
-The following is a list of commands that can be run on =dtache= sessions.
+ (connection-local-set-profiles
+ '(:application tramp :protocol "ssh") 'remote-dtache)
+#+end_src
-** Dtache-shell
+** Redirect only
-Commands to be used in shell buffers.
+Some programs doesn't play well with =tee= which =dtache= relies upon to
redirect the output both to standard out as well as to file. If you encounter a
situation where output from a session is only visible once it has finished
running, the command you launched should instead be using =redirect only=. To
list a command to run with redirect only in the future can be done by adding a
regexp to =dtache-redirect-only-regexps=.
-| Command | Description |
-|-------------------------+-----------------------------|
-| dtache-shell-create | Create a session |
-| dtache-shell-attach | Attach to a session |
-| dtache-shell-detach | Detach from a session |
+#+begin_src elisp
+ (setq dtache-read-only-list '("^ls"))
+#+end_src
-** Dtache
+Here the command beginning with =ls= would from now on be using redirect only.
-General commands that can be used anywhere.
+** Evil bindings
-| Command | Description |
-|-----------------------------+---------------------------------------------|
-| dtache-open-log | Open the output log for a session |
-| dtache-open-stdout | Open the stdout for a session |
-| dtache-open-stderr | Open the stderr for a session |
-| dtache-copy-session-command | Copy the session command |
-| dtache-copy-session-log | Copy the log output of a session |
-| dtache-kill-session | Kill a session |
-| dtache-remove-session | Remove a session |
-| dtache-compile-session | Open the session output in compilation mode |
+For inspiration on how to configure =dtache-list-sessions= to use evil
bindings see
[[https://gitlab.com/niklaseklund/dotfiles/blob/master/.config/emacs/init.el#L1393][Niklas
Eklund's Emacs config]].
* Tips & Tricks
** Advice functions
@@ -213,9 +262,4 @@ The following two functions are examples on how to create
functions that can be
* Credits
-The inspiration for the package comes from ~ambrevar's~
[[https://github.com/Ambrevar/dotfiles/blob/master/.emacs.d/lisp/package-eshell-detach.el][package-eshell-detach]].
-
-* TODO Things to do before next release
-- [X] Update header documentation in files
-- [ ] Squash the development from the branch and merge to master
-- [ ] Update the README.org file
+I got inspired by =Ambrevar's= pursuits on
[[https://ambrevar.xyz/emacs-eshell/][using eshell as his main shell]], and his
[[https://github.com/Ambrevar/dotfiles/blob/master/.emacs.d/lisp/package-eshell-detach.el][package-eshell-detach]]
got me into the idea of using =dtach= as a base for detachable shell commands.
diff --git a/documentation/demo.org b/documentation/demo.org
new file mode 100644
index 0000000000..df520614a3
--- /dev/null
+++ b/documentation/demo.org
@@ -0,0 +1,204 @@
+#+title: dtache.el - Dtach Emacs
+#+author: Niklas Eklund
+#+language: en
+
+* COMMENT Preparations
+
+A simple script that runs for 20 seconds.
+
+#+begin_src sh :tangle /tmp/dtache/loop.sh :tangle-mode (identity #o755)
+ for i in {1..20} ; do sleep 1; echo "$i" ; done
+#+end_src
+
+Tangle the code block above into a shell script.
+
+#+begin_src elisp :results none
+ (call-interactively #'org-babel-tangle-file)
+#+end_src
+
+Need to make sure =ediff= behaves.
+
+#+begin_src elisp :results none
+ (let ((window-conf))
+ (add-hook 'ediff-before-setup-hook
+ (defun ne/ediff-save-window-conf ()
+ (setq window-conf (current-window-configuration))))
+ (dolist (hook '(ediff-quit-hook ediff-suspended-hook))
+ (add-hook hook (defun ne/ediff-restore-window-conf ()
+ (set-window-configuration window-conf)))))
+#+end_src
+
+* Introduction
+
+ =Dtache=, or =Detach Emacs=, is a package to run shell commands in sessions
that are isolated from Emacs. The name of the package comes from
[[https://github.com/crigler/dtach][dtach]], which is the program that makes
this package possible.
+
+ The inspiration for the package comes from those situations where I would
chose to run commands in a terminal outside of Emacs.
+
+* How do I?
+** Start a session
+*** With M-x
+
+A session can be started with the command =dtache-shell-command=.
+
+#+begin_src elisp :results none
+ (call-interactively #'dtache-shell-command)
+#+end_src
+
+*** With a function
+
+A session can also be started with the =dtache-start-session= function. Which
can be included in custom commands.
+
+#+begin_src elisp :results none :dir ~/code/python
+ (dtache-start-session "pylint demo.py ")
+#+end_src
+
+*** With shell
+
+A session can also be started from =M-x shell=, making it a dispatcher for
=dtache= sessions.
+
+#+begin_src elisp :results none
+ (call-interactively #'shell)
+#+end_src
+
+Run the following command.
+
+#+begin_src sh
+ sleep 10 && ls -la
+#+end_src
+
+** Interact with a session
+
+To list all sessions.
+
+#+begin_src elisp :results none
+ (dtache-list-sessions)
+#+end_src
+
+The commands that are available.
+
+| Command | Description | Keybinding |
+|-------------------------------+------------------------------+------------|
+| =dtache-open-session= | A DWIM function | Return |
+| =dtache-compile-session= | Post compilation | c |
+| =dtache-remove-session= | Remove a session | d |
+| =dtache-kill-session= | Kill an active session | k |
+| =dtache-open-output= | Open sessions output | o |
+| =dtache-rerun-session= | Rerun a session | r |
+| =dtache-tail-session= | Tail the output of a session | t |
+| =dtache-copy-session-command= | Copy command | w |
+| =dtache-copy-session-output= | Copy the output | W |
+
+* Configuration
+** Annotators
+
+An annotator function runs when a session is started. Its intent is to capture
metadata information.
+
+#+begin_src elisp :results none
+ (defun dtache--session-git-branch ()
+ "Return current git branch."
+ (let ((git-directory (locate-dominating-file "." ".git")))
+ (when git-directory
+ (let ((args '("name-rev" "--name-only" "HEAD")))
+ (with-temp-buffer
+ (apply #'process-file `("git" nil t nil ,@args))
+ (string-trim (buffer-string)))))))
+#+end_src
+
+Register the annotator function.
+
+#+begin_src elisp :results none
+ (setq dtache-metadata-annotators-alist '((branch .
dtache--session-git-branch)))
+#+end_src
+
+Create a session.
+
+#+begin_src elisp :results none :dir ~/src/emacs-packages/dtache
+ (dtache-start-session "sleep 2 && ls")
+#+end_src
+
+** External package integration
+
+Here are some examples on how =dtache= can be further improved with external
packages.
+
+*** Embark & Marginalia
+
+The command =dtache-open-session= is an alternative to the
=dtache-list-sessions=.
+
+#+begin_src elisp :results none
+ (call-interactively #'dtache-open-session)
+#+end_src
+
+The =dtache-open-session= can be enhanced with
[[https://github.com/minad/marginalia/][marginalia]] annotations.
+
+#+begin_src elisp :results none
+ (use-package marginalia-dtache
+ :after (dtache marginalia)
+ :config
+ (setq dtache-max-command-length 50)
+ (add-to-list 'marginalia-annotator-registry '(dtache
marginalia-dtache-annotate builtin none)))
+#+end_src
+
+The =dtache-open-session= can also be given actions through
[[https://github.com/oantolin/embark/][embark]].
+
+#+begin_src elisp :results none
+ (use-package embark-dtache
+ :after (dtache embark))
+#+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 :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)))))
+
+ (advice-add 'dtache-session-finish-notification :override
#'dtache-session-finish-alert)
+#+end_src
+
+A successful session.
+
+#+begin_src elisp :results none :dir ~/src/emacs-packages/dtache
+ (dtache-start-session "ls")
+#+end_src
+
+A failing session.
+
+#+begin_src elisp :results none :dir ~/src/emacs-packages/dtache
+ (dtache-start-session "lsl")
+#+end_src
+
+* Other use cases
+** Remote execution
+
+=Dtache= has support for remote execution which is made possible through
=TRAMP=. The only difference from a users perspective is that there might be
some delay before the notification is issued.
+
+#+begin_src elisp :dir /ssh:pi:~/bin :results none
+ (dtache-start-session "sleep 5 && ls -la")
+#+end_src
+
+** Duration
+
+The duration becomes very valuable when the shell commands are deterministic.
+
+** Diff two sessions
+
+In combination with the =git-branch= annotator the =dtache-diff-session=
command becomes useful in comparing two sessions.
+
+** Transient combo
+
+[[https://github.com/magit/transient][Transient]] and =dtache= plays very well
together. At work I use the power of transient to compose shell commands and
=dtache= to run them.
diff --git a/dtache-shell.el b/dtache-shell.el
index 74fa248c8c..cb0b3db74e 100755
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -151,7 +151,7 @@ cluttering the comint-history with dtach commands."
(concat
(dtache--session-session-directory dtache-shell--current-session)
(dtache--session-id dtache-shell--current-session)
- dtache--socket-ext))
+ ".socket"))
(input
(concat dtache-dtach-program " " (dtache--dtach-arg) " " socket)))
(comint-simple-send proc input)))
diff --git a/dtache.el b/dtache.el
index a4d201cc23..17e8795066 100644
--- a/dtache.el
+++ b/dtache.el
@@ -1,4 +1,4 @@
-;;; dtache.el --- Run and manage detached commands -*- lexical-binding: t -*-
+;;; dtache.el --- Dispatch and interact with dtache sessions -*-
lexical-binding: t -*-
;; Copyright (C) 2020-2021 Niklas Eklund
@@ -59,10 +59,12 @@
"The name of the `dtach' program.")
(defvar dtache-shell-program "bash"
"Shell to run the dtach command in.")
-(defvar dtache-max-command-length 95
+(defvar dtache-env "dtache-env"
+ "The name of the `dtache' program.")
+(defvar dtache-max-command-length nil
"Maximum length of displayed command.")
-(defvar dtache-degraded-list '()
- "Regexps for commands that should be run in dedgraded mode.")
+(defvar dtache-redirect-only-regexps '()
+ "Regexps for commands that should be run with redirect only.")
(defvar dtache-tail-interval 2
"Interval in seconds for the update rate when tailing a session.")
(defvar dtache-session-type nil
@@ -71,11 +73,10 @@
"Custom function to use to open a session.")
(defvar dtache-session-callback-function nil
"Custom function to callback when a session finish.")
+(defvar dtache-session-status-function #'dtache-session-exit-code-status
+ "Custom function to deduce the status of a session.")
(defvar dtache-compile-hooks nil
"Hooks to run when compiling a session.")
-(defvar dtache-dispatch-alist `((standard . dtache-tail-log)
- (shell . dtache-tail-log))
- "Specify function to open session with based on type.")
(defvar dtache-metadata-annotators-alist nil
"An alist of annotators for metadata.")
@@ -84,21 +85,12 @@
(defvar dtache--sessions-initialized nil
"Sessions are initialized.")
(defvar dtache--dtach-mode nil
- "Mode of operation.")
+ "Mode of operation for dtach.")
(defvar dtache--sessions nil
"A list of sessions.")
(defvar dtache--remote-session-timer nil
"Timer object for remote polling.")
-(defconst dtache--socket-ext ".socket"
- "The file name extension for the socket.")
-(defconst dtache--log-ext ".log"
- "The file name extension for combined stdout and stderr.")
-(defconst dtache--stdout-ext ".stdout"
- "The file name extension for stdout.")
-(defconst dtache--stderr-ext ".stderr"
- "The file name extension for stderr.")
-
;;;; Data structures
(cl-defstruct (dtache-session (:constructor dtache--session-create)
@@ -108,25 +100,23 @@
(type nil :read-only t)
(open-function nil :read-only t)
(callback-function nil :read-only t)
+ (status-function nil :read-only t)
(working-directory nil :read-only t)
(creation-time nil :read-only t)
(session-directory nil :read-only t)
(metadata nil :read-only t)
(host nil :read-only t)
- (degraded nil :read-only t)
+ (redirect-only nil :read-only t)
+ (status nil)
(duration nil)
- (log-size nil)
+ (output-size nil)
(active nil))
;;;; Commands
;;;###autoload
-(defun dtache-shell-command (command &optional suppress-output)
- "Execute COMMAND asynchronously with `dtache'.
-
-The input parameters are kept in sync with `async-shell-command'. If
-the optional parameters SUPPRESS-OUTPUT has a value the output buffer
-is not opened and the command will run in the background."
+(defun dtache-shell-command (command)
+ "Execute COMMAND asynchronously with `dtache'."
(interactive
(list
(read-shell-command (if shell-command-prompt-show-cwd
@@ -134,11 +124,10 @@ is not opened and the command will run in the background."
(abbreviate-file-name
default-directory))
"Dtache shell command: ")
- nil nil)
- current-prefix-arg))
+ nil nil)))
(let* ((inhibit-message t)
(dtache-session-type 'standard))
- (dtache-start-session command (not suppress-output))))
+ (dtache-start-session command)))
;;;###autoload
(defun dtache-list-sessions ()
@@ -159,12 +148,10 @@ is not opened and the command will run in the background."
(list (if (eq major-mode 'dtache-sessions-mode)
(tabulated-list-get-id)
(dtache-select-session))))
- (let* ((dispatch-function
- (or (dtache--session-open-function session)
- (alist-get (dtache--session-type session)
- dtache-dispatch-alist)
- #'dtache-open-log)))
- (funcall dispatch-function session)))
+ (if-let ((open-function
+ (dtache--session-open-function session)))
+ (funcall open-function session))
+ (dtache-open-dwim session))
;;;###autoload
(defun dtache-compile-session (session)
@@ -183,10 +170,11 @@ is not opened and the command will run in the background."
(with-current-buffer (get-buffer-create buffer-name)
(setq-local buffer-read-only nil)
(erase-buffer)
- (insert-file-contents file)
+ (insert (dtache-session-output session))
(setq-local default-directory
(dtache--session-working-directory session))
(run-hooks 'dtache-compile-hooks)
+ (dtache-log-mode)
(compilation-minor-mode)
(setq-local font-lock-defaults '(compilation-mode-font-lock-keywords
t))
(font-lock-mode)
@@ -209,14 +197,15 @@ is not opened and the command will run in the background."
(dtache-start-session (dtache--session-command session))))
;;;###autoload
-(defun dtache-copy-session-log (session)
+(defun dtache-copy-session-output (session)
"Copy SESSION's log."
(interactive
(list (if (eq major-mode 'dtache-sessions-mode)
(tabulated-list-get-id)
(dtache-select-session))))
- (dtache--file-content
- (dtache-session-file session 'log)))
+ (with-temp-buffer
+ (insert (dtache-session-output session))
+ (kill-new (buffer-string))))
;;;###autoload
(defun dtache-copy-session-command (session)
@@ -259,45 +248,62 @@ is not opened and the command will run in the background."
(dtache--kill-processes pid))))
;;;###autoload
-(defun dtache-open-log (session)
- "Open SESSION's log."
+(defun dtache-open-output (session)
+ "Open SESSION's output."
(interactive
(list (if (eq major-mode 'dtache-sessions-mode)
(tabulated-list-get-id)
(dtache-select-session))))
- (dtache--open-file session 'log))
+ (let* ((buffer-name
+ (format "*dtache-output-%s*"
+ (dtache--session-short-id session)))
+ (file-path
+ (dtache-session-file session 'log))
+ (tramp-verbose 1))
+ (if (file-exists-p file-path)
+ (progn
+ (with-current-buffer (get-buffer-create buffer-name)
+ (insert (dtache-session-output session))
+ (setq-local default-directory (dtache--session-working-directory
session))
+ (dtache-log-mode)
+ (goto-char (point-max)))
+ (pop-to-buffer buffer-name))
+ (message "Dtache can't find file: %s" file-path))))
;;;###autoload
-(defun dtache-tail-log (session)
- "Tail SESSION's log."
+(defun dtache-tail-output (session)
+ "Tail SESSION's output."
(interactive
(list (if (eq major-mode 'dtache-sessions-mode)
(tabulated-list-get-id)
(dtache-select-session))))
(if (dtache--session-active-p session)
- (dtache--tail-file session 'log)
- (dtache--open-file session 'log)))
-
-;;;###autoload
-(defun dtache-open-stdout (session)
- "Open SESSION's stdout."
- (interactive
- (list (if (eq major-mode 'dtache-sessions-mode)
- (tabulated-list-get-id)
- (dtache-select-session))))
- (dtache--open-file session 'stdout))
+ (let* ((file-path
+ (dtache-session-file session 'log))
+ (tramp-verbose 1))
+ (when (file-exists-p file-path)
+ (find-file-other-window file-path)
+ (dtache-tail-mode)
+ (goto-char (point-max))))
+ (dtache-open-output session)))
;;;###autoload
-(defun dtache-open-stderr (session)
- "Open SESSION's stderr."
+(defun dtache-diff-session (session1 session2)
+ "Diff SESSION1 with SESSION2."
(interactive
- (list (if (eq major-mode 'dtache-sessions-mode)
- (tabulated-list-get-id)
- (dtache-select-session))))
- (dtache--open-file session 'stderr))
+ (list
+ (dtache-select-session)
+ (dtache-select-session)))
+ (dtache--create-diff-buffer session1)
+ (dtache--create-diff-buffer session2)
+ (let ((buffer1 (format "*dtache-diff-%s*"
+ (dtache--session-short-id session1)))
+ (buffer2 (format "*dtache-diff-%s*"
+ (dtache--session-short-id session2))))
+ (ediff-buffers buffer1 buffer2)))
;;;###autoload
-(defun dtache-quit-tail-log ()
+(defun dtache-quit-tail-output ()
"Quit `dtache' tail log.
The log can have been updated, but that is not done by the user but
@@ -311,23 +317,12 @@ nil before closing."
;;;;; Session
-(defun dtache-start-session (command &optional show-output)
- "Start a `dtache' session running COMMAND optionally SHOW-OUTPUT."
+(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-setup-notification session)
- (when show-output
- (if (file-remote-p default-directory)
- (run-with-timer 0.1 nil (lambda () (dtache-tail-log session)))
- (file-notify-add-watch
- (dtache-session-file session 'log)
- '(change)
- (lambda (event)
- (pcase-let ((`(,_ ,action ,_) event))
- (when (eq action 'created)
- (dtache-tail-log session)))))))
-
(apply #'start-file-process
`("dtache" nil ,dtache-dtach-program ,@dtache-command))))
@@ -359,10 +354,8 @@ Sessions running on current host or localhost are
updated."
(concat
(dtache--session-id session)
(pcase file
- ('socket dtache--socket-ext)
- ('log dtache--log-ext)
- ('stdout dtache--stdout-ext)
- ('stderr dtache--stderr-ext))))
+ ('socket ".socket")
+ ('log ".log"))))
(directory (concat
(file-remote-p (dtache--session-working-directory session))
(dtache--session-session-directory session))))
@@ -384,10 +377,12 @@ Sessions running on current host or localhost are
updated."
(setf (dtache--session-active session) nil)
(setf (dtache--session-duration session)
(dtache--duration session))
+ (when-let ((status (dtache--session-status-function session)))
+ (setf (dtache--session-status session) (funcall status session)))
(dtache-session-finish-notification session)
(when-let ((callback (dtache--session-callback-function session)))
(funcall callback))))
- (setf (dtache--session-log-size session)
+ (setf (dtache--session-output-size session)
(file-attribute-size (file-attributes
(dtache-session-file session 'log))))
session)
@@ -405,7 +400,7 @@ Sessions running on current host or localhost are updated."
;; Remove missing local sessions
(seq-remove (lambda (it)
(and (string= "localhost"
(dtache--session-host it))
- (dtache--session-dead-p it))))
+ (dtache--session-missing-p it))))
;; Update local active sessions
(seq-map (lambda (it)
(if (and (string= "localhost"
(dtache--session-host it))
@@ -443,9 +438,49 @@ Sessions running on current host or localhost are
updated."
(seq-remove
(lambda (it)
(and (string= host (dtache--session-host it))
- (dtache--session-dead-p it)))
+ (dtache--session-missing-p it)))
dtache--sessions)))
+(defun dtache-session-exit-code-status (session)
+ "Return status based on exit-code in SESSION."
+ (with-temp-buffer
+ (insert-file-contents (dtache-session-file session 'log))
+ (goto-char (point-max))
+ (if (string-match "Dtache session finished" (thing-at-point 'line t))
+ 'success
+ 'failure)))
+
+(defun dtache-session-output (session)
+ "Return content of SESSION's output."
+ (let* ((filename (dtache-session-file session 'log))
+ (status (dtache--session-status session))
+ (remove-dtache-message (not (eq status 'unknown))))
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-max))
+ (when remove-dtache-message
+ (line-move -3)
+ (end-of-line))
+ (buffer-substring (point-min) (point)))))
+
+(defun dtache-session-finish-notification (session)
+ "Send a notification when SESSION finish."
+ (let ((status (pcase (dtache--session-status session)
+ ('success "Dtache finished")
+ ('failure "Dtache failed")) ))
+ (message "%s: %s" status (dtache--session-command session))))
+
+(defun dtache-open-dwim (session)
+ "Open SESSION in a do what I mean fashion."
+ (cond ((dtache--session-active session)
+ (dtache-tail-output session))
+ ((eq 'success (dtache--session-status session))
+ (dtache-open-output session))
+ ((eq 'failure (dtache--session-status session))
+ (dtache-compile-session session))
+ (t (progn (message "Unknown status of session.")
+ (dtache-open-output session)))))
+
;;;;; Other
(defun dtache-completing-read (sessions)
@@ -477,17 +512,17 @@ Sessions running on current host or localhost are
updated."
(with-connection-local-variables
(let* ((directory (dtache--session-session-directory session))
(file-name (dtache--session-id session))
- (socket (concat directory file-name dtache--socket-ext))
+ (socket (concat directory file-name ".socket"))
;; Construct the command line
- (commandline (dtache--output-command session))
- (dtache--dtach-mode (if (dtache--session-degraded session)
+ (command (dtache--magic-command session))
+ (dtache--dtach-mode (if (dtache--session-redirect-only session)
'new
dtache--dtach-mode)))
- `(,(dtache--dtach-arg) ,socket "-z" ,dtache-shell-program "-c"
,commandline))))
+ `(,(dtache--dtach-arg) ,socket "-z" ,dtache-shell-program "-c"
,command))))
-(defun dtache-degraded-p (command)
+(defun dtache-redirect-only-p (command)
"Return t if COMMAND should run in degreaded mode."
- (if (thread-last dtache-degraded-list
+ (if (thread-last dtache-redirect-only-regexps
(seq-filter (lambda (regexp)
(string-match-p regexp command)))
(length)
@@ -511,6 +546,15 @@ Sessions running on current host or localhost are
updated."
(unless (file-exists-p directory)
(make-directory directory t))))
+(defun dtache-get-working-directory ()
+ "Return an abreviated working directory path."
+ (let* ((remote (file-remote-p default-directory))
+ (full-home (if remote (expand-file-name remote) (expand-file-name
"~")))
+ (short-home (if remote (concat remote "~/") "~")))
+ (replace-regexp-in-string full-home
+ short-home
+ (expand-file-name default-directory))))
+
;;;; Support functions
;;;;; Session
@@ -524,10 +568,12 @@ Sessions running on current host or localhost are
updated."
:type dtache-session-type
:open-function dtache-open-session-function
:callback-function
dtache-session-callback-function
- :working-directory default-directory
- :degraded (dtache-degraded-p command)
+ :status-function
dtache-session-status-function
+ :working-directory
(dtache-get-working-directory)
+ :redirect-only (dtache-redirect-only-p
command)
:creation-time (time-to-seconds
(current-time))
- :log-size 0
+ :status 'unknown
+ :output-size 0
:session-directory (file-name-as-directory
dtache-session-directory)
:host (dtache--host)
:metadata (dtache-metadata)
@@ -544,7 +590,7 @@ Sessions running on current host or localhost are updated."
(concat
(dtache--session-session-directory session)
(dtache--session-id session)
- dtache--socket-ext))
+ ".socket"))
(regexp (rx-to-string `(and "dtach " (or "-n " "-c ") ,socket)))
(ps-args '("aux" "-w")))
(with-temp-buffer
@@ -567,20 +613,22 @@ Sessions running on current host or localhost are
updated."
(defun dtache--session-truncate-command (session)
"Return a truncated string representation of SESSION's command."
- (let ((command (dtache--session-command session))
- (part-length (- dtache-max-command-length 3)))
- (if (<= (length command) dtache-max-command-length)
- (let ((padding-length (- dtache-max-command-length (length command))))
- (concat command (make-string padding-length ?\s)))
- (concat
- (substring command 0 (/ part-length 2))
- "..."
- (substring command (- (length command) (/ part-length 2)) (length
command))))))
+ (if (null dtache-max-command-length)
+ (dtache--session-command session)
+ (let ((command (dtache--session-command session))
+ (part-length (- dtache-max-command-length 3)))
+ (if (<= (length command) dtache-max-command-length)
+ (let ((padding-length (- dtache-max-command-length (length
command))))
+ (concat command (make-string padding-length ?\s)))
+ (concat
+ (substring command 0 (/ part-length 2))
+ "..."
+ (substring command (- (length command) (/ part-length 2)) (length
command)))))))
(defun dtache--session-update (session)
"Update the `dtache' SESSION."
(setf (dtache--session-active session) (dtache--session-active-p session))
- (setf (dtache--session-log-size session) (file-attribute-size
+ (setf (dtache--session-output-size session) (file-attribute-size
(file-attributes
(dtache-session-file session
'log))))
session)
@@ -601,8 +649,8 @@ Sessions running on current host or localhost are updated."
(dtache--session-active session)
(not (file-exists-p (dtache-session-file session 'socket)))))
-(defun dtache--session-dead-p (session)
- "Return t if SESSION is dead."
+(defun dtache--session-missing-p (session)
+ "Return t if SESSION is missing."
(not
(file-exists-p
(dtache-session-file session 'log))))
@@ -613,6 +661,23 @@ Sessions running on current host or localhost are
updated."
(setq dtache--remote-session-timer
(run-with-timer 10 60 #'dtache-update-remote-sessions))))
+(defun dtache--create-diff-buffer (session)
+ "Create a diff buffer for SESSION."
+ (let ((buffer-name
+ (format "*dtache-diff-%s*"
+ (dtache--session-short-id session))))
+ (with-current-buffer (get-buffer-create buffer-name)
+ (erase-buffer)
+ (insert (format "Command: %s\n" (dtache--session-command session)))
+ (insert (format "Working directory: %s\n" (dtache--working-dir-str
session)))
+ (insert (format "Status: %s\n" (dtache--session-status session)))
+ (insert (format "Created at: %s\n" (dtache--creation-str session)))
+ (insert (format "Id: %s\n" (dtache--session-id session)))
+ (insert (format "Metadata: %s\n" (dtache--metadata-str session)))
+ (insert (format "Duration: %s\n" (dtache--duration-str session)))
+ (insert "\n")
+ (insert (dtache-session-output session)))))
+
;;;;; Database
(defun dtache--db-select-sessions ()
@@ -661,11 +726,6 @@ Sessions running on current host or localhost are
updated."
('attach "-a")
(_ "-n")))
-(defun dtache-session-finish-notification (session)
- "Send a notification when SESSION finish."
- (message "Dtache finished session: %s"
- (dtache--session-command session)))
-
(defun dtache--add-end-of-session-notification (session)
"Trigger an event when SESSION is stopped."
(file-notify-add-watch
@@ -675,9 +735,10 @@ Sessions running on current host or localhost are
updated."
(pcase-let ((`(,_ ,action ,_) event))
(when (eq action 'deleted)
;; Update session
- (setf (dtache--session-log-size session) (file-attribute-size
+ (setf (dtache--session-output-size session) (file-attribute-size
(file-attributes
(dtache-session-file
session 'log))))
+
(setf (dtache--session-active session) nil)
(setf (dtache--session-duration session)
(- (time-to-seconds) (dtache--session-creation-time session)))
@@ -685,6 +746,10 @@ Sessions running on current host or localhost are
updated."
;; Update session in database
(dtache--db-update-session session)
+ ;; Update status
+ (when-let ((status (dtache--session-status-function session)))
+ (setf (dtache--session-status session) (funcall status session)))
+
;; Send notification
(dtache-session-finish-notification session)
@@ -711,37 +776,21 @@ Sessions running on current host or localhost are
updated."
(seq-do (lambda (pid) (dtache--kill-processes pid)) child-processes)
(apply #'process-file `("kill" nil nil nil ,pid))))
-(defun dtache--output-command (session)
- "Return output command for SESSION."
- (if (dtache--session-degraded session)
- (dtache--output-to-file-command session)
- (dtache--output-to-both-command session)))
+(defun dtache--magic-command (session)
+ "Return the magic dtache command for SESSION.
-(defun dtache--output-to-file-command (session)
- "Return a command to send SESSION's output directly to log."
- (let* ((command (dtache--session-command session))
- (directory (dtache--session-session-directory session))
- (file-name (dtache--session-id session))
- (log (concat directory file-name dtache--log-ext)))
- ;; Construct the command line
- ;; echo &> log
- (format "{ %s; } &> %s" command log)))
-
-(defun dtache--output-to-both-command (session)
- "Return a command to send SESSION's output to both shell and log."
- (let* ((command (dtache--session-command session))
+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 (string-join
+ `(,dtache-env
+ ,dtache-shell-program "-c" "-i"
+ ,(shell-quote-argument (format "\"%s\""
(dtache--session-command session)))) " "))
(directory (dtache--session-session-directory session))
(file-name (dtache--session-id session))
- (stdout (concat directory file-name dtache--stdout-ext))
- (stderr (concat directory file-name dtache--stderr-ext))
- (log (concat directory file-name dtache--log-ext)))
- ;; Construct the command line
- ;; { { echo stdout; echo stderr >&2; } >>(tee stdout ); } 2>>(tee
stderr) | tee log
- (format "{ { %s; }%s }%s %s"
- (format "%s" command)
- (format " > >(tee %s );" stdout)
- (format " 2> >(tee %s )" stderr)
- (format " | tee %s" log))))
+ (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))))
(defun dtache--host ()
"Return name of host."
@@ -749,12 +798,6 @@ Sessions running on current host or localhost are
updated."
(file-remote-p default-directory 'host)
"localhost"))
-(defun dtache--file-content (file)
- "Copy FILE's content."
- (with-temp-buffer
- (insert-file-contents file)
- (kill-new (buffer-string))))
-
(defun dtache--duration (session)
"Return the time duration of the SESSION.
@@ -766,29 +809,6 @@ the current time is used."
(dtache-session-file session 'log))))
(dtache--session-creation-time session)))
-(defun dtache--open-file (session file)
- "Oen SESSION's FILE."
- (let* ((file-path
- (dtache-session-file session file))
- (tramp-verbose 1))
- (if (file-exists-p file-path)
- (progn
- (find-file-other-window file-path)
- (setq-local default-directory (dtache--session-working-directory
session))
- (dtache-log-mode)
- (goto-char (point-max)))
- (message "Dtache can't find file: %s" file-path))))
-
-(defun dtache--tail-file (session file)
- "Tail SESSION's FILE."
- (let* ((file-path
- (dtache-session-file session file))
- (tramp-verbose 1))
- (when (file-exists-p file-path)
- (find-file-other-window file-path)
- (dtache-tail-mode)
- (goto-char (point-max)))))
-
(defun dtache--create-id (command)
"Return a hash identifier for COMMAND."
(let ((current-time (current-time-string)))
@@ -826,21 +846,30 @@ the current time is used."
(dtache--session-creation-time session)))
(defun dtache--size-str (session)
- "Return the size of SESSION's log."
+ "Return the size of SESSION's output."
(file-size-human-readable
- (dtache--session-log-size session)))
+ (dtache--session-output-size session)))
-(defun dtache--degraded-str (session)
- "Return string if SESSION is degraded."
- (if (dtache--session-degraded session)
- "!"
- ""))
+(defun dtache--status-str (session)
+ "Return string if SESSION has failed."
+ (pcase (dtache--session-status session)
+ ('failure "!")
+ ('success " ")
+ ('unknown " ")))
(defun dtache--active-str (session)
"Return string if SESSION is active."
(if (dtache--session-active session)
"*"
- ""))
+ " "))
+
+(defun dtache--working-dir-str (session)
+ "Return working directory of SESSION."
+ (let ((working-directory
+ (dtache--session-working-directory session)))
+ (if-let ((remote (file-remote-p working-directory)))
+ (string-remove-prefix remote working-directory)
+ working-directory)))
;;;; Major modes
@@ -856,7 +885,7 @@ the current time is used."
(defvar dtache-tail-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "q") #'dtache-quit-tail-log)
+ (define-key map (kbd "q") #'dtache-quit-tail-output)
map)
"Keymap for `dtache-tail-mode'.")
@@ -877,13 +906,15 @@ the current time is used."
(define-derived-mode dtache-sessions-mode tabulated-list-mode "Dtache Sessions"
"Dtache sessions."
(setq tabulated-list-format
- `[("Command" ,dtache-max-command-length nil)
+ `[("Command" ,(or dtache-max-command-length 50) nil)
("Active" 10 nil)
- ("Directory" 30 nil)
+ ("Status" 10 nil)
("Host" 20 nil)
+ ("Directory" 40 nil)
+ ("Metadata" 30 nil)
("Duration" 10 nil)
- ("Created" 20 nil)
- ("ID" 8 nil)])
+ ("Size" 10 nil)
+ ("Created" 20 nil)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key nil)
(tabulated-list-init-header))
@@ -893,24 +924,24 @@ the current time is used."
`(,session
[,(dtache--session-command session)
,(dtache--active-str session)
- ,(dtache--session-working-directory session)
+ ,(dtache--status-str session)
,(dtache--session-host session)
+ ,(dtache--working-dir-str session)
+ ,(dtache--metadata-str session)
,(dtache--duration-str session)
- ,(dtache--creation-str session)
- ,(dtache--session-short-id session)]))
+ ,(dtache--size-str session)
+ ,(dtache--creation-str session)]))
(let ((map dtache-sessions-mode-map))
(define-key map (kbd "<return>") #'dtache-open-session)
(define-key map (kbd "c") #'dtache-compile-session)
(define-key map (kbd "d") #'dtache-remove-session)
- (define-key map (kbd "e") #'dtache-open-stderr)
(define-key map (kbd "k") #'dtache-kill-session)
- (define-key map (kbd "l") #'dtache-open-log)
- (define-key map (kbd "o") #'dtache-open-stdout)
+ (define-key map (kbd "o") #'dtache-open-output)
(define-key map (kbd "r") #'dtache-rerun-session)
- (define-key map (kbd "t") #'dtache-tail-log)
+ (define-key map (kbd "t") #'dtache-tail-output)
(define-key map (kbd "w") #'dtache-copy-session-command)
- (define-key map (kbd "W") #'dtache-copy-session-log))
+ (define-key map (kbd "W") #'dtache-copy-session-output))
(provide 'dtache)
diff --git a/embark-dtache.el b/embark-dtache.el
index 1f214c7d84..537fe970e6 100644
--- a/embark-dtache.el
+++ b/embark-dtache.el
@@ -40,15 +40,14 @@
"Keymap for Embark dtache actions."
("c" dtache-compile-session)
("d" dtache-remove-session)
- ("e" dtache-open-stderr)
("i" dtache-insert-session-command)
("k" dtache-kill-session)
- ("l" dtache-open-log)
- ("o" dtache-open-stdout)
+ ("o" dtache-open-output)
("r" dtache-rerun-session)
- ("t" dtache-tail-log)
+ ("t" dtache-tail-output)
("w" dtache-copy-session-command)
- ("W" dtache-copy-session-log))
+ ("W" dtache-copy-session-output)
+ ("=" dtache-diff-session))
(add-to-list 'embark-keymap-alist '(dtache . embark-dtache-map))
diff --git a/marginalia-dtache.el b/marginalia-dtache.el
index c1889be8f4..e1c82f8a4d 100644
--- a/marginalia-dtache.el
+++ b/marginalia-dtache.el
@@ -39,8 +39,10 @@
(defvar marginalia-dtache-metadata-length 30)
(defvar marginalia-dtache-duration-length 10)
+(defvar marginalia-dtache-working-dir-length 50)
(defvar marginalia-dtache-size-length 8)
(defvar marginalia-dtache-date-length 12)
+(defvar marginalia-dtache-host-length 10)
;;;; Faces
@@ -73,6 +75,14 @@
'((t :inherit marginalia-date))
"Face used to highlight date in `marginalia-mode'.")
+(defface marginalia-dtache-working-dir
+ '((t :inherit marginalia-symbol))
+ "Face used to highlight working directory in `marginalia-mode'.")
+
+(defface marginalia-dtache-host
+ '((t :inherit marginalia-function))
+ "Face used to highlight host in `marginalia-mode'.")
+
;;;; Functions
(defun marginalia-dtache-annotate (candidate)
@@ -81,7 +91,9 @@
(get-text-property 0 'dtache--data candidate)))
(marginalia--fields
((dtache--active-str session) :width 3 :face 'marginalia-dtache-active)
- ((dtache--degraded-str session) :width 3 :face 'marginalia-dtache-error)
+ ((dtache--status-str session) :width 3 :face 'marginalia-dtache-error)
+ ((dtache--session-host session) :truncate marginalia-dtache-host-length
:face 'marginalia-dtache-host)
+ ((dtache--working-dir-str session) :truncate
marginalia-dtache-working-dir-length :face 'marginalia-dtache-working-dir)
((dtache--metadata-str session) :truncate
marginalia-dtache-metadata-length :face 'marginalia-dtache-metadata)
((dtache--duration-str session) :truncate
marginalia-dtache-duration-length :face 'marginalia-dtache-duration)
((dtache--size-str session) :truncate marginalia-dtache-size-length :face
'marginalia-dtache-size)
diff --git a/test/dtache-test.el b/test/dtache-test.el
index e85a815215..b5edada4d2 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -37,7 +37,10 @@
"Initialize a dtache database and evaluate BODY."
`(let* ((temp-directory (make-temp-file "dtache" t))
(dtache-db-directory (expand-file-name "dtache.db" temp-directory))
- (dtache-session-directory (expand-file-name "sessions"
temp-directory)))
+ (dtache-session-directory (expand-file-name "sessions"
temp-directory))
+ (dtache--sessions)
+ (dtache--sessions-initialized)
+ (dtache--remote-session-timer))
(unwind-protect
(progn
(dtache-initialize)
@@ -56,19 +59,18 @@
"Set STATE of SESSION."
(pcase state
('activate
- (dolist (type `(socket log stderr))
+ (dolist (type `(socket log))
(with-temp-file (dtache-session-file session type))))
('deactivate
(delete-file (dtache-session-file session 'socket)))
('kill
(delete-file (dtache-session-file session 'socket))
- (delete-file (dtache-session-file session 'log))
- (delete-file (dtache-session-file session 'stderr)))))
+ (delete-file (dtache-session-file session 'log)))))
;;;; Tests
(ert-deftest dtache-test-dtach-command ()
- (cl-letf* (((symbol-function #'dtache--output-command) (lambda (_)
"command"))
+ (cl-letf* (((symbol-function #'dtache--magic-command) (lambda (_) "command"))
(dtache-shell-program "zsh")
(dtache-dtach-program "/usr/bin/dtach")
(dtache--dtach-mode 'create)
@@ -97,8 +99,6 @@
((symbol-function #'file-remote-p) (lambda (_directory) nil))
(session (dtache--session-create :id "12345" :session-directory
"/home/user/tmp/")))
(should (string= "/home/user/tmp/12345.log" (dtache-session-file session
'log)))
- (should (string= "/home/user/tmp/12345.stderr" (dtache-session-file
session 'stderr)))
- (should (string= "/home/user/tmp/12345.stdout" (dtache-session-file
session 'stdout)))
(should (string= "/home/user/tmp/12345.socket" (dtache-session-file
session 'socket))))
;; Remote files
@@ -106,8 +106,6 @@
((symbol-function #'file-remote-p) (lambda (_directory)
"/ssh:foo:"))
(session (dtache--session-create :id "12345" :session-directory
"/home/user/tmp/")))
(should (string= "/ssh:foo:/home/user/tmp/12345.log" (dtache-session-file
session 'log)))
- (should (string= "/ssh:foo:/home/user/tmp/12345.stderr"
(dtache-session-file session 'stderr)))
- (should (string= "/ssh:foo:/home/user/tmp/12345.stdout"
(dtache-session-file session 'stdout)))
(should (string= "/ssh:foo:/home/user/tmp/12345.socket"
(dtache-session-file session 'socket)))))
(ert-deftest dtache-test-session-short-id ()
@@ -139,11 +137,11 @@
(ert-deftest dtache-test-session-dead-p ()
(dtache-test--with-temp-database
(let ((session (dtache-test--create-session :command "foo" :host
"localhost")))
- (should (not (dtache--session-dead-p session)))
+ (should (not (dtache--session-missing-p session)))
(dtache-test--change-session-state session 'deactivate)
- (should (not (dtache--session-dead-p session)))
+ (should (not (dtache--session-missing-p session)))
(dtache-test--change-session-state session 'kill)
- (should (dtache--session-dead-p session)))))
+ (should (dtache--session-missing-p session)))))
(ert-deftest dtache-test-cleanup-host-sessions ()
(dtache-test--with-temp-database
@@ -185,27 +183,27 @@
(dtache--db-update-session session)
(should (equal session (car (dtache--db-select-sessions)))))))
-(ert-deftest dtache-test-output-command ()
- ;; Degraded
- (let* ((dtache-notify-send nil)
+(ert-deftest dtache-test-magic-command ()
+ ;; Redirect only
+ (let* ((dtache-shell-program "bash")
(actual
- (dtache--output-command
- (dtache--session-create :id "12345" :session-directory
"/tmp/dtache/" :command "ls" :degraded t)))
- (expected "{ ls; } &> /tmp/dtache/12345.log"))
+ (dtache--magic-command
+ (dtache--session-create :id "12345" :session-directory
"/tmp/dtache/" :command "ls" :redirect-only t)))
+ (expected "{ dtache-env bash -c -i \\\"ls\\\"; } &>
/tmp/dtache/12345.log"))
(should (string= actual expected)))
;; Normal
- (let* ((dtache-notify-send nil)
+ (let* ((dtache-shell-program "bash")
(actual
- (dtache--output-command
+ (dtache--magic-command
(dtache--session-create :id "12345" :session-directory
"/tmp/dtache/" :command "ls")))
- (expected "{ { ls; } > >(tee /tmp/dtache/12345.stdout ); } 2> >(tee
/tmp/dtache/12345.stderr ) | tee /tmp/dtache/12345.log"))
+ (expected "{ dtache-env bash -c -i \\\"ls\\\"; } 2>&1 | tee
/tmp/dtache/12345.log"))
(should (string= actual expected))))
-(ert-deftest dtache-test-degraded-p ()
- (let ((dtache-degraded-list '("ls")))
- (should (not (dtache-degraded-p "cd")))
- (should (dtache-degraded-p "ls -la"))))
+(ert-deftest dtache-test-redirect-only-p ()
+ (let ((dtache-redirect-only-regexps '("ls")))
+ (should (not (dtache-redirect-only-p "cd")))
+ (should (dtache-redirect-only-p "ls -la"))))
(ert-deftest dtache-test-session-pid ()
(cl-letf* (((symbol-function #'process-file) (lambda (_program _infile
_buffer _display &rest _args)
@@ -213,8 +211,7 @@
(session1 (dtache--session-create :id "foo" :session-directory
"/tmp/"))
(session2 (dtache--session-create :id "bar" :session-directory
"/tmp/"))
- (session3 (dtache--session-create :id "baz" :session-directory
"/tmp/"))
- (dtache--socket-ext ".socket"))
+ (session3 (dtache--session-create :id "baz" :session-directory
"/tmp/")))
(should (string= "6699" (dtache--session-pid session1)))
(should (string= "6698" (dtache--session-pid session2)))
(should (not (dtache--session-pid session3)))))
@@ -233,16 +230,27 @@
(should (string= "May 08 08:49" (dtache--creation-str
(dtache--session-create :creation-time 1620463748.7636228))))))
(ert-deftest dtache-test-size-str ()
- (should (string= "100" (dtache--size-str (dtache--session-create :log-size
100))))
- (should (string= "1k" (dtache--size-str (dtache--session-create :log-size
1024)))))
+ (should (string= "100" (dtache--size-str (dtache--session-create
:output-size 100))))
+ (should (string= "1k" (dtache--size-str (dtache--session-create :output-size
1024)))))
-(ert-deftest dtache-test-degraded-str ()
- (should (string= "!" (dtache--degraded-str (dtache--session-create :degraded
t))))
- (should (string= "" (dtache--degraded-str (dtache--session-create :degraded
nil)))))
+(ert-deftest dtache-test-status-str ()
+ (should (string= "!" (dtache--status-str (dtache--session-create :status
'failure))))
+ (should (string= " " (dtache--status-str (dtache--session-create :status
'success))))
+ (should (string= " " (dtache--status-str (dtache--session-create :status
'unknown)))))
(ert-deftest dtache-test-active-str ()
(should (string= "*" (dtache--active-str (dtache--session-create :active
t))))
- (should (string= "" (dtache--active-str (dtache--session-create :active
nil)))))
+ (should (string= " " (dtache--active-str (dtache--session-create :active
nil)))))
+
+(ert-deftest dtache-test-working-dir-str ()
+ (should
+ (string= "/home/user/repo"
+ (dtache--working-dir-str
+ (dtache--session-create :working-directory
"/ssh:remote:/home/user/repo"))))
+ (should
+ (string= "~/repo"
+ (dtache--working-dir-str
+ (dtache--session-create :working-directory "~/repo")))))
(provide 'dtache-test)
