[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/dtache bcbc2d8b4d 003/158: Merge with development branc
From: |
ELPA Syncer |
Subject: |
[elpa] externals/dtache bcbc2d8b4d 003/158: Merge with development branch |
Date: |
Wed, 19 Jan 2022 18:57:39 -0500 (EST) |
branch: externals/dtache
commit bcbc2d8b4dd071feeb86cdfb278f0d88a3679165
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>
Merge with development branch
---
LICENSE | 6 +-
README.org | 86 +++++++
dtache-embark.el | 56 +++++
dtache-marginalia.el | 124 +++++++++++
dtache-shell.el | 136 +++++++++++
dtache.el | 496 +++++++++++++++++++++++++++++++++++++++++
notes.org | 24 ++
test/dtache-marginalia-test.el | 61 +++++
test/dtache-shell-test.el | 42 ++++
test/dtache-test.el | 57 +++++
10 files changed, 1085 insertions(+), 3 deletions(-)
diff --git a/LICENSE b/LICENSE
index b2d71a0d04..fb021035fd 100644
--- a/LICENSE
+++ b/LICENSE
@@ -631,8 +631,8 @@ to attach them to the start of each source file to most
effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
- detached
- Copyright (C) 2020 Niklas Carlsson
+ dtache
+ Copyright (C) 2020 Niklas Eklund
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
@@ -652,7 +652,7 @@ Also add information on how to contact you by electronic
and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
- detached Copyright (C) 2020 Niklas Carlsson
+ dtache Copyright (C) 2020 Niklas Eklund
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
diff --git a/README.org b/README.org
index e69de29bb2..6d670ed9bc 100644
--- a/README.org
+++ b/README.org
@@ -0,0 +1,86 @@
+* About
+
+The ~dtache~ package brings detachable commands to Emacs. Currently
+it is mainly boosting ~M-x shell~ through the ~dtache-shell.el~
+package. The ~dtache.el~ is the backend that provides a mean to create
+detachable sessions, and manages them through a database.
+
+** Background
+
+The package provides the following:
+- allows shell commands to run detached from Emacs
+- access to metadata as well as logs from the sessions
+
+** Configuration
+
+Configure the ~dtache~ package.
+
+#+begin_src elisp
+ (use-package dtache
+ :config
+ ;; Configure directories for the database as well as sessions
+ (setq dtache-db-directory (expand-file-name "dtache" user-emacs-directory))
+ (require 'xdg)
+ (setq dtache-session-directory (f-join (xdg-runtime-dir) "dtache"))
+ ;; Run the setup
+ (dtache-setup))
+#+end_src
+
+Configure the ~dtache-shell~ package. The ~dtache-shell-enable~ will
+activate the dtache-shell minor mode in shell buffers.
+
+#+begin_src elisp
+ (use-package dtache-shell
+ :hook (after-init . dtache-shell-enable))
+#+end_src
+
+Configure the keybindings for the minor mode. The choice here is
+either going inclusive on the package replacing the normal behavior of
+shell, or to be more deliberate.
+
+The following is the evil-bindings for the more adventurous configuration.
+#+begin_src elisp
+ (general-def dtache-shell-mode-map
+ "<return>" #'dtache-shell-create-session
+ "<S-return>" #'comint-send-input
+ "<C-return>" #'dtache-attach-to-session)
+#+end_src
+
+** Optional
+
+If you are a user of ~marginalia~ and ~embark~ you might also be
+interested in adding the following to enrich the
+~dtache-attach-to-session~ command.
+
+#+begin_src elisp
+ (use-package dtache-marginalia
+ :after (dtache marginalia)
+ :config
+ (add-to-list 'marginalia-annotators-heavy '(dtache .
dtache-marginalia-annotate)))
+
+ (use-package dtache-embark
+ :after (dtache embark))
+#+end_src
+
+** Commands
+
+The following is a list of commands that can be run on ~dtache~
+sessions.
+
+| Command | Description |
+|-----------------------------+---------------------------------------------|
+| dtache-attach-to-session | Attach to a session |
+| dtache-open-log | Open the output log for a session |
+| dtache-open-stdout | Open the stdout for a session |
+| dtache-open-stderr | Open the stderr for a session |
+| dtache-copy-session | Copy the session command |
+| dtache-copy-session-content | Copy the output of a session |
+| dtache-kill-session | Kill an active session |
+| dtache-remove-session | Remove a session |
+| dtache-compile-session | Open the session output in compilation mode |
+| dtache-shell-create-session | Create a session from a shell command |
+
+* Recognition
+
+The inspiration for the package comes from
[[https://github.com/Ambrevar/dotfiles/blob/master/.emacs.d/lisp/package-eshell-detach.el][ambrevar's
+package-eshell-detach]].
diff --git a/dtache-embark.el b/dtache-embark.el
new file mode 100644
index 0000000000..6cc8968082
--- /dev/null
+++ b/dtache-embark.el
@@ -0,0 +1,56 @@
+;;; dtache-embark.el --- Embark for dtache -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; URL: https://www.gitlab.com/niklaseklund/dtache.git
+;; Version: 0.1
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: convenience processes
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides an embark keymap for dtache.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'dtache)
+(require 'embark)
+
+;;;; Keymap
+
+(embark-define-keymap dtache-embark-map
+ "Keymap for Embark dtache actions."
+ ("l" dtache-open-log)
+ ("e" dtache-open-stderr)
+ ("o" dtache-open-stdout)
+ ("i" dtache-insert-session)
+ ("w" dtache-copy-session)
+ ("W" dtache-copy-session-content)
+ ("c" dtache-compile-session)
+ ("d" dtache-remove-session)
+ ("k" dtache-kill-session)
+ ("s" dtache-consult-search-session))
+
+(add-to-list 'embark-keymap-alist '(dtache . dtache-embark-map))
+
+(provide 'dtache-embark)
+
+;;; dtache-embark.el ends here
diff --git a/dtache-marginalia.el b/dtache-marginalia.el
new file mode 100644
index 0000000000..42645a7e85
--- /dev/null
+++ b/dtache-marginalia.el
@@ -0,0 +1,124 @@
+;;; dtache-marginalia.el --- Marginalia for dtache -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; URL: https://www.gitlab.com/niklaseklund/dtache.git
+;; Version: 0.1
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: convenience processes
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides a marginalia annotator for dtache.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'dtache)
+(require 'marginalia)
+
+;;;; Variables
+
+(defvar dtache-marginalia-git-branch-length 30)
+(defvar dtache-marginalia-duration-length 10)
+(defvar dtache-marginalia-size-length 8)
+(defvar dtache-marginalia-date-length 12)
+
+;;;; Faces
+
+(defface dtache-marginalia-git
+ '((t :inherit marginalia-char))
+ "Face used to highlight git information in `marginalia-mode'.")
+
+(defface dtache-marginalia-error
+ '((t :inherit error))
+ "Face used to highlight error in `marginalia-mode'.")
+
+(defface dtache-marginalia-active
+ '((t :inherit marginalia-file-owner))
+ "Face used to highlight active in `marginalia-mode'.")
+
+(defface dtache-marginalia-duration
+ '((t :inherit marginalia-date))
+ "Face used to highlight duration in `marginalia-mode'.")
+
+(defface dtache-marginalia-size
+ '((t :inherit marginalia-size))
+ "Face used to highlight size in `marginalia-mode'.")
+
+(defface dtache-marginalia-creation
+ '((t :inherit marginalia-date))
+ "Face used to highlight date in `marginalia-mode'.")
+
+;;;; Functions
+
+(defun dtache-marginalia-annotate (candidate)
+ "Annotate dtache CANDIDATE."
+ (let* ((session (dtache-session-decode candidate)))
+ (marginalia--fields
+ ((dtache-marginalia--active session) :width 3 :face
'dtache-marginalia-active)
+ ((dtache-marginalia--stderr-p session) :width 3 :face
'dtache-marginalia-error)
+ ((dtache-marginalia--git-branch session) :truncate
dtache-marginalia-git-branch-length :face 'dtache-marginalia-git)
+ ((dtache-marginalia--duration session) :truncate
dtache-marginalia-duration-length :face 'dtache-marginalia-duration)
+ ((dtache-marginalia--size session) :truncate
dtache-marginalia-size-length :face 'dtache-marginalia-size)
+ ((dtache-marginalia--creation session) :truncate
dtache-marginalia-date-length :face 'dtache-marginalia-date))))
+
+;;;; Support functions
+
+(defun dtache-marginalia--duration (session)
+ "Return SESSION's duration time."
+ (let* ((time (round (dtache--session-duration session)))
+ (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-marginalia--creation (session)
+ "Return SESSION's creation time."
+ (format-time-string
+ "%b %d %H:%M"
+ (dtache--session-creation-time session)))
+
+(defun dtache-marginalia--size (session)
+ "Return the size of SESSION's log."
+ (file-size-human-readable
+ (dtache--session-log-size session)))
+
+(defun dtache-marginalia--git-branch (session)
+ "Return the git branch for SESSION."
+ (dtache--session-git session))
+
+(defun dtache-marginalia--active (session)
+ "Return string if SESSION is active."
+ (if (dtache--session-active session)
+ "*"
+ ""))
+
+(defun dtache-marginalia--stderr-p (session)
+ "Return string if SESSION has errors."
+ (if (dtache--session-stderr-p session)
+ "!"
+ ""))
+
+(provide 'dtache-marginalia)
+
+;;; dtache-marginalia.el ends here
diff --git a/dtache-shell.el b/dtache-shell.el
new file mode 100755
index 0000000000..e2031f6689
--- /dev/null
+++ b/dtache-shell.el
@@ -0,0 +1,136 @@
+;;; dtache-shell.el --- Shell integration of dtache -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; URL: https://www.gitlab.com/niklaseklund/dtache.git
+;; Version: 0.1
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: convenience processes
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides integration of dtache into shell-mode buffers.
+
+;;;; Usage
+
+;; `dtache-shell-enable': Enable dtache in shell buffers
+
+;;; Code:
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'dash)
+(require 'subr-x)
+(require 'dtache)
+(require 'comint)
+(require 's)
+(require 'shell)
+
+;;;; Functions
+
+(defun dtache-shell-enable ()
+ "Enable `dtache-shell'."
+ (add-hook 'shell-mode-hook #'dtache-shell-maybe-activate)
+ (advice-add 'shell :around #'dtache-shell--disable-histfile))
+
+(defun dtache-shell-disable ()
+ "Disable `dtache-shell'."
+ (remove-hook 'shell-mode-hook #'dtache-shell-maybe-activate)
+ (advice-remove 'shell #'dtache-shell--disable-histfile))
+
+(defun dtache-shell-maybe-activate ()
+ "Only local sessions are supported."
+ (unless (file-remote-p default-directory)
+ (dtache-shell-mode)))
+
+;;;; Commands
+
+;;;###autoload
+(defun dtache-shell-create-session (&optional disable-block)
+ "Create a new dtache session.
+Use prefix argument DISABLE-BLOCK to force the launch of a session."
+ (interactive "P")
+ (let ((comint-input-sender #'dtache-shell-input-sender)
+ (dtache-block-list (if disable-block '() dtache-block-list)))
+ (comint-send-input)))
+
+;;;###autoload
+(defun dtache-shell-detach ()
+ "Detach from an attached session."
+ (interactive)
+ (let ((proc (get-buffer-process (current-buffer)))
+ (input "\C-\\"))
+ (if (dtache-shell--attached-p)
+ (comint-simple-send proc input)
+ (message "Not attached to a session"))))
+
+(defun dtache-shell-input-sender (proc string)
+ "Create a dtache command based on STRING and send to PROC.
+
+The function doesn't create dtache sessions when STRING is matching
+any regexp found in `dtache-block-list'."
+ (if-let* ((no-child-process (not (process-running-child-p (get-process
(buffer-name)))))
+ (allowed (not (--find (s-matches-p it string) dtache-block-list)))
+ (session (dtache-create-session (substring-no-properties string)))
+ (command (dtache-session-command session)))
+ (comint-simple-send proc command)
+ (comint-simple-send proc string)))
+
+;;;; Support functions
+
+(defun dtache-shell--attached-p ()
+ "Return t if `shell' is attached to a session."
+ (let ((pid (process-running-child-p (get-process (buffer-name)))))
+ (when pid
+ (let-alist (process-attributes pid)
+ (s-equals-p "dtach" .comm)))))
+
+(defun dtache-shell--filter-dtach-eof (string)
+ "Remove eof message from dtach in STRING."
+ (if (string-match dtache-eof-message string)
+ (s-replace (format "%s\n" (s-replace "\\" "" dtache-eof-message)) ""
string)
+ string))
+
+(defun dtache-shell--disable-histfile (orig-fun &rest args)
+ "Disable HISTFILE before calling ORIG-FUN with ARGS."
+ (cl-letf (((getenv "HISTFILE") ""))
+ (apply orig-fun args)))
+
+(defun dtache-shell--save-history ()
+ "Save `shell' history."
+ (comint-write-input-ring))
+
+;;;; Minor mode
+
+(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
+ (progn
+ (dtache-cleanup-sessions)
+ (add-hook 'comint-preoutput-filter-functions
#'dtache-shell--filter-dtach-eof 0 t)
+ (add-hook 'kill-buffer-hook #'dtache-shell--save-history 0 t))
+ (remove-hook 'comint-preoutput-filter-functions
#'dtache-shell--filter-dtach-eof t)
+ (remove-hook 'kill-buffer-hook #'dtache-shell--save-history t)))
+
+(provide 'dtache-shell)
+
+;;; dtache-shell.el ends here
diff --git a/dtache.el b/dtache.el
new file mode 100644
index 0000000000..1b725e98be
--- /dev/null
+++ b/dtache.el
@@ -0,0 +1,496 @@
+;;; dtache.el --- Core dtache -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; URL: https://www.gitlab.com/niklaseklund/dtache.git
+;; Version: 0.1
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: convenience processes
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides a backend implementation for dtache
+;; sessions. Dtache is supposed to be interfaced through other
+;; packages, such a package is `dtache-shell' which brings dtache into
+;; shell buffers.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'comint)
+(require 'emacsql)
+(require 'emacsql-sqlite)
+(require 'f)
+(require 'projectile)
+
+;;;; Variables
+
+(defvar dtache-session-directory nil
+ "The directory to store `dtache' sessions.")
+(defvar dtache-db-directory user-emacs-directory
+ "The directory to store `dtache' database.")
+(defvar dtache-db nil
+ "The connection to the `dtache' database.")
+(defconst dtache-program "dtach"
+ "The `dtach' program.")
+
+(defconst dtache-shell "bash"
+ "Shell to run the dtach command in.")
+(defconst dtache-socket-ext ".socket"
+ "The file name extension for the socket for `dtache-program'.")
+(defconst dtache-log-ext ".log"
+ "The file name extension for combined stdout and stderr.")
+(defconst dtache-stdout-ext ".stdout"
+ "The file name extension for stdout.")
+(defconst dtache-stderr-ext ".stderr"
+ "The file name extension for stderr.")
+(defconst dtache-eof-message "\\[EOF - dtach terminating\\]\^M"
+ "Message printed when `dtach' finishes.")
+
+(defvar dtache-block-list '("^$" "^cd.*" "^mkdir.*" "^touch.*" "^alias.*")
+ "A list of regexps that are blocked and should not be sent to `dtache'.")
+(defvar dtache-max-command-length 95
+ "Maximum length of displayed command.")
+
+;;;;; Private
+
+(defvar dtache--sessions nil "A list of the current sessions.")
+
+;;;; Data structures
+
+(cl-defstruct (dtache-session (:constructor dtache--session-create)
+ (:conc-name dtache--session-))
+ (id nil :read-only t)
+ (command nil :read-only t)
+ (directory nil :read-only t)
+ (creation-time nil :read-only t)
+ (git nil :read-only t)
+ (duration nil)
+ (log-size nil)
+ (stderr-p nil)
+ (active nil))
+
+;;;; Interfaces
+
+(cl-defgeneric dtache-attach (session)
+ "A context aware function to attach to SESSION.")
+
+(cl-defmethod dtache-attach (session &context (major-mode shell-mode))
+ "Attach to a dtache SESSION when MAJOR-MODE is `shell-mode'.
+
+`comint-add-to-input-history' is temporarily disabled to avoid
+cluttering the comint-history with dtach commands."
+ (unless (process-running-child-p (get-process (buffer-name)))
+ (let* ((socket (dtache--session-file session 'socket))
+ (input (concat dtache-program " -a " (shell-quote-argument
socket))))
+ (goto-char (point-max))
+ (insert input)
+ (cl-letf (((symbol-function 'comint-add-to-input-history)
+ (lambda (_) t)))
+ (comint-send-input)))))
+
+;;;; Commands
+
+;;;###autoload
+(defun dtache-compile-session (session)
+ "Open log of SESSION in `compilation-mode'."
+ (interactive
+ (list (dtache-select-session)))
+ (let ((buffer-name
+ (format "*dtache-compile-%s*"
+ (dtache--session-short-id session))))
+ (when (f-exists-p (dtache--session-file session 'log))
+ (with-current-buffer (get-buffer-create buffer-name)
+ (setq-local buffer-read-only nil)
+ (erase-buffer)
+ (insert-file-contents (dtache--session-file session 'log))
+ (setq-local default-directory (dtache--session-directory session))
+ (compilation-mode))
+ (pop-to-buffer buffer-name))))
+
+;;;###autoload
+(defun dtache-copy-session-content (session)
+ "Copy content of SESSION."
+ (interactive
+ (list (dtache-select-session)))
+ (dtache--file-content (dtache--session-file session 'log)))
+
+;;;###autoload
+(defun dtache-copy-session (session)
+ "Copy SESSION."
+ (interactive
+ (list (dtache-select-session)))
+ (kill-new (dtache--session-command session)))
+
+;;;###autoload
+(defun dtache-insert-session (session)
+ "Insert SESSION."
+ (interactive
+ (list (dtache-select-session)))
+ (insert (dtache--session-command session)))
+
+;;;###autoload
+(defun dtache-remove-session (session)
+ "Remove SESSION."
+ (interactive
+ (list (dtache-select-session)))
+ (if (dtache--session-active-p session)
+ (message "Kill session first before removing it.")
+ (dtache--db-remove-session session)))
+
+;;;###autoload
+(defun dtache-kill-session (session)
+ "Send a TERM signal to SESSION."
+ (interactive
+ (list (dtache-select-session)))
+ (if (not (dtache--session-active-p session))
+ (message "Session is already inactive.")
+ (let* ((default-directory (dtache--session-directory session))
+ (process-group (prin1-to-string (dtache--session-process-group
session))))
+ (shell-command (format "kill -- -%s" process-group)))))
+
+;;;###autoload
+(defun dtache-open-log (session)
+ "Open SESSION's log."
+ (interactive
+ (list (dtache-select-session)))
+ (dtache--open-file session 'log))
+
+;;;###autoload
+(defun dtache-open-stdout (session)
+ "Open SESSION's stdout."
+ (interactive
+ (list (dtache-select-session)))
+ (dtache--open-file session 'stdout))
+
+;;;###autoload
+(defun dtache-open-stderr (session)
+ "Open SESSION's stderr."
+ (interactive
+ (list (dtache-select-session)))
+ (dtache--open-file session 'stderr))
+
+;;;###autoload
+(defun dtache-attach-to-session (session)
+ "Attach to SESSION."
+ (interactive
+ (list (dtache-select-session)))
+ (if (dtache--session-active-p session)
+ (dtache-attach session)
+ (dtache-open-log session)))
+
+;;;; Functions
+
+(defun dtache-setup ()
+ "Setup `dtache'."
+ ;; Safety first
+ (unless (executable-find "dtach")
+ (error "`dtache' requires program `dtach' to be installed"))
+ (unless dtache-session-directory
+ (error "`dtache-session-directory' must be configured"))
+ (unless dtache-db-directory
+ (error "`dtache-db-directory' must be configured"))
+ ;; Setup
+ (unless (file-exists-p dtache-session-directory)
+ (make-directory dtache-session-directory t))
+ (unless (file-exists-p dtache-db-directory)
+ (make-directory dtache-db-directory t))
+ (dtache-db-initialize))
+
+;;;;; Database
+
+(defun dtache-db-initialize ()
+ "Initialize the `dtache' database."
+ (setq dtache-db
+ (emacsql-sqlite
+ (expand-file-name "dtache.db" dtache-db-directory)))
+ (emacsql dtache-db
+ [:create-table
+ :if :not :exists dtache-sessions
+ ([(id text :primary-key) dtache-session])]))
+
+(defun dtache-db-reinitialize ()
+ "Reinitialize the `dtache' database."
+ (let ((db-alive
+ (and (emacsql-sqlite-connection-p dtache-db)
+ (emacsql-live-p dtache-db))))
+ (when db-alive
+ (emacsql-close dtache-db))
+ (dtache-db-initialize)))
+
+;;;;; Sessions
+
+(defun dtache-select-session ()
+ "Return selected session."
+ (let* ((sessions (dtache--sessions))
+ (selected
+ (completing-read "Select session: "
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (category . dtache)
+ (cycle-sort-function . identity)
+ (display-sort-function . identity))
+ ;; TODO: Tweak this and implement full
+ ;; programable completion
+ (complete-with-action
+ action sessions string pred)))
+ nil t nil 'dtache-session-history)))
+ (dtache-session-decode selected)))
+
+(defun dtache-update-sessions ()
+ "Update sessions in the database."
+ (let ((sessions (dtache--db-select-sessions)))
+ (-some->> sessions
+ (-filter #'dtache--session-active)
+ (-map #'dtache-session--update)
+ (-map #'dtache--db-update-session))))
+
+(defun dtache-cleanup-sessions ()
+ "Remove dead sessions from the database."
+ (let ((sessions (dtache--db-select-sessions)))
+ (-some->> sessions
+ (-filter #'dtache--session-dead-p)
+ (-map #'dtache--db-remove-session))))
+
+(defun dtache-session-command (session)
+ "Return a dtach command for SESSION."
+ (let* ((command (dtache--session-command session))
+ (stdout (dtache--session-file session 'stdout))
+ (stderr (dtache--session-file session 'stderr))
+ (stdout+stderr (dtache--session-file session 'log))
+ (socket (dtache--session-file session 'socket))
+ ;; Construct the command line
+ ;; { { echo stdout; echo stderr >&2; } >>(tee stdout ); } 2>>(tee
stderr) | tee log
+ (commandline (format "{ { %s; }%s }%s %s"
+ (format "%s" command)
+ (format " > >(tee %s );" stdout)
+ (format " 2> >(tee %s )" stderr)
+ (format " | tee %s" stdout+stderr))))
+ (format "%s -c %s -z %s -c %s" dtache-program socket dtache-shell
(shell-quote-argument commandline))))
+
+(defun dtache-create-session (command)
+ "Create a `dtache' session from COMMAND."
+ (let ((session
+ (dtache--session-create :id (dtache--create-id command)
+ :command command
+ :directory default-directory
+ :creation-time (time-to-seconds
(current-time))
+ :git (dtache--session-git-info)
+ :active t)))
+ (dtache--db-insert-session session)
+ session))
+
+;;;;; String representations
+
+(defun dtache-session-encode (session)
+ "Encode SESSION as a string."
+ (let ((command
+ (dtache--session-truncate-command session))
+ (hash
+ (dtache--session-short-id session)))
+ (s-concat
+ command
+ " "
+ (propertize hash 'face 'font-lock-comment-face))))
+
+(defun dtache-session-decode (str)
+ "Decode STR to a session."
+ (cdr (assoc str dtache--sessions)))
+
+;;;; Support functions
+
+(defun dtache--command-string (session)
+ "Return SESSION's command as a string."
+ (let ((command (dtache--session-command session)))
+ (if (< (length command) dtache-max-command-length)
+ (s-pad-right dtache-max-command-length " " command)
+ (s-concat
+ (s-truncate (/ dtache-max-command-length 2) command)
+ (s-right (/ dtache-max-command-length 2) command)))))
+
+(defun dtache--session-truncate-command (session)
+ "Return a truncated string representation of SESSION's command."
+ (let ((command (dtache--session-command session))
+ (part-length (- dtache-max-command-length 3)))
+ (if (<= (length command) dtache-max-command-length)
+ (s-pad-right dtache-max-command-length " " command)
+ (s-concat
+ (s-left (/ part-length 2) command)
+ "..."
+ (s-right (/ part-length 2) command)))))
+
+(defun dtache-session--update (session)
+ "Update the `dtache' SESSION."
+ ;; TODO: Make this function private
+ (setf (dtache--session-active session) (dtache--session-active-p session))
+ (setf (dtache--session-duration session) (dtache--duration session))
+ (setf (dtache--session-log-size session) (file-attribute-size
+ (file-attributes
+ (dtache--session-file session
'log))))
+ (setf (dtache--session-stderr-p session) (> (file-attribute-size
+ (file-attributes
+ (dtache--session-file session
'stderr))) 0))
+ session)
+
+(defun dtache--session-git-info ()
+ "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 #'call-process `("git" nil t nil ,@args))
+ (s-trim (buffer-string)))))))
+
+(defun dtache--file-content (file)
+ "Copy FILE's content."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (kill-new (buffer-string))))
+
+(defun dtache--sessions ()
+ "Return an alist of sessions."
+ (dtache-update-sessions)
+ (let ((sessions (nreverse (dtache--db-select-sessions))))
+ (setq dtache--sessions
+ (--map `(,(dtache-session-encode it) . ,it) sessions))))
+
+(defun dtache--duration (session)
+ "Return the time duration of the SESSION.
+
+Modification time is not reliable whilst a session is active. Instead
+the current time is used."
+ (if (dtache--session-active session)
+ (- (time-to-seconds) (dtache--session-creation-time session))
+ (- (time-to-seconds
+ (file-attribute-modification-time
+ (file-attributes
+ (dtache--session-file session 'log))))
+ (dtache--session-creation-time session))))
+
+(defun dtache--open-file (session file)
+ "Oen SESSION's FILE."
+ (let ((buffer-name (format "*dtache-%s-%s*" file
+ (dtache--session-short-id session))))
+ (when (f-exists-p (dtache--session-file session file))
+ (with-current-buffer (get-buffer-create buffer-name)
+ (erase-buffer)
+ (insert-file-contents (dtache--session-file session file))
+ (setq-local default-directory (dtache--session-directory session)))
+ (pop-to-buffer buffer-name)
+ (dtache-log-mode))))
+
+(defun dtache--create-id (command)
+ "Return a hash identifier for COMMAND."
+ (let ((current-time (current-time-string)))
+ (secure-hash 'md5 (concat command current-time))))
+
+;;;;; Sessions
+
+(defun dtache--session-short-id (session)
+ "Return the short representation of the SESSION's id."
+ (s-right 8 (dtache--session-id session)))
+
+(defun dtache--session-active-p (session)
+ "Return t if SESSION is active."
+ (f-exists-p (dtache--session-file session 'socket)))
+
+(defun dtache--session-dead-p (session)
+ "Return t if SESSION is dead."
+ (not (f-exists-p (dtache--session-file session 'log))))
+
+(defun dtache--session-process-group (session)
+ "Return the process id for SESSION."
+ (let* ((socket (f-filename (dtache--session-file session 'socket))))
+ (-find (lambda (process)
+ (let-alist (process-attributes process)
+ (when (s-matches-p socket .args)
+ .pgrp)))
+ (list-system-processes))))
+
+(defun dtache--session-file (session file)
+ "Return path to SESSION's FILE."
+ (expand-file-name
+ (concat (dtache--session-id session)
+ (dtache--session-extension file))
+ dtache-session-directory))
+
+(defun dtache--session-extension (file)
+ "Return extensions of FILE."
+ (pcase file
+ ('socket dtache-socket-ext)
+ ('log dtache-log-ext)
+ ('stdout dtache-stdout-ext)
+ ('stderr dtache-stderr-ext)))
+
+;;;;; Database
+
+(defun dtache--db-insert-session (session)
+ "Insert SESSION into the database."
+ (let ((id (dtache--session-id session)))
+ (emacsql dtache-db `[:insert
+ :into dtache-sessions
+ :values ([,id ,session])])))
+
+(defun dtache--db-update-session (session)
+ "Update the database with SESSION."
+ (let ((id (dtache--session-id session)))
+ (emacsql dtache-db [:update dtache-sessions
+ :set (= dtache-session $s2)
+ :where (= id $s1)]
+ id session)))
+
+(defun dtache--db-remove-session (session)
+ "Remove SESSION from the database."
+ (let ((id (dtache--session-id session)))
+ (emacsql dtache-db [:delete
+ :from dtache-sessions
+ :where (= id $s1)]
+ id)))
+
+(defun dtache--db-select-session (id)
+ "Return the session with ID from the database."
+ (caar
+ (emacsql dtache-db [:select dtache-session
+ :from dtache-sessions
+ :where (= id $s1)]
+ id)))
+
+(defun dtache--db-select-sessions ()
+ "Return all sessions from the database."
+ (let ((sessions
+ (emacsql dtache-db
+ [:select dtache-session
+ :from dtache-sessions])))
+ (-map #'car sessions)))
+
+;;;; Major modes
+
+(defvar dtache-log-mode-map
+ (let ((map (make-sparse-keymap)))
+ map)
+ "Keymap for `dtache-log-mode'.")
+
+(define-derived-mode dtache-log-mode nil "Dtache Log"
+ "Major mode for dtache logs.")
+
+(provide 'dtache)
+
+;;; dtache.el ends here
diff --git a/notes.org b/notes.org
new file mode 100644
index 0000000000..33f68bb509
--- /dev/null
+++ b/notes.org
@@ -0,0 +1,24 @@
+* Improvements
+** Support byte compilation
+** Handling large files
+
+Opening a large file yields the following warning.
+
+#+begin_src text
+ Warning (undo): Buffer ‘*dtache*’ undo info was 219405582 bytes long.
+ The undo info was discarded because it exceeded `undo-outer-limit'.
+
+ This is normal if you executed a command that made a huge change
+ to the buffer. In that case, to prevent similar problems in the
+ future, set `undo-outer-limit' to a value that is large enough to
+ cover the maximum size of normal changes you expect a single
+ command to make, but not so large that it might exceed the
+ maximum memory allotted to Emacs.
+
+ If you did not execute any such command, the situation is
+ probably due to a bug and you should report it.
+
+ You can disable the popping up of this buffer by adding the entry
+ (undo discard-info) to the user option `warning-suppress-types',
+ which is defined in the `warnings' library.
+#+end_src
diff --git a/test/dtache-marginalia-test.el b/test/dtache-marginalia-test.el
new file mode 100644
index 0000000000..0202fe1c92
--- /dev/null
+++ b/test/dtache-marginalia-test.el
@@ -0,0 +1,61 @@
+;;; dtache-marginalia-test.el --- Tests for dtache-marginalia.el -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; Url: https://gitlab.com/niklaseklund/dtache
+;; Package-requires: ((emacs "26.1"))
+;; Version: 0.1
+
+;; 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-marginalia
+
+;;; Code:
+
+(require 'ert)
+(require 'dtache-marginalia)
+
+(ert-deftest dtache-marginalia-test-duration ()
+ (should (string= "1s" (dtache-marginalia--duration (dtache--session-create
:duration 1))))
+ (should (string= "1m 1s" (dtache-marginalia--duration
(dtache--session-create :duration 61))))
+ (should (string= "1h 1m 1s" (dtache-marginalia--duration
(dtache--session-create :duration 3661)))))
+
+(ert-deftest dtache-marginalia-test-creation ()
+ ;; Make sure to set the TIMEZONE before executing the test to avoid
+ ;; differences between machines
+ (cl-letf (((getenv "TZ") "UTC0"))
+ (should (string= "May 08 08:49" (dtache-marginalia--creation
(dtache--session-create :creation-time 1620463748.7636228))))))
+
+(ert-deftest dtache-marginalia-test-size ()
+ (should (string= "100" (dtache-marginalia--size (dtache--session-create
:log-size 100))))
+ (should (string= "1k" (dtache-marginalia--size (dtache--session-create
:log-size 1024)))))
+
+(ert-deftest dtache-marginalia-git ()
+ (should (string= "foo" (dtache-marginalia--git-branch
(dtache--session-create :git "foo"))))
+ (should (not (dtache-marginalia--git-branch (dtache--session-create)))))
+
+(ert-deftest dtache-marginalia-active ()
+ (should (string= "*" (dtache-marginalia--active (dtache--session-create
:active t))))
+ (should (string= "" (dtache-marginalia--active (dtache--session-create
:active nil)))))
+
+(ert-deftest dtache-marginalia-stderr-p ()
+ (should (string= "!" (dtache-marginalia--stderr-p (dtache--session-create
:stderr-p t))))
+ (should (string= "" (dtache-marginalia--stderr-p (dtache--session-create
:stderr-p nil)))))
+
+(provide 'dtache-marginalia-test)
+
+;;; dtache-marginalia-test.el ends here
diff --git a/test/dtache-shell-test.el b/test/dtache-shell-test.el
new file mode 100644
index 0000000000..91e2b70998
--- /dev/null
+++ b/test/dtache-shell-test.el
@@ -0,0 +1,42 @@
+;;; dtache-shell-test.el --- Tests for dtache-shell.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; Url: https://gitlab.com/niklaseklund/dtache
+;; Package-requires: ((emacs "26.1"))
+;; Version: 0.1
+
+;; 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-shell
+
+;;; Code:
+
+(require 'ert)
+(require 'dtache-shell)
+
+;;;; Tests
+
+(ert-deftest dtache-shell-test-filter-eof ()
+ (let ((str "
+[EOF - dtach terminating]
+user@machine "))
+ (should (string= "
\nuser@machine " (dtache-shell--filter-dtach-eof str)))))
+
+(provide 'dtache-shell-test)
+
+;;; dtache-shell-test.el ends here
diff --git a/test/dtache-test.el b/test/dtache-test.el
new file mode 100644
index 0000000000..2e0355daac
--- /dev/null
+++ b/test/dtache-test.el
@@ -0,0 +1,57 @@
+;;; dtache-test.el --- Tests for dtache.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Niklas Eklund
+
+;; Author: Niklas Eklund <niklas.eklund@posteo.net>
+;; Url: https://gitlab.com/niklaseklund/dtache
+;; Package-requires: ((emacs "26.1"))
+;; Version: 0.1
+
+;; 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:
+
+(require 'ert)
+(require 'dtache)
+
+;;; Tests
+
+(ert-deftest dtache-test-session-short-id ()
+ (let ((session (dtache--session-create :id "abcdefg12345678")))
+ (should (string= "12345678" (dtache--session-short-id session)))))
+
+(ert-deftest dtache-test-session-truncate-command ()
+ (let ((dtache-max-command-length 7))
+ (should (string= "12...78"
+ (dtache--session-truncate-command
+ (dtache--session-create :command "12345678")))))
+ (let ((dtache-max-command-length 6))
+ (should (string= "1...8"
+ (dtache--session-truncate-command
+ (dtache--session-create :command "12345678"))))))
+
+(ert-deftest dtache-test-session-encode ()
+ (let ((session
+ (dtache--session-create :command "abcdefghijk"
+ :id "-------12345678"))
+ (dtache-max-command-length 8))
+ (should (string= "ab...jk 12345678" (dtache-session-encode session)))))
+
+(provide 'dtache-test)
+
+;;; dtache-test.el ends here
- [elpa] branch externals/dtache created (now 26cb80f343), ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 7f43467119 006/158: Remove old notes, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 6897a0e67d 004/158: Finalize completion implementation, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 47b17c2183 001/158: Add LICENSE, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 708f9afbf2 002/158: Add empty README, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 7cbd6b3530 009/158: Merge remote branch into master, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache d0b0ed41e2 012/158: Merge develop branch into master, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache bcbc2d8b4d 003/158: Merge with development branch,
ELPA Syncer <=
- [elpa] externals/dtache ea07041f52 013/158: Merge develop branch into master, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 522e149252 010/158: Add .dir-locals.el file, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 9b9d58e6b5 011/158: Add flycheck-mode to .dir-locals, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 9194f78dec 005/158: Update credits section, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 34b481d354 008/158: Add some more information to the README, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 91baa9ecfa 031/158: Update dtache-message detection, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache eaf141725f 044/158: Add compile section to tips and tricks in README, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache eb997e0b4e 023/158: Correct some spelling mistakes, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache 082139f1c3 045/158: Add instructions on how to customize annotations, ELPA Syncer, 2022/01/19
- [elpa] externals/dtache f6c9710c1b 017/158: Merge develop branch into master, ELPA Syncer, 2022/01/19