[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/dtache b194f96af4 4/4: Migrate source code to detached.
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/dtache b194f96af4 4/4: Migrate source code to detached.el |
|
Date: |
Sat, 21 May 2022 17:57:30 -0400 (EDT) |
branch: externals/dtache
commit b194f96af4e6298fe086a844115ea23300be7166
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>
Migrate source code to detached.el
---
.build.yml | 10 -
.dir-locals.el | 3 -
CHANGELOG.org | 4 +-
README.md | 343 +------------
dtache-compile.el | 169 -------
dtache-consult.el | 210 --------
dtache-dired.el | 45 --
dtache-env | 30 --
dtache-eshell.el | 145 ------
dtache-extra.el | 55 --
dtache-init.el | 168 -------
dtache-org.el | 70 ---
dtache-shell.el | 148 ------
dtache-vterm.el | 101 ----
dtache.el | 1393 +--------------------------------------------------
guix.scm | 55 --
test/dtache-test.el | 296 -----------
17 files changed, 11 insertions(+), 3234 deletions(-)
diff --git a/.build.yml b/.build.yml
deleted file mode 100644
index e1064d970d..0000000000
--- a/.build.yml
+++ /dev/null
@@ -1,10 +0,0 @@
-image: guix
-packages:
-- emacs-ert-runner
-- dtach
-environment:
- project: dtache
-tasks:
-- guix: |
- cd $project
- guix build --file=guix.scm
diff --git a/.dir-locals.el b/.dir-locals.el
deleted file mode 100644
index a31c9294c7..0000000000
--- a/.dir-locals.el
+++ /dev/null
@@ -1,3 +0,0 @@
-((nil . ((compile-command . "guix build --file=guix.scm")))
- (prog-mode (eval flymake-mode))
- (magit-status-mode (magit-todos-exclude-globs)))
diff --git a/CHANGELOG.org b/CHANGELOG.org
index fe88e29a57..e325bd82a0 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -2,7 +2,9 @@
#+author: Niklas Eklund
#+language: en
-* Development
+* Version 0.7 (2022-05-21)
+
+- Rename =dtache= to =detached.el= and migrate source code to
https://git.sr.ht/~niklaseklund/detached.el
- Introduce =dtache-init.el= and move integration of other packages there. The
integration now becomes even simpler for users of =dtache=.
- Rewrite =dtache= to enable the package to lazy load and not force users to
load it when starting Emacs.
- Make completion of sessions adapt to the current dtache sessions. All of the
sessions will be used to determine an an appropriate width for the command
width as well as each individual annotation. Format has updated in
=dtache-annotation-format= and a =dtache-command-format= has been added, this
supersedes the =dtache-max-command-lenght=.
diff --git a/README.md b/README.md
index e4e4c0924b..9156f15cc0 100644
--- a/README.md
+++ b/README.md
@@ -1,347 +1,10 @@
-# dtache.el
+# dtache
<a href="http://elpa.gnu.org/packages/dtache.html";><img alt="GNU ELPA"
src="https://elpa.gnu.org/packages/dtache.svg"/></a>
<a href="http://elpa.gnu.org/devel/dtache.html";><img alt="GNU-devel ELPA"
src="https://elpa.gnu.org/devel/dtache.svg"/></a>
<a href="https://melpa.org/#/dtache";><img alt="MELPA"
src="https://melpa.org/packages/dtache-badge.svg"/></a>
<a href="https://stable.melpa.org/#/dtache";><img alt="MELPA Stable"
src="https://stable.melpa.org/packages/dtache-badge.svg"/></a>
-<a
href="https://builds.sr.ht/~niklaseklund/dtache.el/commits/main/.build.yml";><img
alt="Build"
src="https://builds.sr.ht/~niklaseklund/dtache.el/commits/main/.build.yml.svg"/></a>
-# Introduction
-
-`dtache` is a package to launch, and manage, detached processes. The idea is
that these processes are detached from the Emacs process and the package can
make Emacs seamlessly attach to these processes. This enables users to launch
processes that can survive when Emacs itself is being shutdown. The package
relies on the program [dtach](https://github.com/crigler/dtach), in order to
make this functionality possible.
-
-Internally the package transforms the dtache process into a `dtache-session`
object, which essentially is a text-based representation of the process. All
`dtache-session` objects are stored in a lisp file, and the output of all
sessions are captured into individual logs.
-
-The package supports integration with multiple packages, here is a list of the
built-in packages that are supported:
-
-- `shell`
-- `eshell`
-- `compile`
-- `org`
-- `dired`
-
-# Features
-
-Since a `dtache-session` contain all the output of the process as well as data
such as, `what command` was run, `which directory` the process was launched
etc, it opens up the possibility for the following features:
-
-- `Unlimited scrollback:` All the output from a `dtache-session` is always
accessible
-- `Remote support:` Full support for running on remote hosts. See `Remote
support` section of the README
-- `Notifications:` The package will monitor all dtache sessions and notify
when a session has finished
-- `Post compilation`: If the package has been configured to use `dtache-env`
it will know the exit status of a session. That enables the package to post
compile the output of a session to enable Emacs's built-in functionality of
navigating between errors in the output.
-- `Annotations:` When selecting a session all are presented with a rich set of
annotations
-- `Actions:` The package provides actions to act on a session:
- + `kill` a an active session
- + `rerun` a session
- + `copy` the output of a session
- + `diff` the output of two different sessions
-
-# Installation
-
-The package is available on [GNU ELPA](https://elpa.gnu.org) and
[MELPA](https://melpa.org/), and for users of the [GNU Guix package
manager](https://guix.gnu.org/) there is a guix package.
-
-# Configuration
-
-The prerequisite for `dtache.el` is that the user has the program `dtach`
installed.
-
-## Use-package example
-
-A minimal `use-package` configuration.
-
-``` emacs-lisp
-(use-package dtache
- :init
- (dtache-init)
- :bind (;; Replace `async-shell-command' with `dtache-shell-command'
- ([remap async-shell-command] . dtache-shell-command)
- ;; Replace `compile' with `dtache-compile'
- ([remap compile] . dtache-compile)
- ([remap recompile] . dtache-compile-recompile)
- ;; Replace built in completion of sessions with `consult'
- ([remap dtache-open-session] . dtache-consult-session))
- :custom ((dtache-env "<path_to_dtache-env>")
- (dtache-show-output-on-attach t)
- (dtache-shell-history-file "~/.bash_history")))
-```
-
-The users are required to call `dtache-init`. This function orchestrates the
integration with all other internal and external packages that `dtache.el`
supports. These are:
-
-- `compile`
-- `dired`
-- `dired-rsync`
-- `embark`
-- `eshell`
-- `org`
-- `projectile`
-- `shell`
-- `vterm`
-
-All of the integration are configured to enable lazy-loading. Meaning that if
you are not a user of `projectile` that code that handles the integration will
never load.
-
-However if you do want to disable the integration with a specific package, or
enable for a subset of the packages use the variables `dtache-init-allow-list`
or `dtache-init-block-list`.
-
-# Usage
-
-The idea is that users can choose to either:
-- `create`: a dtache session and attach to it
-- `detach`: from a dtache session
-- `attach`: to a dtache session
-
-In the integration of `dtache.el` with other packages these commands are
always existent, with the exception for `org-mode`.
-
-To detach from a `dtache-session` in any of the modes, use the universal
`dtache-detach-session` command. The keybinding for this command is defined by
the `dtache-detach-key` variable, which by default has the value `C-c C-d`.
-
-## General
-
-To interact with a session the package provides the command
`detached-open-session`. This provides a convenient completion interface,
enriched with annotations to provide useful information about the sessions. The
`detached-open-session` command is implemented as a do what I mean command.
This results in `dtache` performing different actions depending on the state of
a session. The actions can be configured based on the `origin` of the session.
The user can have one set of configurations [...]
-
-The actions are controlled by the customizable variables named
`dtache-.*-session-action`. They come preconfigured but if you don't like the
behavior of `dtache-open-session` these variables allows for tweaking the
experience.
-
-- If the session is `active`, call the sessions `attach` function
-- If the session is `inactive` call the sessions `view` function, which by
default performs a post-compile on the session if its status is `failure`
otherwise the sessions raw output is opened.
-
-The package also provides additional commands to interact with a session.
-
-| Command (Keybinding) | Description
|
-|-------------------------------------|---------------------------------------------|
-| dtache-view-session (v) | View a session's output
|
-| dtache-attach-session (a) | Attach to a session
|
-| dtache-tail-session (t) | Tail the output of an active session
|
-| dtache-diff-session (=) | Diff a session with another session
|
-| dtache-compile-session (c) | Open the session output in compilation
mode |
-| dtache-rerun-session (r) | Rerun a session
|
-| dtache-insert-session-command (i) | Insert the session's command at point
|
-| dtache-copy-session-command (w) | Copy the session's shell command
|
-| dtache-copy-session (W) | Copy the session's output
|
-| dtache-kill-session (k) | Kill an active session
|
-| dtache-delete-session (d) | Delete an inactive session
|
-
-These commands are available through the `dtache-action-map`. The user can
bind the action map to a keybinding of choice. For example
-
-``` emacs-lisp
-(global-set-key (kbd "C-c d") dtache-action-map)
-```
-
-Then upon invocation the user can choose an action, keybindings listed in the
table above, and then choose a session to perform the action upon. For those
using `embark` this will not be necessary as `dtache-init` sets up integration
with embark actions.
-
-## Shell command
-
-The `dtache-shell-command` is for the Emacs users that are accustomed to
running shell commands from `M-x shell-command` or `M-x async-shell-command`.
-
-## Shell
-
-A minor mode named `dtache-shell-mode` is provided, and will be enabled in
`shell`. The commands that are implemented are:
-
-| Command | Description | Keybinding
|
-|-------------------------------|--------------------------------|---------------------|
-| dtache-shell-send-input | Run command with dtache | <S-return>
|
-| dtache-shell-attach-session | Attach to a dtache session | <C-return>
|
-| dtache-detach-session | Detach from a dtache session |
dtache-detach-key |
-
-## Eshell
-
-A minor mode named `dtache-eshell-mode` is provided, and will be enabled in
`eshell`. The commands that are implemented are:
-
-| Command | Description | Keybinding
|
-|--------------------------------|--------------------------------|---------------------|
-| dtache-eshell-send-input | Run command with dtache | <S-return>
|
-| dtache-eshell-attach-session | Attach to a dtache session | <C-return>
|
-| dtache-detach-session | Detach from a dtache session |
dtache-detach-key |
-
-## Org babel
-
-The package implements an additional header argument for `ob-shell`. The
header argument is `:detached t`. When provided it will enable the code inside
a src block to be run with `dtache`. Since org is not providing any live
updates on the output the session is created with `detached-sesion-mode` set to
`create`. This means that if you want to access the output of the session you
do that the same way you would for any other type of session. The
`detached-org` works both with and without [...]
-
-```
-#+begin_src sh :dtache t
- cd ~/code
- ls -la
-#+end_src
-
-#+RESULTS:
-: [dtache]
-```
-
-## Compile
-
-The package implements the commands `detached-compile` and
`detached-compile-recompile`, which are thin wrappers around the original
`compile` and `recompile` commands. The users should be able to use the former
as replacements for the latter without noticing any difference except from the
possibility to `detach`.
-
-## Consult
-
-The command `detached-consult-session` is a replacement for
`detached-open-session` using the [consult](https://github.com/minad/consult)
package. The difference is that the consult command provides multiple session
sources, which is defined in the `detached-consult-sources` variable. Users can
customize which sources to use, as well as use individual sources in other
`consult` commands, such as `consult-buffer`. The users can also narrow the
list of sessions by entering a key. The list [...]
-
-| Type | Key |
-|-----------------------+-----|
-| Active sessions | a |
-| Inactive sessions | i |
-| Successful sessions | s |
-| Failed sessions | f |
-| Local host sessions | l |
-| Remote host sessions | r |
-| Current host sessions | c |
-
-# Customization
-
-## Customizable variables
-
-The package provides the following customizable variables.
-
-| Name | Description
|
-|--------------------------------------|----------------------------------------------------------------------------------|
-| dtache-session-directory | A host specific directory to store
sessions in |
-| dtache-db-directory | A localhost specific directory to store
the database |
-| dtache-dtach-program | Name or path to the `dtach` program
|
-| dtache-shell-program | Name or path to the `shell` that
`dtache.el` should use |
-| dtache-timer-configuration | Configuration of the timer that runs on
remote hosts |
-| dtache-env | Name or path to the `dtache-env` script
|
-| dtache-annotation-format | A list of annotations that should be
present in completion |
-| dtache-command-format | A configuration for displaying a
session command |
-| dtache-tail-interval | How often `dtache.el` should refresh
the output when tailing |
-| dtache-nonattachable-commands | A list of commands that should be
considered nonattachable |
-| dtache-notification-function | Specifies which function to issue
notifications with |
-| dtache-detach-key | Specifies which keybinding to use to
detach from a session |
-| dtache-shell-command-initial-input | Enables latest value in history to be
used as initial input |
-| dtache-filter-ansi-sequences | Specifies if `dtache.el` will use
ansi-color to filter out escape sequences |
-| dtache-show-output-command | Specifies if `dtache.el` should show
the session's output when attaching to it |
-
-Apart from those variables there is also the different `action` variables,
which can be configured differently depending on the origin of the session.
-
-| Name | Description
|
-|---------------------------------------|-----------------------------------------------------------------|
-| dtache-shell-command-session-action | Actions for sessions launched with
`dtache-shell-command` |
-| dtache-eshell-session-action | Actions for sessions launched with
`dtache-eshell-send-input` |
-| dtache-shell-session-action | Actions for sessions launched with
`dtache-shell-send-input` |
-| dtache-compile-session-action | Actions for sessions launched with
`dtache-compile` |
-| dtache-org-session-action | Actions for sessions launched with
`dtache-org` |
-
-## Remote support
-
-The `dtache` supports [Connection Local
Variables](https://www.gnu.org/software/emacs/manual/html_node/elisp/Connection-Local-Variables.html)
which allows the user to customize the variables used by `dtache` when running
on a remote host. This example shows how the following variables are customized
for all remote hosts.
-
-``` emacs-lisp
-(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")))
-
-(connection-local-set-profiles
- '(:application tramp :protocol "ssh") 'remote-dtache)
-```
-
-## Completion annotations
-
-Users can customize the appearance of annotations in `dtache-open-session` by
modifying the `dtache-annotation-format`. The default annotation format is the
following.
-
-``` emacs-lisp
-(defvar dtache-annotation-format
- `((:width 3 :function dtache--state-str :face dtache-state-face)
- (:width 3 :function dtache--status-str :face dtache-failure-face)
- (:width 10 :function dtache--host-str :face dtache-host-face)
- (:width 40 :function dtache--working-dir-str :face dtache-working-dir-face)
- (:width 30 :function dtache--metadata-str :face dtache-metadata-face)
- (:width 10 :function dtache--duration-str :face dtache-duration-face)
- (:width 8 :function dtache--size-str :face dtache-size-face)
- (:width 12 :function dtache--creation-str :face dtache-creation-face))
- "The format of the annotations.")
-```
-
-## Status deduction
-
-Users are encouraged to define the `detached-env` variable. It should point to
the `detached-env` script, which is provided in the repository. This script
allows sessions to communicate the status of a session when it transitions to
inactive. When configured properly `dtache` will be able to set the status of a
session to either `success` or `failure`.
-
-``` emacs-lisp
-(setq dtache-env "/path/to/repo/dtache-env")
-```
-
-## Metadata annotators
-
-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 git branch name,
if the session is started in a git repository.
-
-``` emacs-lisp
-(defun my/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)))))))
-```
-
-Next add the annotation function to the `dtache-metadata-annotators-alist`
together with a symbol describing the property.
-
-``` emacs-lisp
-(setq dtache-metadata-annotators-alist '((branch .
my/dtache--session-git-branch))
-```
-
-## Nonattachable commands
-
-To be able to both attach to a dtach session as well as logging its output
`dtache` relies on the usage of `tee`. However it is possible that the user
tries to run a command which involves a program that doesn't integrate well
with tee. In those situations the output could be delayed until the session
ends, which is not preferable.
-
-For these situations `dtache.el` provides the `dtache-nonattachable-commands`
variable. This is a list of regular expressions. Any command that matches any
of the strings will be getting the property `attachable` set to false.
-``` emacs-lisp
-(setq dtache-nonattachable-commands '("^ls"))
-```
-
-Here a command beginning with `ls` would from now on be considered
nonattachable.
-
-## Colors in sessions
-
-The package needs to use a trick to get programs programs such as `git` or
`grep` to show color in their outputs. This is because these commands only use
colors and ansi sequences if they are being run in a terminal, as opposed to a
pipe. The `detached-env` therefore has two different modes. The mode can be
either `plain-text` or `terminal-data`, the latter is now the default. The
`detached-env` program then uses the `script` command to make programs run in
`dtache` think they are inside [...]
-
-The drawback is that there can be commands which generates escape sequences
that the package supports and will therefore mess up the output for some
commands. If you detect such an incompatible command you can add a regexp that
matches that command to the list `detached-env-plain-text-commands`. By doing
so `dtache` will instruct `detached-env` to run those commands in plain-text
mode.
-
-# Tips & Tricks
-
-The `dtache.el` package integrates with core Emacs packages as well as 3rd
party packages. Integration is orchestrated in the `dtache-init.el`. In this
section you can find tips for integrations that are not supported in the
package itself.
-
-## Alert
-
-By default `dtache` uses the built in `notifications` library to issue a
notification. This solution uses `dbus` but if that doesn't work for the user
there is the possibility to set the `detached-notification-function` to
`detached-state-transition-echo-message` to use the echo area instead. If that
doesn't suffice there is the possibility to use the
[alert](https://github.com/jwiegley/alert) package to get a system notification
instead.
-
-``` emacs-lisp
-(defun my/state-dtache-transition-alert-notification (session)
- "Send an `alert' notification when SESSION becomes inactive."
- (let ((status (car (dtache--session-status session)))
- (host (car (dtache--session-host session))))
- (alert (dtache--session-command session)
- :title (pcase status
- ('success (format "Dtache finished [%s]" host))
- ('failure (format "Dtache failed [%s]" host)))
- :severity (pcase status
- ('success 'moderate)
- ('failure 'high)))))
-
-(setq dtache-notification-function
#'my/dtache-state-transition-alert-notification)
-```
-
-# Versions
-
-Information about larger changes that has been made between versions can be
found in the `CHANGELOG.org`
-
-# Support
-
-The `dtache.el` package should work on `Linux` and `macOS`. It is regularly
tested on `Ubuntu` and `GNU Guix System`.
-
-# Contributions
-
-The package is part of [ELPA](https://elpa.gnu.org/) which means that if you
want to contribute you must have a [copyright
assignment](https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html).
-
-# Acknowledgments
-
-This package wouldn't have been were it is today without these contributors.
-
-## Code contributors
-
-- [rosetail](https://gitlab.com/rosetail)
-- [protesilaos](https://lists.sr.ht/~protesilaos)
-
-## Idea contributors
-
-- [rosetail](https://gitlab.com/rosetail) for all the great ideas and
improvements to the package. Without those contributions `dtache.el` would be a
less sophisticated package.
-- [Troy de Freitas](https://gitlab.com/ntdef) for solving the problem of
getting `dtache.el` to work with `filenotify` on macOS.
-- [Daniel Mendler](https://gitlab.com/minad) for helping out in improving
`dtache.el`, among other things integration with other packages such as
`embark` and `consult`.
-- [Ambrevar](https://gitlab.com/ambrevar) who indirectly contributed by
inspiring me with his [yes eshell is my main
shell](https://www.reddit.com/r/emacs/comments/6y3q4k/yes_eshell_is_my_main_shell/).
It was through that I discovered his
[package-eshell-detach](https://github.com/Ambrevar/dotfiles/blob/master/.emacs.d/lisp/package-eshell-detach.el)
which got me into the idea of using `dtach` as a base for detached shell
commands.
+# Information
+The package has been renamed to `detached.el`, please migrate. The source code
now resides at https://git.sr.ht/~niklaseklund/detached.el.
diff --git a/dtache-compile.el b/dtache-compile.el
deleted file mode 100644
index 6d6b0cd1d7..0000000000
--- a/dtache-compile.el
+++ /dev/null
@@ -1,169 +0,0 @@
-;;; dtache-compile.el --- Dtache integration for compile -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2022 Free Software Foundation, Inc.
-
-;; This file is 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 is a `dtache' extension which provides integration for `compile'.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'compile)
-(require 'dtache)
-
-(declare-function ansi-color-compilation-filter "ansi-color")
-
-;;;; Variables
-
-(defcustom dtache-compile-session-action
- '(:attach dtache-compile-attach
- :view dtache-compile-session
- :run dtache-compile)
- "Actions for a session created with `dtache-compile'."
- :group 'dtache
- :type 'plist)
-
-;;;; Commands
-
-;;;###autoload
-(defun dtache-compile (command &optional comint)
- "Run COMMAND through `compile' but in a 'dtache' session.
-Optionally enable COMINT if prefix-argument is provided."
- (interactive
- (list
- (let ((command (eval compile-command t)))
- (if (or compilation-read-command current-prefix-arg)
- (compilation-read-command command)
- command))
- (consp current-prefix-arg)))
- (let* ((dtache-enabled t)
- (dtache-session-origin (or dtache-session-origin 'compile))
- (dtache-session-action (or dtache-session-action
- dtache-compile-session-action))
- (dtache-session-mode 'create-and-attach))
- (compile command comint)))
-
-;;;###autoload
-(defun dtache-compile-recompile (&optional edit-command)
- "Re-compile by running `compile' but in a 'dtache' session.
-Optionally EDIT-COMMAND."
- (interactive "P")
- (let* ((dtache-enabled t)
- (dtache-session-action dtache-compile-session-action)
- (dtache-session-origin 'compile)
- (dtache-session-mode 'create-and-attach))
- (recompile edit-command)))
-
-;;;;; Functions
-
-;;;###autoload
-(defun dtache-compile-attach (session)
- "Attach to SESSION with `compile'."
- (when (dtache-valid-session session)
- (let* ((dtache-enabled t)
- (dtache-session-mode 'attach)
- (dtache--current-session session))
- (compilation-start (dtache--session-command session)))))
-
-;;;###autoload
-(defun dtache-compile-open (session)
- "Open SESSION with `dtache-compile'."
- (when (dtache-valid-session session)
- (if (eq 'active (dtache--session-state session))
- (dtache-compile-attach session)
- (dtache-compile-session session))))
-
-;;;###autoload
-(defun dtache-compile-start (_)
- "Run in `compilation-start-hook' if `dtache-enabled'."
- (when dtache-enabled
- (setq dtache--buffer-session dtache--current-session)
- (dtache-compile--replace-modesetter)
- (when dtache-filter-ansi-sequences
- (add-hook 'compilation-filter-hook #'ansi-color-compilation-filter 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)))
-
-;;;;; Support functions
-
-(defun dtache-compile--compilation-start (compilation-start &rest args)
- "Create a `dtache' session before running COMPILATION-START with ARGS."
- (if dtache-enabled
- (pcase-let ((`(,command ,mode ,_ ,highlight-regexp) args)
- (buffer-name "*dtache-compilation*"))
- (if (and (not (eq dtache-session-mode 'attach))
- (not (dtache-attachable-command-p command)))
- (dtache-start-session command t)
- (cl-letf* ((name-function (lambda (_) buffer-name))
- (dtache--current-session (or dtache--current-session
- (dtache-create-session
command))))
- (apply compilation-start `(,(dtache-dtach-command
dtache--current-session t)
- ,(or mode 'dtache-compilation-mode)
- ,name-function
- ,highlight-regexp)))))
- (apply compilation-start args)))
-
-(defun dtache-compile--replace-modesetter ()
- "Replace the modsetter inserted by `compilation-start'."
- (save-excursion
- (let ((buffer-read-only nil)
- (regexp (rx (regexp "^dtach ") (or "-c" "-a") (regexp
".*\.socket.*$"))))
- (goto-char (point-min))
- (when (re-search-forward regexp nil t)
- (kill-region (match-beginning 0) (match-end 0))
- (insert (dtache--session-command dtache--current-session))))))
-
-(defun dtache-compile--compilation-dtache-filter ()
- "Filter to modify the output in a compilation buffer."
- (let ((begin compilation-filter-start)
- (end (copy-marker (point))))
- (save-excursion
- (goto-char begin)
- (when (re-search-forward "\n?Dtache session.*\n?" end t)
- (delete-region (match-beginning 0) (match-end 0))))))
-
-(defun dtache-compile--compilation-eof-filter ()
- "Filter to modify the output in a compilation buffer."
- (let ((begin compilation-filter-start)
- (end (copy-marker (point))))
- (save-excursion
- (goto-char begin)
- (when (re-search-forward (format "\n?%s\n" dtache--dtach-eof-message)
end t)
- (delete-region (match-beginning 0) (match-end 0))))))
-
-;;;;; Major modes
-
-(defvar dtache-compilation-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd dtache-detach-key) #'dtache-detach-session)
- map)
- "Keymap for `dtache-compilation-mode'.")
-
-;;;###autoload
-(define-derived-mode dtache-compilation-mode compilation-mode "Dtache
Compilation"
- "Major mode for tailing `dtache' logs."
- (add-hook 'compilation-filter-hook #'dtache-compile--compilation-eof-filter
0 t)
- (add-hook 'compilation-filter-hook
#'dtache-compile--compilation-dtache-filter 0 t))
-
-(advice-add #'compilation-start :around #'dtache-compile--compilation-start)
-
-(provide 'dtache-compile)
-
-;;; dtache-compile.el ends here
diff --git a/dtache-consult.el b/dtache-consult.el
deleted file mode 100644
index 8e71f59ea8..0000000000
--- a/dtache-consult.el
+++ /dev/null
@@ -1,210 +0,0 @@
-;;; dtache-consult.el --- Dtache interface using Consult multi sources -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
-
-;; This file is 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 integrates `dtache' with `consult'[1]. The package
-;; provides a command `dtache-consult-session' which provides multiple session
sources.
-;;
-;; [1] https://github.com/minad/consult
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'dtache)
-
-(declare-function consult--multi "consult")
-
-;;;; Variables
-
-(defcustom dtache-consult-hidden-predicates nil
- "Predicates for sessions that should be hidden."
- :type '(repeat function)
- :group 'dtache)
-
-(defcustom dtache-consult-sources
- '(dtache-consult--source-session
- dtache-consult--source-active-session
- dtache-consult--source-inactive-session
- dtache-consult--source-hidden-session
- dtache-consult--source-success-session
- dtache-consult--source-failure-session
- dtache-consult--source-local-session
- dtache-consult--source-remote-session
- dtache-consult--source-current-session)
- "Sources used by `dtache-consult-session'.
-
-See `consult-multi' for a description of the source values."
- :type '(repeat symbol)
- :group 'dtache)
-
-(defvar dtache-consult--source-session
- `(:category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-remove
- (lambda (x)
- (seq-find (lambda (predicate)
- (apply predicate `(,(cdr x))))
- dtache-consult-hidden-predicates))
- (dtache-session-candidates (dtache-get-sessions))))))
- "All `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-hidden-session
- `(:narrow (?\s . "Hidden")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (seq-find (lambda (predicate)
- (apply predicate `(,(cdr x))))
- dtache-consult-hidden-predicates))
- (dtache-session-candidates (dtache-get-sessions))))))
- "Active `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-active-session
- `(:narrow (?a . "Active")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (eq 'active (dtache--session-state (cdr x))))
- (dtache-session-candidates (dtache-get-sessions))))))
- "Active `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-inactive-session
- `(:narrow (?i . "Inactive")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (eq 'inactive (dtache--session-state (cdr x))))
- (dtache-session-candidates (dtache-get-sessions))))))
- "Inactive `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-failure-session
- `(:narrow (?f . "Failure")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (eq 'failure (car (dtache--session-status (cdr x)))))
- (dtache-session-candidates (dtache-get-sessions))))))
- "Failed `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-success-session
- `(:narrow (?s . "Success")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (eq 'success (car (dtache--session-status (cdr x)))))
- (dtache-session-candidates (dtache-get-sessions))))))
- "Successful `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-local-session
- `(:narrow (?l . "Local Host")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (eq 'local (cdr (dtache--session-host (cdr x)))))
- (dtache-session-candidates (dtache-get-sessions)))))
- "Local host `dtache' sessions as a source for `consult'."))
-
-(defvar dtache-consult--source-remote-session
- `(:narrow (?r . "Remote Host")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (eq 'remote (cdr (dtache--session-host (cdr x)))))
- (dtache-session-candidates (dtache-get-sessions))))))
- "Remote host `dtache' sessions as a source for `consult'.")
-
-(defvar dtache-consult--source-current-session
- `(:narrow (?c . "Current Host")
- :hidden t
- :category dtache
- :annotate dtache-session-annotation
- :action (lambda (x) (dtache-open-session (dtache--decode-session
x)))
- :items
- ,(lambda ()
- (let ((host-name (car (dtache--host))))
- (mapcar #'car (seq-filter
- (lambda (x)
- (string= (car (dtache--session-host (cdr
x))) host-name))
- (dtache-session-candidates
(dtache-get-sessions)))))))
- "Current host `dtache' sessions as a source for `consult'.")
-
-;;;; Commands
-
-;;;###autoload
-(defun dtache-consult-session ()
- "Enhanced `dtache-open-session' command."
- (interactive)
- (unless (require 'consult nil 'noerror)
- (error "Install Consult to use dtache-consult"))
- (consult--multi dtache-consult-sources
- :prompt "Select session: "
- :require-match t
- :sort nil))
-
-(provide 'dtache-consult)
-
-;;; dtache-consult.el ends here
diff --git a/dtache-dired.el b/dtache-dired.el
deleted file mode 100644
index 098692d918..0000000000
--- a/dtache-dired.el
+++ /dev/null
@@ -1,45 +0,0 @@
-;;; dtache-dired.el --- Dtache integration for dired -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022 Free Software Foundation, Inc.
-
-;; This file is 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 integrates `dtache' with `dired'.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'dired)
-(require 'dtache)
-
-;;;; Functions
-
-;;;###autoload
-(defun dtache-dired-do-shell-command (dired-do-shell-command &rest args)
- "Ensure `dtache' is used before running DIRED-DO-SHELL-COMMAND with ARGS."
- (cl-letf* ((dtache-session-origin 'dired)
- ((symbol-function #'dired-run-shell-command)
- (lambda (command)
- (dtache-start-session command)
- nil)))
- (apply dired-do-shell-command args)))
-
-(provide 'dtache-dired)
-
-;;; dtache-dired.el ends here
diff --git a/dtache-env b/dtache-env
deleted file mode 100755
index 2427d3a342..0000000000
--- a/dtache-env
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/usr/bin/env bash
-
-# dtache-env is a script which purpose is to run a dtache command, and
-# issue to stdout, based on the exit code.
-
-mode="$1"
-shift
-dtache_command="$*"
-
-# dtache-env features two different modes:
-# 1) Plain-text: where plain text data will be logged in the sessions output
-# 2) Terminal-data: the script command is used to record the terminal
-# data in raw format, this includes ansi escape sequences. The TERM
-# environmental variable is set to eterm-color in order to enabled
-# colored outputs from the dtache_command
-
-if [ "$mode" = "plain-text" ]; then
- if eval "$dtache_command"; then
- echo -e "\nDtache session finished"
- else
- echo -e "\nDtache session exited abnormally with code $?"
- fi
-elif [ "$mode" = "terminal-data" ]; then
- TERM="eterm-color"
- if eval script --quiet --flush --return --command "\"$dtache_command\""
/dev/null; then
- echo -e "\nDtache session finished"
- else
- echo -e "\nDtache session exited abnormally with code $?"
- fi
-fi
diff --git a/dtache-eshell.el b/dtache-eshell.el
deleted file mode 100644
index 7e7e493a94..0000000000
--- a/dtache-eshell.el
+++ /dev/null
@@ -1,145 +0,0 @@
-;;; dtache-eshell.el --- Dtache integration for eshell -*- lexical-binding: t
-*-
-
-;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
-
-;; This file is 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 is a `dtache' extension which provides integration for `eshell'.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'dtache)
-(require 'eshell)
-(require 'esh-mode)
-(require 'esh-ext)
-(require 'em-hist)
-
-;;;; Variables
-
-(defcustom dtache-eshell-session-action
- '(:attach dtache-shell-command-attach-session
- :view dtache-view-dwim
- :run dtache-shell-command)
- "Actions for a session created with `dtache-eshell'."
- :group 'dtache
- :type 'plist)
-
-;;;; Functions
-
-(defun dtache-eshell-select-session ()
- "Return selected session."
- (let* ((host-name (car (dtache--host)))
- (sessions
- (thread-last (dtache-get-sessions)
- (seq-filter (lambda (it)
- (string= (car (dtache--session-host it))
host-name)))
- (seq-filter (lambda (it) (eq 'active
(dtache--determine-session-state it)))))))
- (dtache-completing-read sessions)))
-
-(defun dtache-eshell-get-dtach-process ()
- "Return `eshell' process if `dtache' is running."
- (when-let* ((process (and eshell-process-list (caar eshell-process-list))))
- (and (string= (process-name process) "dtach")
- process)))
-
-;;;; Commands
-
-;;;###autoload
-(defun dtache-eshell-send-input (&optional detach)
- "Create a session and attach to it.
-
-If prefix-argument directly DETACH from the session."
- (interactive "P")
- (let* ((dtache-session-origin 'eshell)
- (dtache-session-mode (if detach 'create 'create-and-attach))
- (dtache-enabled t)
- (dtache--current-session nil))
- (advice-add #'eshell-external-command :around
#'dtache-eshell-external-command)
- (call-interactively #'eshell-send-input)))
-
-;;;###autoload
-(defun dtache-eshell-attach-session (session)
- "Attach to SESSION."
- (interactive
- (list (dtache-eshell-select-session)))
- (when (dtache-valid-session session)
- (if (and (eq 'active (dtache--determine-session-state session))
- (dtache--session-attachable session))
- (cl-letf* ((dtache-session-mode 'attach)
- (input
- (dtache-dtach-command session t))
- ((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)
- (overlay-put (make-overlay end end) 'before-string "[attached]")
- (insert " "))
- (setq dtache--buffer-session session)
- (call-interactively #'eshell-send-input))
- (dtache-open-session session))))
-
-;;;; Support functions
-
-;;;###autoload
-(defun dtache-eshell-external-command (orig-fun &rest args)
- "Advice `eshell-external-command' to optionally use `dtache'."
- (let* ((dtache-session-action dtache-eshell-session-action)
- (command (string-trim-right
- (mapconcat #'identity
- (flatten-list args)
- " ")))
- (session (dtache-create-session command))
- (command (dtache-dtach-command session)))
- (advice-remove #'eshell-external-command #'dtache-eshell-external-command)
- (setq dtache--buffer-session session)
- (setq dtache-enabled nil)
- (apply orig-fun `(,(seq-first command) ,(seq-rest command)))))
-
-;;;; Minor mode
-
-(defvar dtache-eshell-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "<S-return>") #'dtache-eshell-send-input)
- (define-key map (kbd "<C-return>") #'dtache-eshell-attach-session)
- (define-key map (kbd dtache-detach-key) #'dtache-detach-session)
- map)
- "Keymap for `dtache-eshell-mode'.")
-
-;;;###autoload
-(define-minor-mode dtache-eshell-mode
- "Integrate `dtache' in `eshell-mode'."
- :lighter " dtache-eshell"
- :keymap (let ((map (make-sparse-keymap)))
- map)
- (make-local-variable 'eshell-preoutput-filter-functions)
- (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-extra.el b/dtache-extra.el
deleted file mode 100644
index 359dff08a5..0000000000
--- a/dtache-extra.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; dtache-extra.el --- Dtache integration for external packages -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2022 Free Software Foundation, Inc.
-
-;; This file is 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 a collection of functionality to integrate `dtache'
with external packages.
-
-;;; Code:
-
-;;;; Requirements
-
-(declare-function dtache-compile "dtache")
-(declare-function dtache-start-session "dtache")
-
-(defvar dtache-session-origin)
-(defvar dtache-local-session)
-
-;;;; Functions
-
-;;;###autoload
-(defun dtache-extra-projectile-run-compilation (cmd &optional use-comint-mode)
- "If CMD is a string execute it with `dtache-compile'.
-
-Optionally USE-COMINT-MODE"
- (if (functionp cmd)
- (funcall cmd)
- (let ((dtache-session-origin 'projectile))
- (dtache-compile cmd use-comint-mode))))
-
-;;;###autoload
-(defun dtache-extra-dired-rsync (command _details)
- "Run COMMAND with `dtache'."
- (let ((dtache-local-session t)
- (dtache-session-origin 'rsync))
- (dtache-start-session command t)))
-
-(provide 'dtache-extra)
-
-;;; dtache-extra.el ends here
diff --git a/dtache-init.el b/dtache-init.el
deleted file mode 100644
index 07da844be2..0000000000
--- a/dtache-init.el
+++ /dev/null
@@ -1,168 +0,0 @@
-;;; dtache-init.el --- Initialize dtache -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022 Free Software Foundation, Inc.
-
-;; This file is 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 is intended to aid users in configuring `dtache's integration with
other packages.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'subr-x)
-
-(declare-function dtache-attach-session "dtache")
-(declare-function dtache-compile-session "dtache")
-(declare-function dtache-delete-session "dtache")
-(declare-function dtache-insert-session-command "dtache")
-(declare-function dtache-kill-session "dtache")
-(declare-function dtache-rerun-session "dtache")
-(declare-function dtache-tail-session "dtache")
-(declare-function dtache-view-session "dtache")
-(declare-function dtache-copy-session-command "dtache")
-(declare-function dtache-copy-session "dtache")
-(declare-function dtache-diff-session "dtache")
-
-(declare-function dtache-shell-mode "dtache")
-(declare-function dtache-compile-start "dtache-compile")
-(declare-function dtache-dired-do-shell-command "dtache-dired")
-(declare-function dtache-eshell-mode "dtache-eshell")
-(declare-function dtache-extra-projectile-run-compilation "dtache-extra")
-(declare-function dtache-extra-dired-rsync "dtache-extra")
-(declare-function dtache-org-babel-sh "dtache-org")
-(declare-function dtache-shell-override-history "dtache-shell")
-(declare-function dtache-shell-save-history-on-kill "dtache-shell")
-(declare-function dtache-vterm-mode "dtache-vterm")
-
-(declare-function org-babel-sh-evaluate "ob-shell")
-(declare-function dired-rsync--do-run "dired-rsync")
-(declare-function dired-rsync "dired-rsync")
-(declare-function projectile "projectile")
-(declare-function vterm "vterm")
-
-(defvar embark-general-map)
-(defvar embark-keymap-alist)
-
-;;;; Variables
-
-(defcustom dtache-init-block-list nil
- "A list of blocked packages."
- :group 'dtache
- :type 'list)
-
-(defcustom dtache-init-allow-list
- '(compile dired dired-rsync embark eshell org projectile shell vterm)
- "A list of allowed packages."
- :group 'dtache
- :type 'list)
-
-(defvar dtache-action-map
- (let ((map (make-sparse-keymap)))
- (define-key map "a" #'dtache-attach-session)
- (define-key map "c" #'dtache-compile-session)
- (define-key map "d" #'dtache-delete-session)
- (define-key map "i" #'dtache-insert-session-command)
- (define-key map "k" #'dtache-kill-session)
- (define-key map "r" #'dtache-rerun-session)
- (define-key map "t" #'dtache-tail-session)
- (define-key map "v" #'dtache-view-session)
- (define-key map "w" #'dtache-copy-session-command)
- (define-key map "W" #'dtache-copy-session)
- (define-key map "=" #'dtache-diff-session)
- map))
-
-;;;; Support functions
-
-(defvar dtache-init--package-integration '((compile . dtache-init-compile)
- (dired . dtache-init-dired)
- (dired-rsync .
dtache-init-dired-rsync)
- (embark . dtache-init-embark)
- (eshell . dtache-init-eshell)
- (org . dtache-init-org)
- (projectile .
dtache-init-projectile)
- (shell . dtache-init-shell)
- (vterm . dtache-init-vterm))
- "Alist which contain names of packages and their initialization function.")
-
-;;;; Functions
-
-;;;###autoload
-(defun dtache-init ()
- "Initialize `dtache' integration with all packages."
-
- ;; Required for `dtache-shell-command' which is always provided
- (add-hook 'shell-mode-hook #'dtache-shell-mode)
-
- (let ((init-functions
- (thread-last dtache-init--package-integration
- (seq-filter (lambda (it)
- (member (car it) dtache-init-allow-list)))
- (seq-remove (lambda (it)
- (member (car it) dtache-init-block-list)))
- (seq-map #'cdr))))
- (dolist (init-function init-functions)
- (funcall init-function))))
-
-(defun dtache-init-shell ()
- "Initialize integration with `shell'."
- (advice-add #'shell :around #'dtache-shell-override-history)
- (add-hook 'shell-mode-hook #'dtache-shell-save-history-on-kill))
-
-(defun dtache-init-compile ()
- "Initialize integration with `compile'."
- (add-hook 'compilation-start-hook #'dtache-compile-start)
- (add-hook 'compilation-shell-minor-mode-hook #'dtache-shell-mode))
-
-(defun dtache-init-eshell ()
- "Initialize integration with `eshell'."
- (add-hook 'eshell-mode-hook #'dtache-eshell-mode))
-
-(defun dtache-init-org ()
- "Initialize integration with `org'."
- (advice-add #'org-babel-sh-evaluate :around #'dtache-org-babel-sh))
-
-(defun dtache-init-dired ()
- "Initialize integration with `dired'."
- (advice-add 'dired-do-shell-command :around #'dtache-dired-do-shell-command))
-
-(defun dtache-init-dired-rsync ()
- "Initialize integration with `dired-rsync'."
- (when (functionp #'dired-rsync)
- (advice-add #'dired-rsync--do-run :override #'dtache-extra-dired-rsync)))
-
-(defun dtache-init-projectile ()
- "Initialize integration with `projectile'."
- (when (functionp #'projectile)
- (advice-add 'projectile-run-compilation
- :override #'dtache-extra-projectile-run-compilation)))
-
-(defun dtache-init-vterm ()
- "Initialize integration with `vterm'."
- (when (functionp #'vterm)
- (add-hook 'vterm-mode-hook #'dtache-vterm-mode)))
-
-(defun dtache-init-embark ()
- "Initialize integration with `embark'."
- (with-eval-after-load 'embark
- (defvar embark-dtache-map (make-composed-keymap dtache-action-map
embark-general-map))
- (add-to-list 'embark-keymap-alist '(dtache . embark-dtache-map))))
-
-(provide 'dtache-init)
-
-;;; dtache-init.el ends here
diff --git a/dtache-org.el b/dtache-org.el
deleted file mode 100644
index eb45d45f72..0000000000
--- a/dtache-org.el
+++ /dev/null
@@ -1,70 +0,0 @@
-;;; dtache-org.el --- Dtache integration for org -*- lexical-binding: t -*-
-
-;; Copyright (C) 2022 Free Software Foundation, Inc.
-
-;; This file is 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 integrates `dtache' with `org'. In particular it
-;; integrates with `ob-shell' in order to detach babel src blocks.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'dtache)
-(require 'ob-shell)
-
-;;;; Variables
-
-(defcustom dtache-org-session-action
- '(:attach dtache-shell-command-attach-session
- :view dtache-view-dwim
- :run dtache-shell-command)
- "Actions for a session created with `dtache-org'."
- :group 'dtache
- :type 'plist)
-
-;;;; Functions
-
-;;;###autoload
-(defun dtache-org-babel-sh (org-babel-sh-evaluate-fun &rest args)
- "Modify ARGS before calling ORG-BABEL-SH-EVALUATE-FUN.
-
-This function modifies the full-body in ARGS and replaces it with a
-`dtache' command. The functionality is enabled by setting a header
-property of :dtache t in the org babel src block."
- (pcase-let* ((`(,session ,full-body ,params ,stdin ,cmdline) args))
- (if (alist-get :dtache params)
- (cl-letf* ((dtache-session-origin 'org)
- (dtache-session-action dtache-org-session-action)
- (dtache-session-mode 'create)
- (new-command (replace-regexp-in-string "\n" " && "
full-body))
- (dtach-command
- (if (string= "none" (alist-get :session params))
- (dtache-dtach-command new-command t)
- (format "%s\necho \"[dtache]\"" (dtache-dtach-command
new-command t))))
- ((symbol-function #'org-babel-eval)
- (lambda (_ command)
- (start-file-process-shell-command "dtache-org" nil
command)
- "[dtache]")))
- (apply org-babel-sh-evaluate-fun `(,session ,dtach-command ,params
,stdin ,cmdline)))
- (apply org-babel-sh-evaluate-fun args))))
-
-(provide 'dtache-org)
-
-;;; dtache-org.el ends here
diff --git a/dtache-shell.el b/dtache-shell.el
deleted file mode 100644
index 54cbcd33f9..0000000000
--- a/dtache-shell.el
+++ /dev/null
@@ -1,148 +0,0 @@
-;;; dtache-shell.el --- Dtache integration for shell -*- lexical-binding: t -*-
-
-;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
-
-;; This file is 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 is a `dtache' extension which provides integration for `shell'.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'dtache)
-
-;;;; Variables
-
-(defcustom dtache-shell-session-action
- '(:attach dtache-shell-command-attach-session
- :view dtache-view-dwim
- :run dtache-shell-command)
- "Actions for a session created with `dtache-shell'."
- :group 'dtache
- :type 'plist)
-
-(defcustom dtache-shell-history-file nil
- "File to store history."
- :type 'string
- :group 'dtache)
-
-;;;; Functions
-
-(defun dtache-shell-select-session ()
- "Return selected session."
- (let* ((host-name (car (dtache--host)))
- (sessions
- (thread-last (dtache-get-sessions)
- (seq-filter (lambda (it)
- (string= (car (dtache--session-host it))
host-name)))
- (seq-filter (lambda (it) (eq 'active
(dtache--determine-session-state it)))))))
- (dtache-completing-read sessions)))
-
-;;;; Commands
-
-;;;###autoload
-(defun dtache-shell-send-input (&optional detach)
- "Create a session and attach to it unless DETACH."
- (interactive "P")
- (let* ((dtache-session-origin 'shell)
- (dtache-session-action dtache-shell-session-action)
- (dtache-session-mode (if detach 'create 'create-and-attach))
- (comint-input-sender #'dtache-shell--create-input-sender))
- (comint-send-input)))
-
-;;;###autoload
-(defun dtache-shell-attach-session (session)
- "Attach to SESSION.
-
-`comint-add-to-input-history' is temporarily disabled to avoid
-cluttering the comint-history with dtach commands."
- (interactive
- (list (dtache-shell-select-session)))
- (when (dtache-valid-session session)
- (if (and (eq 'active (dtache--determine-session-state session))
- (dtache--session-attachable session))
- (cl-letf ((dtache--current-session session)
- (comint-input-sender #'dtache-shell--attach-input-sender)
- ((symbol-function 'comint-add-to-input-history) (lambda (_)
t)))
- (setq dtache--buffer-session session)
- (comint-kill-input)
- (insert "[attached]")
- (comint-send-input))
- (dtache-open-session session))))
-
-;;;; Support functions
-
-(defun dtache-shell--attach-input-sender (proc _string)
- "Attach to `dtache--session' and send the attach command to PROC."
- (let* ((dtache-session-mode 'attach)
- (input
- (dtache-dtach-command dtache--current-session t)))
- (comint-simple-send proc input)))
-
-(defun dtache-shell--create-input-sender (proc string)
- "Create a dtache session based on STRING and send to PROC."
- (with-connection-local-variables
- (let* ((command (substring-no-properties string))
- (dtach-command (dtache-dtach-command command t)))
- (comint-simple-send proc dtach-command))))
-
-(defun dtache-shell--comint-read-input-ring-advice (orig-fun &rest args)
- "Set `comint-input-ring-file-name' before calling ORIG-FUN with ARGS."
- (with-connection-local-variables
- (let ((comint-input-ring-file-name
- (concat
- (file-remote-p default-directory)
- dtache-shell-history-file)))
- (apply orig-fun args)
- (advice-remove 'comint-read-input-ring
#'dtache-shell--comint-read-input-ring-advice))))
-
-(defun dtache-shell--save-history ()
- "Save `shell' history."
- (with-connection-local-variables
- (unless (string-prefix-p dtache--shell-command-buffer (buffer-name))
- (let* ((inhibit-message t)
- (comint-input-ring-file-name
- (concat
- (file-remote-p default-directory)
- dtache-shell-history-file)))
- (comint-write-input-ring)))))
-
-;;;###autoload
-(defun dtache-shell-override-history (orig-fun &rest args)
- "Override history to read `dtache-shell-history-file' in ORIG-FUN with ARGS.
-
-This function also makes sure that the HISTFILE is disabled for local shells."
- (cl-letf (((getenv "HISTFILE") ""))
- (advice-add 'comint-read-input-ring :around
#'dtache-shell--comint-read-input-ring-advice)
- (apply orig-fun args)))
-
-;;;###autoload
-(defun dtache-shell-save-history-on-kill ()
- "Add hook to save history when killing `shell' buffer."
- (add-hook 'kill-buffer-hook #'dtache-shell--save-history 0 t))
-
-;;;; Minor mode
-
-(let ((map dtache-shell-mode-map))
- (define-key map (kbd "<S-return>") #'dtache-shell-send-input)
- (define-key map (kbd "<C-return>") #'dtache-shell-attach-session))
-
-(provide 'dtache-shell)
-
-;;; dtache-shell.el ends here
diff --git a/dtache-vterm.el b/dtache-vterm.el
deleted file mode 100644
index fc1e27db93..0000000000
--- a/dtache-vterm.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; dtache-vterm.el --- Dtache integration with vterm -*- lexical-binding: t
-*-
-
-;; Copyright (C) 2022 Free Software Foundation, Inc.
-
-;; This file is 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 integrates `dtache' with `vterm'
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'dtache)
-
-(declare-function vterm-send-C-a "vterm")
-(declare-function vterm-send-C-k "vterm")
-(declare-function vterm-send-C-e "vterm")
-(declare-function vterm-send-return "vterm")
-(declare-function vterm-end-of-line "vterm")
-
-(defvar vterm--process)
-
-;;;; Commands
-
-;;;###autoload
-(defun dtache-vterm-send-input (&optional detach)
- "Create a `dtache' session.
-
-Optionally DETACH from it."
- (interactive)
- (vterm-send-C-a)
- (let* ((input (buffer-substring-no-properties (point) (vterm-end-of-line)))
- (dtache-session-origin 'vterm)
- (dtache-session-action
- '(:attach dtache-shell-command-attach-session
- :view dtache-view-dwim
- :run dtache-shell-command))
- (dtache-session-mode
- (if detach 'create 'create-and-attach)))
- (vterm-send-C-k)
- (process-send-string vterm--process (dtache-dtach-command input t))
- (vterm-send-C-e)
- (vterm-send-return)))
-
-;;;###autoload
-(defun dtache-vterm-attach (session)
- "Attach to an active `dtache' SESSION."
- (interactive
- (list
- (let* ((host-name (car (dtache--host)))
- (sessions
- (thread-last (dtache-get-sessions)
- (seq-filter (lambda (it)
- (string= (car (dtache--session-host
it)) host-name)))
- (seq-filter (lambda (it) (eq 'active
(dtache--determine-session-state it)))))))
- (dtache-completing-read sessions))))
- (let ((dtache-session-mode 'attach))
- (process-send-string vterm--process (dtache-dtach-command session t))
- (vterm-send-return)))
-
-;;;###autoload
-(defun dtache-vterm-detach ()
- "Detach from a `dtache' session."
- (interactive)
- (process-send-string vterm--process dtache--dtach-detach-character))
-
-;;;; Minor mode
-
-(defvar dtache-vterm-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "<S-return>") #'dtache-vterm-send-input)
- (define-key map (kbd "<C-return>") #'dtache-vterm-attach)
- (define-key map (kbd dtache-detach-key) #'dtache-vterm-detach)
- map)
- "Keymap for `dtache-vterm-mode'.")
-
-;;;###autoload
-(define-minor-mode dtache-vterm-mode
- "Integrate `dtache' in `vterm'."
- :lighter " dtache-vterm"
- :keymap (let ((map (make-sparse-keymap)))
- map))
-
-(provide 'dtache-vterm)
-
-;;; dtache-vterm.el ends here
diff --git a/dtache.el b/dtache.el
index 0d1e96eb75..2bd6b96e9e 100644
--- a/dtache.el
+++ b/dtache.el
@@ -5,8 +5,8 @@
;; Author: Niklas Eklund <niklas.eklund@posteo.net>
;; Maintainer: Niklas Eklund <niklas.eklund@posteo.net>
;; URL: https://sr.ht/~niklaseklund/dtache.el/
-;; Version: 0.6
-;; Package-Requires: ((emacs "27.1"))
+;; Version: 0.7
+;; Package-Requires: ((emacs "27.1") (detached "0.7"))
;; Keywords: convenience processes
;; This file is part of GNU Emacs.
@@ -26,1398 +26,15 @@
;;; Commentary:
-;; The dtache package allows users to run shell commands dtache from
-;; Emacs. These commands are launched in sessions, using the program
-;; dtach[1]. These sessions can be easily created through the command
-;; `dtache-shell-command', or any of the commands provided by the
-;; `dtache-shell', `dtache-eshell' and `dtache-compile' extensions.
-
-;; When a session is created, dtache makes sure that Emacs is attached
-;; to it the same time, which makes it a seamless experience for the
-;; users. The `dtache' package internally creates a `dtache-session'
-;; for all commands.
-
-;; [1] https://github.com/crigler/dtach
+;; The dtache package has been renamed to detached.el, please migrate
+;; to that instead.
;;; Code:
;;;; Requirements
-(require 'ansi-color)
-(require 'autorevert)
-(require 'comint)
-(require 'notifications)
-(require 'filenotify)
-(require 'simple)
-(require 'tramp)
-
-(declare-function dtache-eshell-get-dtach-process "dtache-eshell")
-
-;;;; Variables
-
-;;;;; Customizable
-
-(defcustom dtache-session-directory (expand-file-name "dtache"
(temporary-file-directory))
- "The directory to store sessions."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-db-directory user-emacs-directory
- "The directory to store the `dtache' database."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-dtach-program "dtach"
- "The name of the `dtach' program."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-shell-program shell-file-name
- "Path to the shell to run the dtach command in."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-show-output-on-attach nil
- "If set to t show the session output when attaching to it."
- :type 'bool
- :group 'dtache)
-
-(defcustom dtache-show-output-command (executable-find "cat")
- "The command to be run to show a sessions output."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-env nil
- "The name of, or path to, the `dtache' environment script."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-env-plain-text-commands nil
- "A list of regexps for commands to run in plain-text mode."
- :type 'list
- :group 'dtache)
-
-(defcustom dtache-annotation-format
- '((:width 3 :padding 2 :function dtache--status-str :face
dtache-failure-face)
- (:width 3 :padding 4 :function dtache--state-str :face dtache-state-face)
- (:width 10 :padding 4 :function dtache--host-str :face dtache-host-face)
- (:width 40 :padding 4 :function dtache--working-dir-str :face
dtache-working-dir-face)
- (:width 40 :padding 4 :function dtache--metadata-str :face
dtache-metadata-face)
- (:width 10 :padding 4 :function dtache--duration-str :face
dtache-duration-face)
- (:width 8 :padding 4 :function dtache--size-str :face dtache-size-face)
- (:width 12 :padding 4 :function dtache--creation-str :face
dtache-creation-face))
- "The format of the annotations."
- :type '(repeat symbol)
- :group 'dtache)
-
-(defcustom dtache-command-format
- '(:width 90 :padding 4 :function dtache-command-str)
- "The format for displaying the command."
- :type 'integer
- :group 'dtache)
-
-(defcustom dtache-tail-interval 2
- "Interval in seconds for the update rate when tailing a session."
- :type 'integer
- :group 'dtache)
-
-(defcustom dtache-open-active-session-action 'attach
- "How to open an active session, allowed values are `attach' and `tail'."
- :type 'symbol
- :group 'dtache)
-
-(defcustom dtache-shell-command-session-action
- '(:attach dtache-shell-command-attach-session
- :view dtache-view-dwim
- :run dtache-shell-command)
- "Actions for a session created with `dtache-shell-command'."
- :type 'plist
- :group 'dtache)
-
-(defcustom dtache-shell-command-initial-input t
- "Variable to control initial command input for `dtache-shell-command'.
-If set to a non nil value the latest entry to
-`dtache-shell-command-history' will be used as the initial input in
-`dtache-shell-command' when it is used as a command."
- :type 'bool
- :group 'dtache)
-
-(defcustom dtache-nonattachable-commands nil
- "A list of commands which `dtache' should consider nonattachable."
- :type '(repeat (regexp :format "%v"))
- :group 'dtache)
-
-(defcustom dtache-notification-function
#'dtache-state-transition-notifications-message
- "Variable to set which function to use to issue a notification."
- :type 'function
- :group 'dtache)
-
-(defcustom dtache-detach-key "C-c C-d"
- "Variable to set the keybinding for detaching."
- :type 'string
- :group 'dtache)
-
-(defcustom dtache-filter-ansi-sequences t
- "Variable to instruct `dtache' to use `ansi-filter'."
- :type 'bool
- :group 'dtache)
-
-(defcustom dtache-log-mode-hook '()
- "Hook for customizing `dtache-log' mode."
- :type 'hook
- :group 'dtache)
-
-(defcustom dtache-shell-mode-filter-functions
- '(dtache--dtache-env-message-filter
- dtache--dtach-eof-message-filter)
- "A list of filter functions that are run in `dtache-shell-mode'."
- :type 'list
- :group 'dtache)
-
-;;;;; Public
-
-(defvar dtache-enabled nil)
-(defvar dtache-session-mode nil
- "Mode of operation for session.
-Valid values are: create, new and attach")
-(defvar dtache-session-origin nil
- "Variable to specify the origin of the session.")
-(defvar dtache-session-action nil
- "A property list of actions for a session.")
-(defvar dtache-shell-command-history nil
- "History of commands run with `dtache-shell-command'.")
-(defvar dtache-local-session nil
- "If set to t enforces a local session.")
-
-(defvar dtache-compile-session-hooks nil
- "Hooks to run when compiling a session.")
-(defvar dtache-metadata-annotators-alist nil
- "An alist of annotators for metadata.")
-
-(defconst dtache-session-version "0.6.1"
- "The version of `dtache-session'.
-This version is encoded as [package-version].[revision].")
-
-;;;;; Faces
-
-(defgroup dtache-faces nil
- "Faces used by `dtache'."
- :group 'dtache
- :group 'faces)
-
-(defface dtache-metadata-face
- '((t :inherit font-lock-builtin-face))
- "Face used to highlight metadata in `dtache'.")
-
-(defface dtache-failure-face
- '((t :inherit error))
- "Face used to highlight failure in `dtache'.")
-
-(defface dtache-state-face
- '((t :inherit success))
- "Face used to highlight state in `dtache'.")
-
-(defface dtache-duration-face
- '((t :inherit font-lock-builtin-face))
- "Face used to highlight duration in `dtache'.")
-
-(defface dtache-size-face
- '((t :inherit font-lock-function-name-face))
- "Face used to highlight size in `dtache'.")
-
-(defface dtache-creation-face
- '((t :inherit font-lock-comment-face))
- "Face used to highlight date in `dtache'.")
-
-(defface dtache-working-dir-face
- '((t :inherit font-lock-variable-name-face))
- "Face used to highlight working directory in `dtache'.")
-
-(defface dtache-host-face
- '((t :inherit font-lock-constant-face))
- "Face used to highlight host in `dtache'.")
-
-(defface dtache-identifier-face
- '((t :inherit font-lock-comment-face))
- "Face used to highlight identifier in `dtache'.")
-
-;;;;; Private
-
-(defvar dtache--sessions-initialized nil
- "Sessions are initialized.")
-(defvar dtache--sessions nil
- "A list of sessions.")
-(defvar dtache--watched-session-directories nil
- "An alist where values are a (directory . descriptor).")
-(defvar dtache--db-watch nil
- "A descriptor to the `dtache-db-directory'.")
-(defvar dtache--buffer-session nil
- "The `dtache-session' session in current buffer.")
-(defvar dtache--current-session nil
- "The current session.")
-(make-variable-buffer-local 'dtache--buffer-session)
-(defvar dtache--session-candidates nil
- "An alist of session candidates.")
-(defvar dtache--annotation-widths nil
- "An alist of widths to use for annotation.")
-
-(defconst dtache--shell-command-buffer "*Dtache Shell Command*"
- "Name of the `dtache-shell-command' buffer.")
-(defconst dtache--dtach-eof-message "\\[EOF - dtach terminating\\]"
- "Message printed when `dtach' terminates.")
-(defconst dtache--dtach-dtache-message "\\[dtache\\]\^M"
- "Message printed when detaching from `dtach'.")
-(defconst dtache--dtach-detach-character "\C-\\"
- "Character used to detach from a session.")
-
-;;;; Data structures
-
-(cl-defstruct (dtache-session (:constructor dtache--session-create)
- (:conc-name dtache--session-))
- (id nil :read-only t)
- (command nil :read-only t)
- (origin nil :read-only t)
- (working-directory nil :read-only t)
- (directory nil :read-only t)
- (metadata nil :read-only t)
- (host nil :read-only t)
- (attachable nil :read-only t)
- (env-mode nil :read-only t)
- (action nil :read-only t)
- (time nil)
- (status nil)
- (size nil)
- (state nil))
-
-;;;; Macros
-
-(defmacro dtache-connection-local-variables (&rest body)
- "A macro that conditionally use `connection-local-variables' when executing
BODY."
- `(if dtache-local-session
- (progn
- ,@body)
- (with-connection-local-variables
- (progn
- ,@body))))
-
-;;;; Commands
-
-;;;###autoload
-(defun dtache-shell-command (command &optional suppress-output)
- "Execute COMMAND with `dtache'.
-
-Optionally SUPPRESS-OUTPUT if prefix-argument is provided."
- (interactive
- (list
- (read-shell-command (if shell-command-prompt-show-cwd
- (format-message "Dtache shell command in `%s': "
- (abbreviate-file-name
- default-directory))
- "Dtache shell command: ")
- (when dtache-shell-command-initial-input
- (car dtache-shell-command-history))
- 'dtache-shell-command-history)
- current-prefix-arg))
- (let* ((dtache-session-origin (or dtache-session-origin 'shell-command))
- (dtache-session-action (or dtache-session-action
- dtache-shell-command-session-action))
- (dtache--current-session (dtache-create-session command)))
- (dtache-start-session command suppress-output)))
-
-;;;###autoload
-(defun dtache-open-session (session)
- "Open a `dtache' SESSION."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (if (eq 'active (dtache--session-state session))
- (pcase dtache-open-active-session-action
- ('attach (dtache-attach-session session))
- ('tail (dtache-tail-session session))
- (_ (message "`dtache-open-active-session-action' has an incorrect
value")))
- (if-let ((view-fun (plist-get (dtache--session-action session) :view)))
- (funcall view-fun session)
- (dtache-view-dwim session)))))
-
-;;;###autoload
-(defun dtache-compile-session (session)
- "Compile SESSION.
-
-The session is compiled by opening its output and enabling
-`compilation-minor-mode'."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (let ((buffer-name "*dtache-session-output*")
- (file
- (dtache--session-file session 'log))
- (tramp-verbose 1))
- (when (file-exists-p file)
- (with-current-buffer (get-buffer-create buffer-name)
- (setq-local buffer-read-only nil)
- (erase-buffer)
- (insert (dtache--session-output session))
- (setq-local default-directory
- (dtache--session-working-directory session))
- (run-hooks 'dtache-compile-session-hooks)
- (dtache-log-mode)
- (compilation-minor-mode)
- (setq dtache--buffer-session session)
- (setq-local font-lock-defaults '(compilation-mode-font-lock-keywords
t))
- (font-lock-mode)
- (read-only-mode))
- (pop-to-buffer buffer-name)))))
-
-;;;###autoload
-(defun dtache-rerun-session (session &optional suppress-output)
- "Rerun SESSION, optionally SUPPRESS-OUTPUT."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))
- current-prefix-arg))
- (when (dtache-valid-session session)
- (let* ((default-directory
- (dtache--session-working-directory session))
- (dtache-session-action (dtache--session-action session))
- (command (dtache--session-command session)))
- (if suppress-output
- (dtache-start-session command suppress-output)
- (if-let ((run-fun (plist-get (dtache--session-action session) :run)))
- (funcall run-fun command)
- (dtache-start-session command))))))
-
-;;;###autoload
-(defun dtache-attach-session (session)
- "Attach to SESSION."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (if (or (eq 'inactive (dtache--session-state session))
- (not (dtache--session-attachable session)))
- (dtache-open-session session)
- (if-let ((attach-fun (plist-get (dtache--session-action session)
:attach)))
- (funcall attach-fun session)
- (dtache-shell-command-attach-session session)))))
-
-;;;###autoload
-(defun dtache-copy-session (session)
- "Copy SESSION's output."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (with-temp-buffer
- (insert (dtache--session-output session))
- (when (eq 'terminal-data (dtache--session-env-mode session))
- ;; Enable `dtache-log-mode' to parse ansi-escape sequences
- (dtache-log-mode))
- (kill-new (buffer-string)))))
-
-;;;###autoload
-(defun dtache-copy-session-command (session)
- "Copy SESSION's command."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (kill-new (dtache--session-command session))))
-
-;;;###autoload
-(defun dtache-insert-session-command (session)
- "Insert SESSION's command."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (insert (dtache--session-command session))))
-
-;;;###autoload
-(defun dtache-delete-session (session)
- "Delete SESSION."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (if (eq 'active (dtache--determine-session-state session))
- (message "Kill session first before removing it.")
- (dtache--db-remove-entry session))))
-
-;;;###autoload
-(defun dtache-kill-session (session &optional delete)
- "Send a TERM signal to SESSION.
-
-Optionally DELETE the session if prefix-argument is provided."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))
- current-prefix-arg))
- (when (dtache-valid-session session)
- (when-let* ((default-directory (dtache--session-directory session))
- (pid (dtache--session-pid session)))
- (dtache--kill-processes pid))
- (when delete
- (dtache--db-remove-entry session))))
-
-;;;###autoload
-(defun dtache-view-session (session)
- "View the SESSION."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (let* ((buffer-name "*dtache-session-output*")
- (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)
- (setq-local buffer-read-only nil)
- (erase-buffer)
- (insert (dtache--session-output session))
- (setq-local default-directory (dtache--session-working-directory
session))
- (dtache-log-mode)
- (setq dtache--buffer-session session)
- (goto-char (point-max)))
- (pop-to-buffer buffer-name))
- (message "Dtache can't find file: %s" file-path)))))
-
-;;;###autoload
-(defun dtache-tail-session (session)
- "Tail the SESSION."
- (interactive
- (list (dtache-completing-read (dtache-get-sessions))))
- (when (dtache-valid-session session)
- (if (eq 'active (dtache--determine-session-state session))
- (let* ((file-path
- (dtache--session-file session 'log))
- (tramp-verbose 1))
- (when (file-exists-p file-path)
- (find-file-other-window file-path)
- (setq dtache--buffer-session session)
- (dtache-tail-mode)
- (goto-char (point-max))))
- (dtache-view-session session))))
-
-;;;###autoload
-(defun dtache-diff-session (session1 session2)
- "Diff SESSION1 with SESSION2."
- (interactive
- (let ((sessions (dtache-get-sessions)))
- `(,(dtache-completing-read sessions)
- ,(dtache-completing-read sessions))))
- (when (and (dtache-valid-session session1)
- (dtache-valid-session session2))
- (let ((buffer1 "*dtache-session-output-1*")
- (buffer2 "*dtache-session-output-2*"))
- (with-current-buffer (get-buffer-create buffer1)
- (erase-buffer)
- (insert (dtache--session-header session1))
- (insert (dtache--session-output session1))
- (when (eq 'terminal-data (dtache--session-env-mode session1))
- ;; Enable `dtache-log-mode' to parse ansi-escape sequences
- (dtache-log-mode)))
- (with-current-buffer (get-buffer-create buffer2)
- (erase-buffer)
- (insert (dtache--session-header session2))
- (insert (dtache--session-output session2))
- (when (eq 'terminal-data (dtache--session-env-mode session2))
- ;; Enable `dtache-log-mode' to parse ansi-escape sequences
- (dtache-log-mode)))
- (ediff-buffers buffer1 buffer2))))
-
-;;;###autoload
-(defun dtache-detach-session ()
- "Detach from session in current buffer.
-
-This command is only activated if `dtache--buffer-session' is an
-active session. For sessions created with `dtache-compile' or
-`dtache-shell-command', the command will also kill the window."
- (interactive)
- (if (dtache-session-p dtache--buffer-session)
- (if (eq major-mode 'dtache-tail-mode)
- (dtache-quit-tail-session)
- (if-let ((command-or-compile
- (cond ((string-match dtache--shell-command-buffer
(buffer-name)) t)
- ((string-match "\*dtache-compilation" (buffer-name))
t)
- ((eq major-mode 'dtache-log-mode) t)
- ((eq major-mode 'dtache-tail-mode) t)
- (t nil))))
- ;; `dtache-shell-command' or `dtache-compile'
- (let ((kill-buffer-query-functions nil))
- (when-let ((process (get-buffer-process (current-buffer))))
- (comint-simple-send process dtache--dtach-detach-character)
- (message "[dtache]"))
- (setq dtache--buffer-session nil)
- (kill-buffer-and-window))
- (if (eq 'active (dtache--determine-session-state
dtache--buffer-session))
- ;; `dtache-eshell'
- (if-let ((process (and (eq major-mode 'eshell-mode)
- (dtache-eshell-get-dtach-process))))
- (progn
- (setq dtache--buffer-session nil)
- (process-send-string process
dtache--dtach-detach-character))
- ;; `dtache-shell'
- (let ((process (get-buffer-process (current-buffer))))
- (comint-simple-send process dtache--dtach-detach-character)
- (setq dtache--buffer-session nil)))
- (message "No active dtache-session found in buffer."))))
- (message "No dtache-session found in buffer.")))
-
-;;;###autoload
-(defun dtache-delete-sessions (&optional all-hosts)
- "Delete `dtache' sessions which belong to the current host, unless
ALL-HOSTS."
- (interactive "P")
- (let* ((host-name (car (dtache--host)))
- (sessions (if all-hosts
- (dtache-get-sessions)
- (seq-filter (lambda (it)
- (string= (car (dtache--session-host it))
host-name))
- (dtache-get-sessions)))))
- (seq-do #'dtache--db-remove-entry sessions)))
-
-;;;###autoload
-(defun dtache-quit-tail-session ()
- "Quit `dtache' tail session.
-
-The log can have been updated, but that is not done by the user but
-rather the tail mode. To avoid a promtp `buffer-modified-p' is set to
-nil before closing."
- (interactive)
- (set-buffer-modified-p nil)
- (setq dtache--buffer-session nil)
- (kill-buffer-and-window))
-
-;;;; Functions
-
-;;;;; Session
-
-(defun dtache-create-session (command)
- "Create a `dtache' session from COMMAND."
- (dtache-connection-local-variables
- (dtache--create-session-directory)
- (let ((session
- (dtache--session-create :id (intern (dtache--create-id command))
- :command command
- :origin dtache-session-origin
- :action dtache-session-action
- :working-directory
(dtache--get-working-directory)
- :attachable (dtache-attachable-command-p
command)
- :time `(:start ,(time-to-seconds
(current-time)) :end 0.0 :duration 0.0 :offset 0.0)
- :status '(unknown . 0)
- :size 0
- :directory (if dtache-local-session
dtache-session-directory
- (concat (file-remote-p
default-directory) dtache-session-directory))
- :env-mode (dtache--env-mode command)
- :host (dtache--host)
- :metadata (dtache-metadata)
- :state 'unknown)))
- (dtache--db-insert-entry session)
- (dtache--watch-session-directory (dtache--session-directory session))
- session)))
-
-;;;###autoload
-(defun dtache-start-session (command &optional suppress-output)
- "Start a `dtache' session running COMMAND.
-
-Optionally SUPPRESS-OUTPUT."
- (let ((inhibit-message t)
- (dtache-enabled t)
- (dtache--current-session
- (or dtache--current-session
- (dtache-create-session command))))
- (if-let ((run-in-background
- (and (or suppress-output
- (eq dtache-session-mode 'create)
- (not (dtache--session-attachable
dtache--current-session)))))
- (dtache-session-mode 'create))
- (progn (setq dtache-enabled nil)
- (if dtache-local-session
- (apply #'start-process-shell-command
- `("dtache" nil ,(dtache-dtach-command
dtache--current-session t)))
- (apply #'start-file-process-shell-command
- `("dtache" nil ,(dtache-dtach-command
dtache--current-session t)))))
- (cl-letf* ((dtache-session-mode 'create-and-attach)
- ((symbol-function #'set-process-sentinel) #'ignore)
- (buffer (get-buffer-create dtache--shell-command-buffer)))
- (when (get-buffer-process buffer)
- (setq buffer (generate-new-buffer (buffer-name buffer))))
- (setq dtache-enabled nil)
- (funcall #'async-shell-command (dtache-dtach-command
dtache--current-session t) buffer)
- (with-current-buffer buffer (setq dtache--buffer-session
dtache--current-session))))))
-
-(defun dtache-session-candidates (sessions)
- "Return an alist of SESSIONS candidates."
- (when sessions
- (setq dtache--annotation-widths
- (dtache--annotation-widths sessions dtache-annotation-format))
- (let ((command-length
- (thread-last sessions
- (seq-map #'dtache--session-command)
- (seq-map #'length)
- (seq-max)
- (min (plist-get dtache-command-format ':width)))))
- (let ((command-fun (plist-get dtache-command-format ':function)))
- (setq dtache--session-candidates
- (thread-last sessions
- (seq-map (lambda (it)
- `(,(apply command-fun `(,it
,command-length))
- . ,it)))
- (dtache--session-deduplicate)
- (seq-map (lambda (it)
- `(,(concat (car it)
- (make-string (plist-get
dtache-command-format :padding) ?\s))
- . ,(cdr it))))))))))
-
-(defun dtache-session-annotation (item)
- "Associate ITEM to a session and return ts annotation."
- (let ((session (cdr (assoc item dtache--session-candidates))))
- (mapconcat
- #'identity
- (cl-loop for annotation in dtache-annotation-format
- collect (let ((str (funcall (plist-get annotation :function)
session))
- (width (alist-get (plist-get annotation :function)
dtache--annotation-widths)))
- (when (> width 0)
- (concat
- (truncate-string-to-width
- (propertize str 'face (plist-get annotation :face))
- width
- 0 ?\s)
- (make-string (plist-get annotation :padding) ?\s)
- ))))
- "")))
-
-;;;###autoload
-(defun dtache-initialize-sessions ()
- "Initialize `dtache' sessions from the database."
-
- ;; Initialize sessions
- (unless dtache--sessions-initialized
- (unless (file-exists-p dtache-db-directory)
- (make-directory dtache-db-directory t))
- (dtache--db-initialize)
- (setq dtache--db-watch
- (file-notify-add-watch dtache-db-directory
- '(change attribute-change)
- #'dtache--db-directory-event))
- (setq dtache--sessions-initialized t)
-
- ;; Remove missing local sessions
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (eq 'local (cdr
(dtache--session-host it)))))
- (seq-filter #'dtache--session-missing-p)
- (seq-do #'dtache--db-remove-entry))
-
- ;; Validate sessions with unknown state
- (dtache--validate-unknown-sessions)
-
- ;; Update transitioned sessions
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (eq 'active (dtache--session-state
it))))
- (seq-remove (lambda (it) (when (dtache--session-missing-p it)
- (dtache--db-remove-entry it)
- t)))
- (seq-filter #'dtache--state-transition-p)
- (seq-do #'dtache--session-state-transition-update))
-
- ;; Watch session directories with active sessions
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (eq 'active (dtache--session-state
it))))
- (seq-map #'dtache--session-directory)
- (seq-uniq)
- (seq-do #'dtache--watch-session-directory))))
-
-(defun dtache-valid-session (session)
- "Ensure that SESSION is valid.
-
-If session is not valid trigger an automatic cleanup on SESSION's host."
- (when (dtache-session-p session)
- (if (not (dtache--session-missing-p session))
- t
- (let ((host (dtache--session-host session)))
- (message "Session does not exist. Initiate sesion cleanup on host %s"
(car host))
- (dtache--cleanup-host-sessions host)
- nil))))
-
-(defun dtache-session-exit-code-status (session)
- "Return status based on exit-code in SESSION."
- (if (null dtache-env)
- `(unknown . 0)
- (let ((dtache-env-message
- (with-temp-buffer
- (insert-file-contents (dtache--session-file session 'log))
- (goto-char (point-max))
- (thing-at-point 'line t)))
- (success-message "Dtache session finished")
- (failure-message (rx "Dtache session exited abnormally with code "
(group (one-or-more digit)))))
- (cond ((string-match success-message dtache-env-message) `(success . 0))
- ((string-match failure-message dtache-env-message)
- `(failure . ,(string-to-number (match-string 1
dtache-env-message))))
- (t `(unknown . 0))))))
-
-(defun dtache-state-transitionion-echo-message (session)
- "Issue a notification when SESSION transitions from active to inactive.
-This function uses the echo area."
- (let ((status (pcase (car (dtache--session-status session))
- ('success "Dtache finished")
- ('failure "Dtache failed")
- ('unknown "Dtache finished"))))
- (message "%s [%s]: %s" status (car (dtache--session-host session))
(dtache--session-command session))))
-
-(defun dtache-state-transition-notifications-message (session)
- "Issue a notification when SESSION transitions from active to inactive.
-This function uses the `notifications' library."
- (let ((status (car (dtache--session-status session)))
- (host (car (dtache--session-host session))))
- (notifications-notify
- :title (pcase status
- ('success (format "Dtache finished [%s]" host))
- ('failure (format "Dtache failed [%s]" host))
- ('unknown (format "Dtache finished [%s]" host)))
- :body (dtache--session-command session)
- :urgency (pcase status
- ('success 'normal)
- ('failure 'critical)
- ('unknown 'normal)))))
-
-(defun dtache-view-dwim (session)
- "View SESSION in a do what I mean fashion."
- (let ((status (car (dtache--session-status session))))
- (cond ((eq 'success status)
- (dtache-view-session session))
- ((eq 'failure status)
- (dtache-compile-session session))
- ((eq 'unknown status)
- (dtache-view-session session))
- (t (message "Dtache session is in an unexpected state.")))))
-
-(defun dtache-get-sessions ()
- "Return validated sessions."
- (dtache--validate-unknown-sessions)
- (dtache--db-get-sessions))
-
-(defun dtache-shell-command-attach-session (session)
- "Attach to SESSION with `async-shell-command'."
- (let* ((dtache--current-session session)
- (dtache-session-mode 'attach)
- (inhibit-message t))
- (if (not (dtache--session-attachable session))
- (dtache-tail-session session)
- (cl-letf* (((symbol-function #'set-process-sentinel) #'ignore)
- (buffer (get-buffer-create dtache--shell-command-buffer))
- (default-directory (dtache--session-working-directory
session))
- (dtach-command (dtache-dtach-command session t)))
- (when (get-buffer-process buffer)
- (setq buffer (generate-new-buffer (buffer-name buffer))))
- (funcall #'async-shell-command dtach-command buffer)
- (with-current-buffer buffer (setq dtache--buffer-session
dtache--current-session))))))
-
-;;;;; Other
-
-(cl-defgeneric dtache-dtach-command (entity &optional concat)
- "Return dtach command for ENTITY optionally CONCAT.")
-
-(cl-defgeneric dtache-dtach-command ((command string) &optional concat)
- "Return dtach command for COMMAND.
-
-Optionally CONCAT the command return command into a string."
- (dtache-dtach-command (dtache-create-session command) concat))
-
-(cl-defgeneric dtache-dtach-command ((session dtache-session) &optional concat)
- "Return dtach command for SESSION.
-
-Optionally CONCAT the command return command into a string."
- (dtache-connection-local-variables
- (let* ((dtache-session-mode (cond ((eq dtache-session-mode 'attach) 'attach)
- ((not (dtache--session-attachable
session)) 'create)
- (t dtache-session-mode)))
- (socket (dtache--session-file session 'socket t))
- (log (dtache--session-file session 'log t))
- (dtach-arg (dtache--dtach-arg)))
- (setq dtache--buffer-session session)
- (if (eq dtache-session-mode 'attach)
- (if concat
- (mapconcat #'identity
- `(,(when dtache-show-output-on-attach
- (concat dtache-show-output-command " " log ";"))
- ,dtache-dtach-program
- ,dtach-arg
- ,socket
- "-r none")
- " ")
- (append
- (when dtache-show-output-on-attach
- `(,dtache-show-output-command ,(concat log ";")))
- `(,dtache-dtach-program ,dtach-arg ,socket "-r" "none")))
- (if concat
- (mapconcat #'identity
- `(,dtache-dtach-program
- ,dtach-arg
- ,socket "-z"
- ,dtache-shell-program "-c"
- ,(shell-quote-argument (dtache--dtache-command
session)))
- " ")
- `(,dtache-dtach-program
- ,dtach-arg ,socket "-z"
- ,dtache-shell-program "-c"
- ,(dtache--dtache-command session)))))))
-
-(defun dtache-attachable-command-p (command)
- "Return t if COMMAND is attachable."
- (if (thread-last dtache-nonattachable-commands
- (seq-filter (lambda (regexp)
- (string-match-p regexp command)))
- (length)
- (= 0))
- t
- nil))
-
-(defun dtache-metadata ()
- "Return a property list with metadata."
- (let ((metadata '()))
- (seq-doseq (annotator dtache-metadata-annotators-alist)
- (push `(,(car annotator) . ,(funcall (cdr annotator))) metadata))
- metadata))
-
-(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 . dtache-session-annotation)
- (affixation-function .
- ,(lambda (cands)
- (seq-map (lambda (s)
- `(,s nil
,(dtache-session-annotation s)))
- 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)))
- (dtache--decode-session cand)))
-
-(defun dtache-command-str (session max-length)
- "Return SESSION's command as a string restrict it to MAX-LENGTH."
- (let ((command (dtache--session-command session)))
- (if (<= (length command) max-length)
- (truncate-string-to-width
- command
- max-length
- 0 ?\s)
- (concat (substring (dtache--session-command session) 0 (- max-length 3))
"..."))))
-
-;;;; Support functions
-
-;;;;; Session
-
-(defun dtache--session-pid (session)
- "Return SESSION's pid."
- (let* ((socket
- (expand-file-name
- (concat (symbol-name (dtache--session-id session)) ".socket")
- (or
- (file-remote-p default-directory 'localname)
- default-directory))))
- (car
- (split-string
- (with-temp-buffer
- (apply #'process-file `("pgrep" nil t nil "-f" ,(shell-quote-argument
(format "dtach -. %s" socket))))
- (buffer-string))
- "\n" t))))
-
-(defun dtache--determine-session-state (session)
- "Return t if SESSION is active."
- (if (file-exists-p
- (dtache--session-file session 'socket))
- 'active
- 'inactive))
-
-(defun dtache--state-transition-p (session)
- "Return t if SESSION has transitioned from active to inactive."
- (and
- (eq 'active (dtache--session-state session))
- (eq 'inactive (dtache--determine-session-state session))))
-
-(defun dtache--session-missing-p (session)
- "Return t if SESSION is missing."
- (not
- (file-exists-p
- (dtache--session-file session 'log))))
-
-(defun dtache--session-header (session)
- "Return header for SESSION."
- (mapconcat
- #'identity
- `(,(format "Command: %s" (dtache--session-command session))
- ,(format "Working directory: %s" (dtache--working-dir-str session))
- ,(format "Host: %s" (car (dtache--session-host session)))
- ,(format "Id: %s" (symbol-name (dtache--session-id session)))
- ,(format "Status: %s" (car (dtache--session-status session)))
- ,(format "Exit-code: %s" (cdr (dtache--session-status session)))
- ,(format "Metadata: %s" (dtache--metadata-str session))
- ,(format "Created at: %s" (dtache--creation-str session))
- ,(format "Duration: %s\n" (dtache--duration-str session))
- "")
- "\n"))
-
-(defun dtache--session-deduplicate (sessions)
- "Make car of SESSIONS unique by adding an identifier to it."
- (let* ((ht (make-hash-table :test #'equal :size (length sessions)))
- (occurences
- (thread-last sessions
- (seq-group-by #'car)
- (seq-map (lambda (it) (seq-length (cdr it))))
- (seq-max)))
- (identifier-width (if (> occurences 1)
- (+ (length (number-to-string occurences)) 3)
- 0))
- (reverse-sessions (seq-reverse sessions)))
- (dolist (session reverse-sessions)
- (if-let (count (gethash (car session) ht))
- (setcar session (format "%s%s" (car session)
- (truncate-string-to-width
- (propertize (format " (%s)" (puthash (car
session) (1+ count) ht)) 'face 'dtache-identifier-face)
- identifier-width 0 ?\s)))
- (puthash (car session) 0 ht)
- (setcar session (format "%s%s" (car session) (make-string
identifier-width ?\s)))))
- (seq-reverse reverse-sessions)))
-
-(defun dtache--decode-session (item)
- "Return the session assicated with ITEM."
- (cdr (assoc item dtache--session-candidates)))
-
-(defun dtache--validate-unknown-sessions ()
- "Validate `dtache' sessions with state unknown."
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (eq 'unknown (dtache--session-state
it))))
- (seq-do (lambda (it)
- (if (dtache--session-missing-p it)
- (dtache--db-remove-entry it)
- (setf (dtache--session-state it) 'active)
- (dtache--db-update-entry it))))))
-
-(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-local-path (file-remote-p (expand-file-name file-name
(dtache--session-directory session)) 'localname))
- (full-path (expand-file-name file-name (dtache--session-directory
session))))
- (if (and local remote-local-path)
- remote-local-path
- full-path)))
-
-(defun dtache--cleanup-host-sessions (host)
- "Run cleanuup on HOST sessions."
- (let ((host-name (car host)))
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (string= host-name (car
(dtache--session-host it)))))
- (seq-filter #'dtache--session-missing-p)
- (seq-do #'dtache--db-remove-entry))))
-
-(defun dtache--session-output (session)
- "Return content of SESSION's output."
- (let* ((filename (dtache--session-file session 'log))
- (dtache-message (rx (regexp "\n?\nDtache session ") (or "finished"
"exited"))))
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (let ((beginning (point))
- (end (if (search-forward-regexp dtache-message nil t)
- (match-beginning 0)
- (point-max))))
- (buffer-substring beginning end)))))
-
-(defun dtache--create-session-directory ()
- "Create session directory if it doesn't exist."
- (let ((directory
- (concat
- (file-remote-p default-directory)
- dtache-session-directory)))
- (unless (file-exists-p directory)
- (make-directory directory t))))
-
-(defun dtache--get-working-directory ()
- "Return an abbreviated working directory path."
- (if-let (remote (file-remote-p default-directory))
- (replace-regexp-in-string (expand-file-name remote)
- (concat remote "~/")
- (expand-file-name default-directory))
- (abbreviate-file-name default-directory)))
-
-;;;;; Database
-
-(defun dtache--db-initialize ()
- "Return all sessions stored in database."
- (let ((db (expand-file-name "dtache.db" dtache-db-directory)))
- (when (file-exists-p db)
- (with-temp-buffer
- (insert-file-contents db)
- (cl-assert (bobp))
- (when (string= (dtache--db-session-version) dtache-session-version)
- (setq dtache--sessions
- (read (current-buffer))))))))
-
-(defun dtache--db-session-version ()
- "Return `dtache-session-version' from database."
- (let ((header (thing-at-point 'line))
- (regexp (rx "Dtache Session Version: " (group (one-or-more (or digit
punct))))))
- (string-match regexp header)
- (match-string 1 header)))
-
-(defun dtache--db-insert-entry (session)
- "Insert SESSION into `dtache--sessions' and update database."
- (dtache-initialize-sessions)
- (push `(,(dtache--session-id session) . ,session) dtache--sessions)
- (dtache--db-update-sessions))
-
-(defun dtache--db-remove-entry (session)
- "Remove SESSION from `dtache--sessions', delete log and update database."
- (dtache-initialize-sessions)
- (let ((log (dtache--session-file session 'log)))
- (when (file-exists-p log)
- (delete-file log)))
- (setq dtache--sessions
- (assq-delete-all (dtache--session-id session) dtache--sessions))
- (dtache--db-update-sessions))
-
-(defun dtache--db-update-entry (session &optional update)
- "Update SESSION in `dtache--sessions' optionally UPDATE database."
- (dtache-initialize-sessions)
- (setf (alist-get (dtache--session-id session) dtache--sessions) session)
- (when update
- (dtache--db-update-sessions)))
-
-(defun dtache--db-get-session (id)
- "Return session with ID."
- (dtache-initialize-sessions)
- (alist-get id dtache--sessions))
-
-(defun dtache--db-get-sessions ()
- "Return all sessions stored in the database."
- (dtache-initialize-sessions)
- (seq-map #'cdr dtache--sessions))
-
-(defun dtache--db-update-sessions ()
- "Write `dtache--sessions' to database."
- (dtache-initialize-sessions)
- (let ((db (expand-file-name "dtache.db" dtache-db-directory)))
- (with-temp-file db
- (insert (format ";; Dtache Session Version: %s\n\n"
dtache-session-version))
- (prin1 dtache--sessions (current-buffer)))))
-
-;;;;; Other
-
-(defun dtache--dtach-arg ()
- "Return dtach argument based on `dtache-session-mode'."
- (pcase dtache-session-mode
- ('create "-n")
- ('create-and-attach "-c")
- ('attach "-a")
- (_ (error "`dtache-session-mode' has an unknown value"))))
-
-(defun dtache--session-state-transition-update (session)
- "Update SESSION due to state transition."
- ;; Update session
- (let ((session-size (file-attribute-size
- (file-attributes
- (dtache--session-file session 'log))))
- (session-time (dtache--update-session-time session) )
- (status-fun (or (plist-get (dtache--session-action session) :status)
- #'dtache-session-exit-code-status)))
- (setf (dtache--session-size session) session-size)
- (setf (dtache--session-time session) session-time)
- (setf (dtache--session-state session) 'inactive)
- (setf (dtache--session-status session) (funcall status-fun session)))
-
- ;; Send notification
- (funcall dtache-notification-function session)
-
- ;; Update session in database
- (dtache--db-update-entry session t)
-
- ;; Execute callback
- (when-let ((callback (plist-get (dtache--session-action session) :callback)))
- (funcall callback session)))
-
-(defun dtache--kill-processes (pid)
- "Kill PID and all of its children."
- (let ((child-processes
- (split-string
- (with-temp-buffer
- (apply #'process-file `("pgrep" nil t nil "-P" ,pid))
- (buffer-string))
- "\n" t)))
- (seq-do (lambda (pid) (dtache--kill-processes pid)) child-processes)
- (apply #'process-file `("kill" nil nil nil ,pid))))
-
-(defun dtache--dtache-command (session)
- "Return the dtache command for SESSION.
-
-If SESSION is nonattachable fallback to a command that doesn't rely on tee."
- (let* ((log (dtache--session-file session 'log t))
- (begin-shell-group (if (string= "fish" (file-name-nondirectory
dtache-shell-program))
- "begin;"
- "{"))
- (end-shell-group (if (or (string= "fish" (file-name-nondirectory
dtache-shell-program)))
- "end"
- "}"))
- (redirect
- (if (dtache--session-attachable session)
- (format "2>&1 | tee %s" log)
- (format "&> %s" log)))
- (env (if dtache-env dtache-env (format "%s -c" dtache-shell-program)))
- (command
- (if dtache-env
- (concat (format "%s " (dtache--session-env-mode session))
- (shell-quote-argument (dtache--session-command session)))
- (shell-quote-argument (dtache--session-command session)))))
- (format "%s %s %s; %s %s" begin-shell-group env command end-shell-group
redirect)))
-
-(defun dtache--env-mode (command)
- "Return mode to run in `dtache-env' based on COMMAND."
- (if (seq-find (lambda (regexp)
- (string-match-p regexp command))
- dtache-env-plain-text-commands)
- 'plain-text
- 'terminal-data))
-
-(defun dtache--host ()
- "Return a cons with (host . type)."
- (let ((remote (file-remote-p default-directory)))
- `(,(if remote (file-remote-p default-directory 'host) (system-name)) .
,(if remote 'remote 'local))))
-
-(defun dtache--ansi-color-tail ()
- "Apply `ansi-color' on tail output."
- (let ((inhibit-read-only t))
- (ansi-color-apply-on-region auto-revert-tail-pos (point-max))))
-
-(defun dtache--update-session-time (session &optional approximate)
- "Update SESSION's time property.
-
-If APPROXIMATE, use latest modification time of SESSION's
-log to deduce the end time."
- (let* ((start-time (plist-get (dtache--session-time session) :start))
- (end-time))
- (if approximate
- (setq end-time
- (time-to-seconds
- (file-attribute-modification-time
- (file-attributes
- (dtache--session-file session 'log)))))
- (setq end-time (time-to-seconds)))
- `(:start ,start-time :end ,end-time :duration ,(- end-time start-time))))
-
-(defun dtache--create-id (command)
- "Return a hash identifier for COMMAND."
- (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\^M\n" dtache--dtach-eof-message) ""
str))
-
-(defun dtache--dtach-dtache-message-filter (str)
- "Remove `dtache--dtach-dtache-message' in STR."
- (replace-regexp-in-string (format "\n?%s\n" dtache--dtach-dtache-message) ""
str))
-
-(defun dtache--watch-session-directory (session-directory)
- "Watch for events in SESSION-DIRECTORY."
- (unless (alist-get session-directory dtache--watched-session-directories
- nil nil #'string=)
- (push
- `(,session-directory . ,(file-notify-add-watch
- session-directory
- '(change)
- #'dtache--session-directory-event))
- dtache--watched-session-directories)))
-
-(defun dtache--session-directory-event (event)
- "Act on an EVENT in a directory in `dtache--watched-session-directories'.
-
-If event is caused by the deletion of a socket, locate the related
-session and trigger a state transition."
- (pcase-let* ((`(,_ ,action ,file) event))
- (when (and (eq action 'deleted)
- (string= "socket" (file-name-extension file)))
- (when-let* ((id (intern (file-name-base file)))
- (session (dtache--db-get-session id))
- (session-directory (dtache--session-directory session)))
-
- ;; Update session
- (dtache--session-state-transition-update session)
-
- ;; Remove session directory from `dtache--watch-session-directory'
- ;; if there is no active session associated with the directory
- (unless
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (eq 'active
(dtache--session-state it))))
- (seq-map #'dtache--session-directory)
- (seq-uniq)
- (seq-filter (lambda (it) (string= it
session-directory))))
- (file-notify-rm-watch
- (alist-get session-directory dtache--watched-session-directories))
- (setq dtache--watched-session-directories
- (assoc-delete-all session-directory
dtache--watched-session-directories)))))))
-
-(defun dtache--db-directory-event (event)
- "Act on EVENT in `dtache-db-directory'.
-
-If event is cased by an update to the `dtache' database, re-initialize
-`dtache--sessions'."
- (pcase-let* ((`(,_descriptor ,action ,file) event)
- (database-updated (and (string= "dtache.db" file)
- (eq 'attribute-changed action))))
- (when database-updated)
- (dtache--db-initialize)))
-
-(defun dtache--annotation-widths (sessions annotation-format)
- "Return widths for ANNOTATION-FORMAT based on SESSIONS."
- (seq-map (lambda (it) (dtache--annotation-width sessions it))
annotation-format))
-
-(defun dtache--annotation-width (sessions annotation)
- "Determine width for ANNOTATION based on SESSIONS."
- (let ((annotation-fun (plist-get annotation ':function))
- (width (plist-get annotation ':width)))
- `(,annotation-fun .
- ,(thread-last sessions
- (seq-map annotation-fun)
- (seq-map #'length)
- (seq-max)
- (min width)))))
-
-;;;;; 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)))))
- ""))
-
-(defun dtache--duration-str (session)
- "Return SESSION's duration time."
- (let* ((duration (if (eq 'active (dtache--session-state session))
- (- (time-to-seconds) (plist-get (dtache--session-time
session) :start))
- (plist-get
- (dtache--session-time session) :duration)))
- (time (round duration))
- (hours (/ time 3600))
- (minutes (/ (mod time 3600) 60))
- (seconds (mod time 60)))
- (cond ((> time (* 60 60)) (format "%sh %sm %ss" hours minutes seconds))
- ((> time 60) (format "%sm %ss" minutes seconds))
- (t (format "%ss" seconds)))))
-
-(defun dtache--creation-str (session)
- "Return SESSION's creation time."
- (format-time-string
- "%b %d %H:%M"
- (plist-get
- (dtache--session-time session) :start)))
-
-(defun dtache--size-str (session)
- "Return the size of SESSION's output."
- (if (eq 'active (dtache--session-state session))
- ""
- (file-size-human-readable
- (dtache--session-size session))))
-
-(defun dtache--status-str (session)
- "Return string if SESSION has failed."
- (pcase (car (dtache--session-status session))
- ('failure "!")
- ('success "")
- ('unknown "")))
-
-(defun dtache--state-str (session)
- "Return string based on SESSION state."
- (if (eq 'active (dtache--session-state 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)))
-
-(defun dtache--host-str (session)
- "Return host name of SESSION."
- (car (dtache--session-host session)))
-
-;;;; Minor modes
-
-(defvar dtache-shell-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd dtache-detach-key) #'dtache-detach-session)
- map)
- "Keymap for `dtache-shell-mode'.")
-
-;;;###autoload
-(define-minor-mode dtache-shell-mode
- "Integrate `dtache' in `shell-mode'."
- :lighter " dtache-shell"
- :keymap (let ((map (make-sparse-keymap)))
- map)
- (if dtache-shell-mode
- (dolist (filter dtache-shell-mode-filter-functions)
- (add-hook 'comint-preoutput-filter-functions filter 0 t))
- (dolist (filter dtache-shell-mode-filter-functions)
- (remove-hook 'comint-preoutput-filter-functions filter t))))
-
-;;;; Major modes
-
-(defvar dtache-log-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd dtache-detach-key) #'dtache-detach-session)
- map)
- "Keymap for `dtache-log-mode'.")
-
-;;;###autoload
-(define-derived-mode dtache-log-mode nil "Dtache Log"
- "Major mode for `dtache' logs."
- (when dtache-filter-ansi-sequences
- (comint-carriage-motion (point-min) (point-max))
- (set-buffer-modified-p nil)
- (ansi-color-apply-on-region (point-min) (point-max)))
- (read-only-mode t))
-
-(defvar dtache-tail-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd dtache-detach-key) #'dtache-detach-session)
- map)
- "Keymap for `dtache-tail-mode'.")
-
-;;;###autoload
-(define-derived-mode dtache-tail-mode auto-revert-tail-mode "Dtache Tail"
- "Major mode to tail `dtache' logs."
- (setq-local auto-revert-interval dtache-tail-interval)
- (setq-local tramp-verbose 1)
- (setq-local auto-revert-remote-files t)
- (defvar revert-buffer-preserve-modes)
- (setq-local revert-buffer-preserve-modes nil)
- (auto-revert-set-timer)
- (setq-local auto-revert-verbose nil)
- (auto-revert-tail-mode)
- (when dtache-filter-ansi-sequences
- (comint-carriage-motion (point-min) (point-max))
- (set-buffer-modified-p nil)
- (add-hook 'after-revert-hook #'dtache--ansi-color-tail nil t)
- (ansi-color-apply-on-region (point-min) (point-max)))
- (read-only-mode t))
(provide 'dtache)
;;; dtache.el ends here
+(require 'detached)
diff --git a/guix.scm b/guix.scm
deleted file mode 100644
index b76838f33f..0000000000
--- a/guix.scm
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; guix.scm -- Guix package definition
-
-(use-modules
- (guix packages)
- (guix git-download)
- (guix gexp)
- (guix build-system gnu)
- ((guix licenses) #:prefix license:)
- (guix build-system emacs)
- (gnu packages emacs-xyz)
- (gnu packages screen)
- (ice-9 popen)
- (ice-9 rdelim))
-
-(define %source-dir (dirname (current-filename)))
-
-(define %git-commit
- (read-string (open-pipe "git show HEAD | head -1 | cut -d ' ' -f2"
OPEN_READ)))
-
-(define-public emacs-dtache
- (let ((branch "remote")
- (commit "220f93dfa710474b4f9c9db0349a6082374f80c0")
- (revision "0"))
- (package
- (name "emacs-dtache")
- (version (git-version "0.0" revision commit))
- (source
- (origin
- (method git-fetch)
- (uri (git-reference
- (url "https://gitlab.com/niklaseklund/dtache";)
- (commit commit)))
- (sha256
- (base32
- "0yvkygdqghrp8xn7nfgfq3x5y913r6kasqndxy3fr2dqpxxb941a"))
- (file-name (git-file-name name version))))
- (build-system emacs-build-system)
- (native-inputs
- `(("emacs-ert-runner" ,emacs-ert-runner)))
- (inputs `(("dtach" ,dtach)))
- (arguments
- `(#:tests? #t
- #:test-command '("ert-runner")))
- (home-page "https://gitlab.com/niklaseklund/dtache";)
- (synopsis "Dtach Emacs")
- (description "Dtache allows a program to be seamlessly executed
-in an environment that is isolated from Emacs.")
- (license license:gpl3+))))
-
-(package
- (inherit emacs-dtache)
- (name "emacs-dtache-git")
- (version (git-version (package-version emacs-dtache) "HEAD" %git-commit))
- (source (local-file %source-dir
- #:recursive? #t)))
diff --git a/test/dtache-test.el b/test/dtache-test.el
deleted file mode 100644
index 905b0b15fc..0000000000
--- a/test/dtache-test.el
+++ /dev/null
@@ -1,296 +0,0 @@
-;;; dtache-test.el --- Tests for dtache.el -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Tests for `dtache'.
-
-;;; Code:
-
-;;;; Requirements
-
-(require 'ert)
-(require 'dtache)
-
-;;;; Support
-
-(defmacro dtache-test--with-temp-database (&rest body)
- "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--sessions)
- (dtache--sessions-initialized)
- (dtache--remote-session-timer))
- (unwind-protect
- (progn
- (dtache-initialize-sessions)
- ,@body)
- (delete-directory temp-directory t))))
-
-(cl-defun dtache-test--create-session (&key command host)
- "Create session with COMMAND running on HOST."
- (cl-letf* (((symbol-function #'dtache--host) (lambda () host))
- ((symbol-function #'dtache-metadata) (lambda () nil))
- ((symbol-function #'dtache--watch-session-directory) #'ignore)
- (session (dtache-create-session command)))
- (dtache-test--change-session-state session 'activate)
- session))
-
-(defun dtache-test--change-session-state (session state)
- "Set STATE of SESSION."
- (pcase state
- ('activate
- (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)))))
-
-;;;; Tests
-
-(ert-deftest dtache-test-dtach-command ()
- (dtache-test--with-temp-database
- (cl-letf* ((dtache-dtach-program "dtach")
- (dtache-env "dtache-env")
- (dtache-shell-program "bash")
- (session (dtache-create-session "ls -la"))
- (dtache-show-output-on-attach t)
- (dtache-show-output-command "/bin/cat")
- ((symbol-function #'dtache-create-session)
- (lambda (_)
- session)))
- (let* ((dtache-session-mode 'create-and-attach)
- (expected `(,dtache-dtach-program
- "-c" ,(dtache--session-file session 'socket t)
- "-z" ,dtache-shell-program
- "-c"
- ,(format "{ dtache-env terminal-data ls\\ -la; } 2>&1
| tee %s"
- (dtache--session-file session 'log t))))
- (expected-concat (format "%s -c %s -z %s -c %s"
- dtache-dtach-program
- (dtache--session-file session 'socket t)
- dtache-shell-program
- (shell-quote-argument
- (format "{ dtache-env terminal-data ls\\
-la; } 2>&1 | tee %s"
- (dtache--session-file session
'log t))))))
- (should (equal expected (dtache-dtach-command session)))
- (should (equal expected-concat (dtache-dtach-command session t))))
- (let* ((dtache-session-mode 'attach)
- (expected `(,dtache-show-output-command
- ,(format "%s;" (dtache--session-file session 'log t))
- ,dtache-dtach-program "-a" ,(dtache--session-file
session 'socket t) "-r" "none"))
- (expected-concat (format "%s %s; %s -a %s -r none"
- dtache-show-output-command
- (dtache--session-file session 'log t)
- dtache-dtach-program
- (dtache--session-file session 'socket
t))))
- (should (equal expected (dtache-dtach-command session)))
- (should (equal expected-concat (dtache-dtach-command session t)))))))
-
-(ert-deftest dtache-test-metadata ()
- ;; No annotators
- (let ((dtache-metadata-annotators-alist '()))
- (should (not (dtache-metadata))))
-
- ;; Two annotators
- (let ((dtache-metadata-annotators-alist
- '((git-branch . (lambda () "foo"))
- (username . (lambda () "bar"))))
- (expected '((username . "bar")
- (git-branch . "foo"))))
- (should (equal (dtache-metadata) expected))))
-
-(ert-deftest dtache-test-session-file ()
- ;; Local files
- (cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory)
(concat directory file)))
- ((symbol-function #'file-remote-p) (lambda (_directory
_localname) "/home/user/tmp"))
- (session (dtache--session-create :id 's12345 :directory
"/home/user/tmp/")))
- (should (string= "/home/user/tmp/s12345.log" (dtache--session-file session
'log)))
- (should (string= "/home/user/tmp/s12345.socket" (dtache--session-file
session 'socket))))
-
- ;; Remote files
- (cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory)
(concat directory file)))
- ((symbol-function #'file-remote-p) (lambda (_directory
_localname) "/ssh:foo:/home/user/tmp/"))
- (session (dtache--session-create :id 's12345 :directory
"/ssh:foo:/home/user/tmp/")))
- (should (string= "/ssh:foo:/home/user/tmp/s12345.log"
(dtache--session-file session 'log)))
- (should (string= "/ssh:foo:/home/user/tmp/s12345.socket"
(dtache--session-file session 'socket)))))
-
-(ert-deftest dtache-test-host ()
- (cl-letf (((symbol-function #'system-name) (lambda () "localhost")))
- (should (equal '("localhost" . local) (dtache--host))))
- (let ((default-directory "/ssh:remotehost:/home/user/git"))
- (should (equal '("remotehost" . remote) (dtache--host)))))
-
-(ert-deftest dtache-test-session-active-p ()
- (dtache-test--with-temp-database
- (let ((session (dtache-test--create-session :command "foo" :host '("bar" .
local))))
- (should (eq 'active (dtache--determine-session-state session)))
- (dtache-test--change-session-state session 'deactivate)
- (should (eq 'inactive (dtache--determine-session-state session))))))
-
-(ert-deftest dtache-test-session-dead-p ()
- (dtache-test--with-temp-database
- (let ((session (dtache-test--create-session :command "foo" :host '("bar" .
local))))
- (should (not (dtache--session-missing-p session)))
- (dtache-test--change-session-state session 'deactivate)
- (should (not (dtache--session-missing-p session)))
- (dtache-test--change-session-state session 'kill)
- (should (dtache--session-missing-p session)))))
-
-(ert-deftest dtache-test-cleanup-host-sessions ()
- (dtache-test--with-temp-database
- (cl-letf* ((session1 (dtache-test--create-session :command "foo" :host
'("remotehost" . remote)))
- (session2 (dtache-test--create-session :command "bar" :host
'("localhost" . local)))
- (session3 (dtache-test--create-session :command "baz" :host
'("localhost" . local)))
- (host '("localhost" . local))
- ((symbol-function #'dtache--host) (lambda () host)))
- ;; One inactive, one missing, one active
- (dtache-test--change-session-state session1 'deactivate)
- (dtache-test--change-session-state session2 'kill)
- (dtache--cleanup-host-sessions host)
- (dtache--db-get-sessions)
- (should (seq-set-equal-p
- (dtache--db-get-sessions)
- `(,session1 ,session3))))))
-
-(ert-deftest dtache-test-dtach-arg ()
- (let ((dtache-session-mode 'create))
- (should (string= "-n" (dtache--dtach-arg))))
- (let ((dtache-session-mode 'create-and-attach))
- (should (string= "-c" (dtache--dtach-arg))))
- (let ((dtache-session-mode 'attach))
- (should (string= "-a" (dtache--dtach-arg))))
- (let ((dtache-session-mode nil))
- (should-error (dtache--dtach-arg))))
-
-;;;;; Database
-
-(ert-deftest dtache-test-db-insert-session ()
- (dtache-test--with-temp-database
- (let* ((session (dtache-test--create-session :command "foo" :host
'("localhost" . local))))
- (should (equal (dtache--db-get-sessions) `(,session))))))
-
-(ert-deftest dtache-test-db-remove-session ()
- (dtache-test--with-temp-database
- (let* ((host '(:type local :name "host"))
- (session1 (dtache-test--create-session :command "foo" :host '("host"
. local)))
- (session2 (dtache-test--create-session :command "bar" :host '("host"
. local))))
- (should (seq-set-equal-p `(,session1 ,session2)
(dtache--db-get-sessions)))
- (dtache--db-remove-entry session1)
- (should (seq-set-equal-p `(,session2) (dtache--db-get-sessions))))))
-
-(ert-deftest dtache-test-db-update-session ()
- (dtache-test--with-temp-database
- (let* ((session (dtache-test--create-session :command "foo" :host '("host"
. local)))
- (id (dtache--session-id session))
- (copy))
- (setq copy (copy-dtache-session session))
- (setf (dtache--session-state copy) nil)
- (should (not (equal copy (dtache--db-get-session id))))
- (dtache--db-update-entry copy t)
- (should (equal copy (car (dtache--db-get-sessions)))))))
-
-(ert-deftest dtache-test-dtache-command ()
- (let ((attachable-session (dtache--session-create :directory "/tmp/dtache/"
- :working-directory
"/home/user/"
- :command "ls -la"
- :attachable t
- :env-mode 'terminal-data
- :id 'foo123))
- (nonattachable-session (dtache--session-create :directory
"/tmp/dtache/"
- :working-directory
"/home/user/"
- :command "ls -la"
- :attachable nil
- :env-mode 'plain-text
- :id 'foo123)))
- ;; With dtache-env
- (let ((dtache-env "dtache-env"))
- (should (string= "{ dtache-env terminal-data ls\\ -la; } 2>&1 | tee
/tmp/dtache/foo123.log"
- (dtache--dtache-command attachable-session)))
- (should (string= "{ dtache-env plain-text ls\\ -la; } &>
/tmp/dtache/foo123.log"
- (dtache--dtache-command nonattachable-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--dtache-command attachable-session)))
- (should (string= "{ bash -c ls\\ -la; } &> /tmp/dtache/foo123.log"
- (dtache--dtache-command nonattachable-session))))))
-
-(ert-deftest dtache-test-attachable-command-p ()
- (let ((dtache-nonattachable-commands '("ls")))
- (should (dtache-attachable-command-p "cd"))
- (should (not (dtache-attachable-command-p "ls -la")))))
-
-;;;;; String representations
-
-(ert-deftest dtache-test-duration-str ()
- (should (string= "1s" (dtache--duration-str (dtache--session-create :time
'(:duration 1)))))
- (should (string= "1m 1s" (dtache--duration-str (dtache--session-create :time
'(:duration 61)))))
- (should (string= "1h 1m 1s" (dtache--duration-str (dtache--session-create
:time '(:duration 3661))))))
-
-(ert-deftest dtache-test-creation-str ()
- ;; Make sure to set the TIMEZONE before executing the test to avoid
- ;; differences between machines
- (cl-letf* (((getenv "TZ") "UTC0")
- (session (dtache--session-create :time `(:start
1620463748.7636228))))
- (should (string= "May 08 08:49" (dtache--creation-str session)))))
-
-(ert-deftest dtache-test-size-str ()
- (should (string= "100" (dtache--size-str (dtache--session-create :size 100
:state 'inactive))))
- (should (string= "1k" (dtache--size-str (dtache--session-create :size 1024
:state 'inactive)))))
-
-(ert-deftest dtache-test-status-str ()
- (should (string= "!" (dtache--status-str (dtache--session-create :status
'(failure . 127)))))
- (should (string= "" (dtache--status-str (dtache--session-create :status
'(success . 0)))))
- (should (string= "" (dtache--status-str (dtache--session-create :status
'(unknown . 0))))))
-
-(ert-deftest dtache-test-state-str ()
- (should (string= "*" (dtache--state-str (dtache--session-create :state
'active))))
- (should (string= "" (dtache--state-str (dtache--session-create :state
'inactive)))))
-
-(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")))))
-
-;;;;; 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-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