--- /dev/null
+;;; detached-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "detached" "detached.el" (0 0 0 0))
+;;; Generated autoloads from detached.el
+
+(autoload 'detached-shell-command "detached" "\
+Execute COMMAND with `detached'.
+
+Optionally SUPPRESS-OUTPUT if prefix-argument is provided.
+
+\(fn COMMAND &optional SUPPRESS-OUTPUT)" t nil)
+
+(autoload 'detached-open-session "detached" "\
+Open a `detached' SESSION.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-compile-session "detached" "\
+Compile SESSION.
+
+The session is compiled by opening its output and enabling
+`compilation-minor-mode'.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-edit-session-annotation "detached" "\
+Edit SESSION's annotation.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-edit-and-run-session "detached" "\
+Edit and re-run SESSION at point.
+
+Optionally TOGGLE-SESSION-MODE.
+
+\(fn SESSION &optional TOGGLE-SESSION-MODE)" t nil)
+
+(autoload 'detached-rerun-session "detached" "\
+Re-run SESSION at point.
+
+Optionally TOGGLE-SESSION-MODE.
+
+\(fn SESSION &optional TOGGLE-SESSION-MODE)" t nil)
+
+(autoload 'detached-describe-session "detached" "\
+Describe current session." t nil)
+
+(autoload 'detached-describe-duration "detached" "\
+Describe the SESSION's duration statistics.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-attach-session "detached" "\
+Attach to SESSION.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-copy-session-output "detached" "\
+Copy SESSION's output.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-copy-session-command "detached" "\
+Copy SESSION's command.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-insert-session-command "detached" "\
+Insert SESSION's command.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-delete-session "detached" "\
+Delete SESSION.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-kill-session "detached" "\
+Send a TERM signal to SESSION.
+
+Optionally DELETE the session if prefix-argument is provided.
+
+\(fn SESSION &optional DELETE)" t nil)
+
+(autoload 'detached-view-session "detached" "\
+View the SESSION.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-diff-session "detached" "\
+Diff SESSION1 with SESSION2.
+
+\(fn SESSION1 SESSION2)" t nil)
+
+(autoload 'detached-open-session-directory "detached" "\
+Open SESSION's log directory.
+
+\(fn SESSION)" t nil)
+
+(autoload 'detached-detach-session "detached" "\
+Detach from session in current buffer.
+
+This command is only activated if `detached-buffer-session' is an
+active session. For sessions created with `detached-compile' or
+`detached-shell-command', the command will also kill the window." t nil)
+
+(autoload 'detached-delete-sessions "detached" "\
+Delete `detached' sessions which belong to the current host, unless ALL-HOSTS.
+
+\(fn &optional ALL-HOSTS)" t nil)
+
+(autoload 'detached-initialize-sessions "detached" "\
+Initialize `detached' sessions from the database." nil nil)
+
+(autoload 'detached-shell-mode "detached" "\
+Integrate `detached' in `shell-mode'.
+
+This is a minor mode. If called interactively, toggle the
+`detached-shell mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `detached-shell-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'detached-log-mode "detached" "\
+Major mode for `detached' logs.
+
+\(fn)" t nil)
+
+(register-definition-prefixes "detached" '("detached-"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-compile" "detached-compile.el" (0
+;;;;;; 0 0 0))
+;;; Generated autoloads from detached-compile.el
+
+(autoload 'detached-compile "detached-compile" "\
+Run COMMAND through `compile' but in a `detached' session.
+Optionally enable COMINT if prefix-argument is provided.
+
+\(fn COMMAND &optional COMINT)" t nil)
+
+(autoload 'detached-compile-recompile "detached-compile" "\
+Re-compile by running `compile' but in a `detached' session.
+Optionally EDIT-COMMAND.
+
+\(fn &optional EDIT-COMMAND)" t nil)
+
+(autoload 'detached-compile-attach "detached-compile" "\
+Attach to SESSION with `compile'.
+
+\(fn SESSION)" nil nil)
+
+(autoload 'detached-compile-start-session "detached-compile" "\
+Start SESSION with `detached-compile'.
+
+\(fn SESSION)" nil nil)
+
+(autoload 'detached-compile--start "detached-compile" "\
+Run in `compilation-start-hook' if `detached-enabled'.
+
+\(fn _)" nil nil)
+
+(autoload 'detached-compilation-mode "detached-compile" "\
+Major mode for `detached' compilation.
+
+\(fn)" t nil)
+
+(register-definition-prefixes "detached-compile" '("detached-compil"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-consult" "detached-consult.el" (0
+;;;;;; 0 0 0))
+;;; Generated autoloads from detached-consult.el
+
+(autoload 'detached-consult-session "detached-consult" "\
+Enhanced `detached-open-session' command." t nil)
+
+(register-definition-prefixes "detached-consult" '("detached-consult-"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-dired" "detached-dired.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from detached-dired.el
+
+(autoload 'detached-dired-do-shell-command "detached-dired" "\
+Ensure `detached' is used before running DIRED-DO-SHELL-COMMAND with ARGS.
+
+\(fn DIRED-DO-SHELL-COMMAND &rest ARGS)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads nil "detached-eshell" "detached-eshell.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from detached-eshell.el
+
+(autoload 'detached-eshell-external-command "detached-eshell" "\
+Advice ORIG-FUN to optionally use `detached' on ARGS.
+
+\(fn ORIG-FUN &rest ARGS)" nil nil)
+
+(autoload 'detached-eshell-mode "detached-eshell" "\
+Integrate `detached' in `eshell-mode'.
+
+This is a minor mode. If called interactively, toggle the
+`detached-eshell mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `detached-eshell-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+\(fn &optional ARG)" t nil)
+
+(register-definition-prefixes "detached-eshell" '("detached-eshell-"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-extra" "detached-extra.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from detached-extra.el
+
+(autoload 'detached-extra-projectile-run-compilation "detached-extra" "\
+If CMD is a string execute it with `detached-compile'.
+
+Optionally USE-COMINT-MODE
+
+\(fn CMD &optional USE-COMINT-MODE)" nil nil)
+
+(autoload 'detached-extra-dired-rsync "detached-extra" "\
+Run COMMAND with `detached'.
+
+\(fn COMMAND DETAILS)" nil nil)
+
+(autoload 'detached-extra-alert-notification "detached-extra" "\
+Send an `alert' notification when SESSION becomes inactive.
+
+\(fn SESSION)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads nil "detached-init" "detached-init.el" (0 0 0 0))
+;;; Generated autoloads from detached-init.el
+
+(autoload 'detached-init "detached-init" "\
+Initialize `detached' integration with all packages." nil nil)
+
+(register-definition-prefixes "detached-init" '("detached-"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-list" "detached-list.el" (0 0 0 0))
+;;; Generated autoloads from detached-list.el
+
+(autoload 'detached-list-sessions "detached-list" "\
+Open list of `detached'." t nil)
+
+(register-definition-prefixes "detached-list" '("detached-"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-org" "detached-org.el" (0 0 0 0))
+;;; Generated autoloads from detached-org.el
+
+(autoload 'detached-org-babel-sh "detached-org" "\
+Modify ARGS before calling ORG-BABEL-SH-EVALUATE-FUN.
+
+This function modifies the full-body in ARGS and replaces it with a
+`detached' command. The functionality is enabled by setting a header
+property of :detached t in the org babel src block.
+
+\(fn ORG-BABEL-SH-EVALUATE-FUN &rest ARGS)" nil nil)
+
+(register-definition-prefixes "detached-org" '("detached-org-session-action"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-shell" "detached-shell.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from detached-shell.el
+
+(autoload 'detached-shell-override-history "detached-shell" "\
+Override history in ORIG-FUN with ARGS.
+
+This function also makes sure that the HISTFILE is disabled for local shells.
+
+\(fn ORIG-FUN &rest ARGS)" nil nil)
+
+(autoload 'detached-shell-save-history-on-kill "detached-shell" "\
+Add hook to save history when killing `shell' buffer." nil nil)
+
+(register-definition-prefixes "detached-shell" '("detached-shell-"))
+
+;;;***
+\f
+;;;### (autoloads nil "detached-vterm" "detached-vterm.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from detached-vterm.el
+
+(autoload 'detached-vterm-mode "detached-vterm" "\
+Integrate `detached' in `vterm'.
+
+This is a minor mode. If called interactively, toggle the
+`detached-vterm mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `detached-vterm-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+\(fn &optional ARG)" t nil)
+
+(register-definition-prefixes "detached-vterm" '("detached-vterm-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("detached-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; detached-autoloads.el ends here
--- /dev/null
+;;; detached-compile.el --- Detached 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 `detached' extension which provides integration for `compile'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'compile)
+(require 'detached)
+
+(declare-function ansi-color-compilation-filter "ansi-color")
+
+;;;; Variables
+
+(defcustom detached-compile-session-action
+ '(:attach detached-compile-attach
+ :view detached-compile-session
+ :run detached-compile-start-session)
+ "Actions for a session created with `detached-compile'."
+ :group 'detached
+ :type 'plist)
+
+;;;; Commands
+
+;;;###autoload
+(defun detached-compile (command &optional comint)
+ "Run COMMAND through `compile' but in a `detached' 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* ((detached-enabled t)
+ (detached-session-origin (or detached-session-origin 'compile))
+ (detached-session-action (or detached-session-action
+ detached-compile-session-action))
+ (detached-session-mode (or detached-session-mode 'attached)))
+ (compile command comint)))
+
+;;;###autoload
+(defun detached-compile-recompile (&optional edit-command)
+ "Re-compile by running `compile' but in a `detached' session.
+Optionally EDIT-COMMAND."
+ (interactive "P")
+ (detached-with-session detached-buffer-session
+ (let* ((detached-enabled t)
+ (detached-session-mode 'attached)
+ (detached-session-command
+ (if edit-command
+ (compilation-read-command
+ (detached-session-command detached-buffer-session))
+ (detached-session-command detached-buffer-session)))
+ (detached-current-session (detached-create-session detached-session-command)))
+ (apply #'compilation-start `(,detached-session-command)))))
+
+(defun detached-compile-kill ()
+ "Kill a `detached' session."
+ (interactive)
+ (detached-kill-session detached-buffer-session))
+
+;;;;; Functions
+
+;;;###autoload
+(defun detached-compile-attach (session)
+ "Attach to SESSION with `compile'."
+ (when (detached-valid-session session)
+ (detached-with-session session
+ (let* ((detached-enabled t)
+ (detached-session-mode 'attached))
+ (compilation-start `(,detached-session-command))))))
+
+;;;###autoload
+(defun detached-compile-start-session (session)
+ "Start SESSION with `detached-compile'."
+ (detached-with-session session
+ (detached-compile detached-session-command)))
+
+;;;;; Support functions
+
+;;;###autoload
+(defun detached-compile--start (_)
+ "Run in `compilation-start-hook' if `detached-enabled'."
+ (when detached-enabled
+ (setq-local default-directory (detached-session-working-directory detached-current-session))
+ (setq detached-buffer-session detached-current-session)
+ (setq compile-command (detached-session-command detached-current-session))
+ (setq compilation-arguments nil)
+ (detached-compile--replace-modesetter)
+ (when detached-filter-ansi-sequences
+ (add-hook 'compilation-filter-hook #'ansi-color-compilation-filter 0 t))
+ (add-hook 'comint-preoutput-filter-functions #'detached--env-message-filter 0 t)
+ (add-hook 'comint-preoutput-filter-functions #'detached--dtach-eof-message-filter 0 t)))
+
+(defun detached-compile--compilation-start (compilation-start &rest args)
+ "Create a `detached' session before running COMPILATION-START with ARGS."
+ (if detached-enabled
+ (pcase-let* ((`(,command ,mode ,name-function ,highlight-regexp) args)
+ (detached-session-environment
+ (or detached-session-environment
+ `(:compilation-args ,(list (or mode 'detached-compilation-mode)
+ name-function
+ highlight-regexp))))
+ (detached-current-session
+ (or detached-current-session
+ (detached-create-session command)))
+ (default-directory (if (detached--session-local-p detached-current-session)
+ (detached-session-directory detached-current-session)
+ (detached-session-working-directory detached-current-session))))
+ (if (eq detached-session-mode 'detached)
+ (detached--start-session-process detached-current-session
+ (detached-session-start-command
+ detached-current-session
+ :type 'string))
+ (unless (detached-session-active-p detached-current-session)
+ (detached-watch-session detached-current-session))
+ (apply compilation-start `(,(if (detached-session-active-p detached-current-session)
+ (detached-session-attach-command detached-current-session
+ :type 'string)
+ (detached-session-start-command detached-current-session
+ :type 'string))
+ ,@(detached-session-environment-property detached-current-session :compilation-args)))))
+ (apply compilation-start args)))
+
+(defun detached-compile--replace-modesetter ()
+ "Replace the modsetter inserted by `compilation-start'."
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (regexp (rx (regexp "^dtach ") (or "-c" "-a") (regexp ".*\.socket.*$"))))
+ (goto-char (point-min))
+ (when (re-search-forward regexp nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert (detached-session-command detached-current-session))))))
+
+(defun detached-compile--compilation-detached-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?Detached session.*\n?" end t)
+ (delete-region (match-beginning 0) (match-end 0))))))
+
+(defun detached-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" detached--dtach-eof-message) end t)
+ (delete-region (match-beginning 0) (match-end 0))))))
+
+(cl-defmethod detached--detach-session ((_mode (derived-mode detached-compilation-mode)))
+ "Detach from session when MODE is `detached-compilation-mode'."
+ (detached--detach-from-comint-process)
+ (detached--quit-session-buffer))
+
+;;;;; Major modes
+
+(defvar detached-compilation-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-k") #'detached-compile-kill)
+ (define-key map (kbd "C-c C-.") #'detached-describe-session)
+ (define-key map (kbd detached-detach-key) #'detached-detach-session)
+ map)
+ "Keymap for `detached-compilation-mode'.")
+
+;;;###autoload
+(define-derived-mode detached-compilation-mode compilation-mode "Detached Compilation"
+ "Major mode for `detached' compilation."
+ (add-hook 'compilation-filter-hook #'detached-compile--compilation-eof-filter 0 t)
+ (add-hook 'compilation-filter-hook #'detached-compile--compilation-detached-filter 0 t))
+
+(advice-add #'compilation-start :around #'detached-compile--compilation-start)
+
+(provide 'detached-compile)
+
+;;; detached-compile.el ends here
--- /dev/null
+;;; detached-consult.el --- Detached 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 `detached' with `consult'[1]. The package
+;; provides a command `detached-consult-session' which provides multiple session sources.
+;;
+;; [1] https://github.com/minad/consult
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'detached)
+
+(declare-function consult--multi "consult")
+
+;;;; Variables
+
+(defcustom detached-consult-hidden-predicates nil
+ "Predicates for sessions that should be hidden."
+ :type '(repeat function)
+ :group 'detached)
+
+(defcustom detached-consult-sources
+ '(detached-consult--source-session
+ detached-consult--source-active-session
+ detached-consult--source-inactive-session
+ detached-consult--source-hidden-session
+ detached-consult--source-success-session
+ detached-consult--source-failure-session
+ detached-consult--source-local-session
+ detached-consult--source-remote-session
+ detached-consult--source-current-session)
+ "Sources used by `detached-consult-session'.
+
+See `consult-multi' for a description of the source values."
+ :type '(repeat symbol)
+ :group 'detached)
+
+(defvar detached-consult--source-session
+ `(:category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (seq-remove
+ (lambda (x)
+ (seq-find (lambda (predicate)
+ (apply predicate `(,(cdr x))))
+ detached-consult-hidden-predicates))
+ (detached-session-candidates (detached-get-sessions))))))
+ "All `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-hidden-session
+ `(:narrow (?\s . "Hidden")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (seq-filter
+ (lambda (x)
+ (seq-find (lambda (predicate)
+ (apply predicate `(,(cdr x))))
+ detached-consult-hidden-predicates))
+ (detached-session-candidates (detached-get-sessions))))))
+ "Active `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-active-session
+ `(:narrow (?a . "Active")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-filter #'detached-session-active-p)))))
+ "Active `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-inactive-session
+ `(:narrow (?i . "Inactive")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-filter #'detached-session-inactive-p)))))
+ "Inactive `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-failure-session
+ `(:narrow (?f . "Failure")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-filter #'detached-session-failed-p)))))
+ "Failed `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-success-session
+ `(:narrow (?s . "Success")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-remove #'detached-session-failed-p)))))
+ "Successful `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-local-session
+ `(:narrow (?l . "Local Host")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-filter #'detached-session-localhost-p))))
+ "Local host `detached' sessions as a source for `consult'."))
+
+(defvar detached-consult--source-remote-session
+ `(:narrow (?r . "Remote Host")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-filter #'detached-session-remotehost-p)))))
+ "Remote host `detached' sessions as a source for `consult'.")
+
+(defvar detached-consult--source-current-session
+ `(:narrow (?c . "Current Host")
+ :hidden t
+ :category detached
+ :annotate detached-session-annotation
+ :action (lambda (x) (detached-open-session (detached--decode-session x)))
+ :items
+ ,(lambda ()
+ (let ((host-name (car (detached--host))))
+ (mapcar #'car
+ (thread-last (detached-session-candidates (detached-get-sessions))
+ (seq-map #'cdr)
+ (seq-filter
+ (lambda (x)
+ (string= (detached-session-host-name x) host-name))))))))
+ "Current host `detached' sessions as a source for `consult'.")
+
+;;;; Commands
+
+;;;###autoload
+(defun detached-consult-session ()
+ "Enhanced `detached-open-session' command."
+ (interactive)
+ (unless (require 'consult nil 'noerror)
+ (error "Install Consult to use detached-consult"))
+ (consult--multi detached-consult-sources
+ :prompt "Select session: "
+ :require-match t
+ :sort nil))
+
+(provide 'detached-consult)
+
+;;; detached-consult.el ends here
--- /dev/null
+;;; detached-dired.el --- Detached 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 `detached' with `dired'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'dired)
+(require 'detached)
+
+;;;; Functions
+
+;;;###autoload
+(defun detached-dired-do-shell-command (dired-do-shell-command &rest args)
+ "Ensure `detached' is used before running DIRED-DO-SHELL-COMMAND with ARGS."
+ (cl-letf* ((detached-session-origin 'dired)
+ ((symbol-function #'dired-run-shell-command)
+ (lambda (command)
+ (let ((session (detached-create-session command)))
+ (detached-start-shell-command-session session))
+ nil)))
+ (pcase-let* ((`(,command ,arg ,file-list) args)
+ (modified-args `(,(string-remove-suffix " &" command) ,arg ,file-list)))
+ (apply dired-do-shell-command modified-args))))
+
+(provide 'detached-dired)
+
+;;; detached-dired.el ends here
--- /dev/null
+;;; detached-eshell.el --- Detached 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 `detached' extension which provides integration for `eshell'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'detached)
+(require 'eshell)
+(require 'esh-mode)
+(require 'esh-ext)
+(require 'em-hist)
+
+;;;; Variables
+
+(defcustom detached-eshell-session-action
+ '(:attach detached-shell-command-attach-session
+ :view detached-view-dwim
+ :run detached-start-shell-command-session)
+ "Actions for a session created with `detached-eshell'."
+ :group 'detached
+ :type 'plist)
+
+;;;; Functions
+
+;;;###autoload
+(defun detached-eshell-external-command (orig-fun &rest args)
+ "Advice ORIG-FUN to optionally use `detached' on ARGS."
+ (let* ((detached-session-action detached-eshell-session-action)
+ (command (string-trim-right (string-join (flatten-list args) " ")))
+ (session (detached-create-session command))
+ (command
+ (detached-session-start-command session
+ :type 'list)))
+ (advice-remove #'eshell-external-command #'detached-eshell-external-command)
+ (setq detached-buffer-session session)
+ (setq detached-enabled nil)
+ (apply orig-fun `(,(seq-first command) ,(seq-rest command)))))
+
+;;;; Commands
+
+(defun detached-eshell-send-input (&optional detached)
+ "Start a `detached-session' and attach to it, unless DETACHED."
+ (interactive "P")
+ (let* ((detached-session-origin 'eshell)
+ (detached-session-mode (if detached 'detached 'attached))
+ (detached-enabled t)
+ (detached-current-session nil))
+ (advice-add #'eshell-external-command :around #'detached-eshell-external-command)
+ (call-interactively #'eshell-send-input)))
+
+(defun detached-eshell-attach-session (session)
+ "Attach to SESSION."
+ (interactive
+ (list (detached-select-host-session)))
+ (when (detached-valid-session session)
+ (if (detached-session-active-p session)
+ (cl-letf* ((input
+ (detached-session-attach-command session
+ :type 'string))
+ ((symbol-function #'eshell-add-to-history) #'ignore))
+ (let ((kill-ring nil))
+ (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 detached-buffer-session session)
+ (call-interactively #'eshell-send-input))
+ (detached-open-session session))))
+
+;;;; Support functions
+
+(defun detached-eshell--get-dtach-process ()
+ "Return `eshell' process if `detached' is running."
+ (when-let* ((process (and eshell-process-list (caar eshell-process-list))))
+ (and (string= (process-name process) "dtach")
+ process)))
+
+(cl-defmethod detached--detach-session ((_mode (derived-mode eshell-mode)))
+ "Detach from session when MODE is `eshell-mode'."
+ (when-let ((active-session (detached-session-active-p
+ (alist-get (detached-session-id detached-buffer-session)
+ detached--sessions)))
+ (dtach-process (detached-eshell--get-dtach-process)))
+ (setq detached-buffer-session nil)
+ (process-send-string dtach-process
+ detached--dtach-detach-character)))
+
+;;;; Minor mode
+
+(defvar detached-eshell-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<S-return>") #'detached-eshell-send-input)
+ (define-key map (kbd "<C-return>") #'detached-eshell-attach-session)
+ (define-key map (kbd "C-c C-.") #'detached-describe-session)
+ (define-key map (kbd detached-detach-key) #'detached-detach-session)
+ map)
+ "Keymap for `detached-eshell-mode'.")
+
+;;;###autoload
+(define-minor-mode detached-eshell-mode
+ "Integrate `detached' in `eshell-mode'."
+ :lighter " detached-eshell"
+ :keymap (let ((map (make-sparse-keymap)))
+ map)
+ (make-local-variable 'eshell-preoutput-filter-functions)
+ (if detached-eshell-mode
+ (progn
+ (add-hook 'eshell-preoutput-filter-functions #'detached--env-message-filter)
+ (add-hook 'eshell-preoutput-filter-functions #'detached--dtach-eof-message-filter))
+ (remove-hook 'eshell-preoutput-filter-functions #'detached--env-message-filter)
+ (remove-hook 'eshell-preoutput-filter-functions #'detached--dtach-eof-message-filter)))
+
+(provide 'detached-eshell)
+
+;;; detached-eshell.el ends here
--- /dev/null
+;;; detached-extra.el --- Detached 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 `detached' with external packages.
+
+;;; Code:
+
+;;;; Requirements
+
+(declare-function detached-compile "detached")
+(declare-function detached-start-session "detached")
+(declare-function detached-session-command "detached")
+
+(declare-function alert "alert")
+
+(defvar detached-session-origin)
+(defvar detached-local-session)
+
+;;;; Functions
+
+;;;###autoload
+(defun detached-extra-projectile-run-compilation (cmd &optional use-comint-mode)
+ "If CMD is a string execute it with `detached-compile'.
+
+Optionally USE-COMINT-MODE"
+ (if (functionp cmd)
+ (funcall cmd)
+ (let ((detached-session-origin 'projectile))
+ (detached-compile cmd use-comint-mode))))
+
+;;;###autoload
+(defun detached-extra-dired-rsync (command _details)
+ "Run COMMAND with `detached'."
+ (let* ((detached-local-session t)
+ (detached-session-origin 'rsync)
+ (detached-session-mode 'detached)
+ (session (detached-create-session command)))
+ (detached-start-session session)))
+
+;;;###autoload
+(defun detached-extra-alert-notification (session)
+ "Send an `alert' notification when SESSION becomes inactive."
+ (let ((status (detached-session-status session))
+ (host (detached-session-host-name session)))
+ (alert (detached-session-command session)
+ :title (pcase status
+ ('success (format "Detached finished [%s]" host))
+ ('failure (format "Detached failed [%s]" host)))
+ :severity (pcase status
+ ('success 'moderate)
+ ('failure 'high)))))
+
+(provide 'detached-extra)
+
+;;; detached-extra.el ends here
--- /dev/null
+;;; detached-init.el --- Initialize detached -*- 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 `detached's integration with other packages.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'subr-x)
+
+(declare-function detached-attach-session "detached")
+(declare-function detached-compile-session "detached")
+(declare-function detached-delete-session "detached")
+(declare-function detached-insert-session-command "detached")
+(declare-function detached-open-session-directory "detached")
+(declare-function detached-kill-session "detached")
+(declare-function detached-rerun-session "detached")
+(declare-function detached-view-session "detached")
+(declare-function detached-copy-session-command "detached")
+(declare-function detached-copy-session-output "detached")
+(declare-function detached-diff-session "detached")
+(declare-function detached-initialize-sessions "detached")
+(declare-function detached-shell-mode "detached")
+
+(declare-function detached-compile--start "detached-compile")
+(declare-function detached-dired-do-shell-command "detached-dired")
+(declare-function detached-eshell-mode "detached-eshell")
+(declare-function detached-extra-projectile-run-compilation "detached-extra")
+(declare-function detached-extra-dired-rsync "detached-extra")
+(declare-function detached-list--db-update "detached-list")
+(declare-function detached-list--apply-filter "detached-list")
+(declare-function detached-org-babel-sh "detached-org")
+(declare-function detached-shell-override-history "detached-shell")
+(declare-function detached-shell-save-history-on-kill "detached-shell")
+(declare-function detached-vterm-mode "detached-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 detached-list-filters)
+
+(defvar embark-general-map)
+(defvar embark-keymap-alist)
+(defvar nano-modeline-mode-formats)
+
+;;;; Variables
+
+(defcustom detached-init-block-list nil
+ "A list of blocked packages."
+ :group 'detached
+ :type 'list)
+
+(defcustom detached-init-allow-list
+ '(compile dired dired-rsync embark eshell nano-modeline org projectile shell vterm)
+ "A list of allowed packages."
+ :group 'detached
+ :type 'list)
+
+(defvar detached-embark-action-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "a" #'detached-attach-session)
+ (define-key map "c" #'detached-compile-session)
+ (define-key map "d" #'detached-delete-session)
+ (define-key map "i" #'detached-insert-session-command)
+ (define-key map "f" #'detached-open-session-directory)
+ (define-key map "k" #'detached-kill-session)
+ (define-key map "r" #'detached-rerun-session)
+ (define-key map "v" #'detached-view-session)
+ (define-key map "w" #'detached-copy-session-command)
+ (define-key map "W" #'detached-copy-session-output)
+ (define-key map "=" #'detached-diff-session)
+ map))
+
+(defvar detached-init-package-integration '((compile . detached-init--compile)
+ (dired . detached-init--dired)
+ (dired-rsync . detached-init--dired-rsync)
+ (embark . detached-init--embark)
+ (eshell . detached-init--eshell)
+ (nano-modeline . detached-init--nano-modeline)
+ (org . detached-init--org)
+ (projectile . detached-init--projectile)
+ (shell . detached-init--shell)
+ (vterm . detached-init--vterm))
+ "Alist which contain names of packages and their initialization function.")
+
+;;;; Functions
+
+;;;###autoload
+(defun detached-init ()
+ "Initialize `detached' integration with all packages."
+ (detached-init--detached)
+ (detached-init--detached-list)
+ (let ((init-functions
+ (thread-last detached-init-package-integration
+ (seq-filter (lambda (it)
+ (member (car it) detached-init-allow-list)))
+ (seq-remove (lambda (it)
+ (member (car it) detached-init-block-list)))
+ (seq-map #'cdr))))
+ (dolist (init-function init-functions)
+ (funcall init-function))))
+
+;;;; Support functions
+
+(defun detached-init--shell ()
+ "Initialize integration with `shell'."
+ (advice-add 'shell :around #'detached-shell-override-history)
+ (add-hook 'shell-mode-hook #'detached-shell-save-history-on-kill))
+
+(defun detached-init--compile ()
+ "Initialize integration with `compile'."
+ (add-hook 'compilation-start-hook #'detached-compile--start)
+ (add-hook 'compilation-shell-minor-mode-hook #'detached-shell-mode))
+
+(defun detached-init--eshell ()
+ "Initialize integration with `eshell'."
+ (add-hook 'eshell-mode-hook #'detached-eshell-mode))
+
+(defun detached-init--org ()
+ "Initialize integration with `org'."
+ (advice-add 'org-babel-sh-evaluate
+ :around #'detached-org-babel-sh))
+
+(defun detached-init--dired ()
+ "Initialize integration with `dired'."
+ (advice-add 'dired-do-shell-command
+ :around #'detached-dired-do-shell-command))
+
+(defun detached-init--dired-rsync ()
+ "Initialize integration with `dired-rsync'."
+ (advice-add 'dired-rsync--do-run
+ :override #'detached-extra-dired-rsync))
+
+(defun detached-init--projectile ()
+ "Initialize integration with `projectile'."
+ (advice-add 'projectile-run-compilation
+ :override #'detached-extra-projectile-run-compilation))
+
+(defun detached-init--vterm ()
+ "Initialize integration with `vterm'."
+ (with-eval-after-load 'vterm
+ (add-hook 'vterm-mode-hook #'detached-vterm-mode)))
+
+(defun detached-init--embark ()
+ "Initialize integration with `embark'."
+ (with-eval-after-load 'embark
+ (defvar embark-detached-map (make-composed-keymap detached-embark-action-map embark-general-map))
+ (add-to-list 'embark-keymap-alist '(detached . embark-detached-map))))
+
+(defun detached-init--nano-modeline ()
+ "Initialize integration with `nano-modeline'."
+ (with-eval-after-load 'nano-modeline
+ (push `(detached-list-mode
+ :mode-p (lambda () (derived-mode-p 'detached-list-mode))
+ :format (lambda () (nano-modeline-render nil (detached-list--mode-line-indicator) "" "")))
+ nano-modeline-mode-formats)))
+
+(defun detached-init--detached-list ()
+ "Initialize `detached-list'."
+ ;; Trigger initialization of sessions upon load of `detached-list'
+ (with-eval-after-load 'detached-list
+ (detached-list--apply-filter
+ (cdr (car detached-list-filters)))
+ (add-hook 'detached-update-db-hooks #'detached-list--db-update)))
+
+(defun detached-init--detached ()
+ "Initialize `detached'."
+ ;; Trigger initialization of sessions upon load of `detached'
+ (with-eval-after-load 'detached
+ (detached-initialize-sessions))
+ ;; Required for `detached-shell-command' which is always provided
+ (add-hook 'shell-mode-hook #'detached-shell-mode))
+
+(provide 'detached-init)
+
+;;; detached-init.el ends here
--- /dev/null
+;;; detached-list.el --- Manage detached sessions -*- 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 an interface to manage `detached' sessions.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'detached)
+(require 'hl-line)
+(require 'imenu)
+(require 'tabulated-list)
+
+;;;; Variables
+
+(defcustom detached-list-config
+ `((:name "Command" :function detached-list--command-str :length 90)
+ (:name "Status" :function detached-list--status-str :length 10)
+ (:name "Host" :function detached--host-str :length 15 :face detached-host-face)
+ (:name "Directory" :function detached--working-dir-str :length 40 :face detached-working-dir-face)
+ (:name "Metadata" :function detached--metadata-str :length 30 :face detached-metadata-face)
+ (:name "Duration" :function detached--duration-str :length 10 :face detached-duration-face)
+ (:name "Created" :function detached--creation-str :length 20 :face detached-creation-face))
+ "Configuration for `detached' list mode."
+ :type '(repeat (plist :options ((:name symbol)
+ (:function symbol)
+ (:length symbol)
+ (:face symbol))))
+ :group 'detached)
+
+(defcustom detached-list-display-buffer-action
+ '(display-buffer-same-window
+ (inhibit-same-window . nil))
+ "The action used to display the detached list buffer."
+ :group 'detached
+ :type 'sexp)
+
+(defcustom detached-list-open-session-display-buffer-action
+ '(display-buffer-same-window
+ (inhibit-same-window . nil))
+ "The action used to display a detached session."
+ :group 'detached
+ :type 'sexp)
+
+(defcustom detached-list-filters nil
+ "An alist of custom filters that can be applied.
+
+The filters are built using the different narrow functions that
+detached list implements."
+ :group 'detached
+ :type '(alist :key-type string))
+
+(defcustom detached-list-session-identifier-function
+ #'detached-session-identifier
+ "The function to use for identifying a session."
+ :group 'detached
+ :type 'sexp)
+
+(defcustom detached-list-state-symbols
+ '((unknown . "-")
+ (active . "*")
+ (failure . "!")
+ (success . " ")
+ (initially-attached . "o")
+ (initially-detached . " "))
+ "An alist of symbols to use to communicate different states."
+ :group 'detached
+ :type '(alist :key-type symbol :value-type string))
+
+;;;; Private
+
+(defvar detached-list--marked-sessions nil
+ "A list of marked session ids.")
+(defvar detached-list--narrow-criteria nil
+ "A list of criteria to apply when displaying the sessions.")
+
+;;;; Functions
+
+(defun detached-list-imenu-index ()
+ "Create an `imenu' index for `detached-list'."
+ (let ((index))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((session (tabulated-list-get-id)))
+ (push `(,(detached-session-command session) . ,(point))
+ index))
+ (forward-line 1))
+ (seq-reverse index)))
+
+(defun detached-list-eldoc (_callback)
+ "A member of `eldoc-documentation-functions', for signatures."
+ (let ((session (tabulated-list-get-id)))
+ (when (detached-session-p session)
+ (let ((strs `(,(when-let ((annotation (detached--session-annotation session)))
+ (propertize annotation 'face 'detached-annotation-face))
+ ,(detached-session-command session))))
+ (string-join (seq-remove #'null strs) "\n")))))
+
+;;;; Commands
+
+(defun detached-list-initialize-session-directory (&optional all)
+ "Initialize a session-directory.
+
+Optionally initialize ALL session-directories."
+ (interactive "P")
+ (if-let* ((uninitialized-directories
+ (thread-last (detached-get-sessions)
+ (seq-filter #'detached-session-uninitialized-p)
+ (seq-map #'detached-session-directory)
+ (seq-uniq))))
+ (if all
+ (seq-do #'detached-list--initialize-directory uninitialized-directories)
+ (when-let ((directory (completing-read "Initialize directory: " uninitialized-directories)))
+ (detached-list--initialize-directory directory)))
+ (message "All session directories have been initialized")))
+
+(defun detached-list-quit ()
+ "Quit command."
+ (interactive)
+ (if (= (length (window-list)) 1)
+ (bury-buffer)
+ (delete-window)))
+
+(defun detached-list-remove-narrow-criterion ()
+ "Remove narrow criterion."
+ (interactive)
+ (if detached-list--narrow-criteria
+ (detached-list-narrow-sessions
+ (butlast detached-list--narrow-criteria))
+ (message "No criterion to remove")))
+
+(defun detached-list-widen ()
+ "Remove all narrowing restrictions."
+ (interactive)
+ (when detached-list--narrow-criteria
+ (detached-list-narrow-sessions nil)))
+
+(defun detached-list-detach-from-session (session)
+ "Detach from SESSION at point."
+ (interactive
+ (list (tabulated-list-get-id)))
+ (when-let* ((buffer (detached-list--attached-p session)))
+ (unless (get-buffer-window buffer)
+ (pop-to-buffer buffer))
+ (with-selected-window (get-buffer-window buffer)
+ (detached-detach-session))))
+
+(defun detached-list-jump-to-directory (session)
+ "Jump to SESSION at point's directory."
+ (interactive
+ (list (tabulated-list-get-id)))
+ (detached-open-session-directory session))
+
+(defun detached-list-kill-session ()
+ "Send a TERM signal to sessions at point, or all marked sessions.
+
+Optionally DELETE the session if prefix-argument is provided."
+ (interactive)
+ (when (y-or-n-p (if detached-list--marked-sessions
+ "Kill all marked sessions? "
+ "Kill session at point? "))
+ (seq-do
+ (lambda (session)
+ (detached-list--unmark-session session)
+ (detached-kill-session session current-prefix-arg))
+ (detached-list--get-marked-or-current-sessions))
+ (detached-list-revert)))
+
+(defun detached-list-view-session (session)
+ "View SESSION."
+ (interactive
+ (list (detached-session-in-context)))
+ (let ((detached-open-session-display-buffer-action
+ detached-list-open-session-display-buffer-action))
+ (detached-view-dwim session)))
+
+(defun detached-list-edit-and-run-session (session &optional toggle-suppress-output)
+ "Edit and run SESSION at point.
+
+Optionally TOGGLE-SUPPRESS-OUTPUT."
+ (interactive
+ (list (tabulated-list-get-id)
+ current-prefix-arg))
+ (let ((detached-session-mode
+ (if toggle-suppress-output
+ (if (eq 'detached (detached--session-initial-mode session))
+ 'attached
+ 'detached)
+ (detached--session-initial-mode session))))
+ (unless (eq detached-session-mode 'detached)
+ (when-let ((single-window (> (length (window-list)) 1))
+ (buffer (current-buffer)))
+ (delete-window (get-buffer-window))
+ (bury-buffer buffer)))
+ (detached-edit-and-run-session session)))
+
+(defun detached-list-rerun-session (session &optional toggle-session-mode)
+ "Rerun SESSION at point.
+
+Optionally TOGGLE-SESSION-MODE."
+ (interactive
+ (list (tabulated-list-get-id)
+ current-prefix-arg))
+ (let ((detached-session-mode
+ (if toggle-session-mode
+ (if (eq 'attached (detached--session-initial-mode session))
+ 'attached
+ 'detached)
+ (detached--session-initial-mode session))))
+ (unless (eq detached-session-mode 'detached)
+ (when-let ((single-window (> (length (window-list)) 1))
+ (buffer (current-buffer)))
+ (delete-window (get-buffer-window))
+ (bury-buffer buffer)))
+ (detached-rerun-session session)))
+
+(defun detached-list-diff-marked-sessions ()
+ "Diff two sessions."
+ (interactive)
+ (if (= (length detached-list--marked-sessions) 2)
+ (progn
+ (when-let ((single-window (> (length (window-list)) 1))
+ (buffer (current-buffer)))
+ (delete-window (get-buffer-window))
+ (bury-buffer buffer))
+ (apply #'detached-diff-session detached-list--marked-sessions))
+ (message "Mark two sessions")))
+
+(defun detached-list-open-session ()
+ "View session."
+ (interactive)
+ (let ((session (tabulated-list-get-id))
+ (detached-open-session-display-buffer-action
+ detached-list-open-session-display-buffer-action))
+ (when-let ((single-window (> (length (window-list)) 1))
+ (buffer (current-buffer)))
+ (delete-window (get-buffer-window))
+ (bury-buffer buffer))
+ (detached-open-session session)))
+
+(defun detached-list-narrow-unique ()
+ "Narrow to unique sessions."
+ (interactive)
+ (when detached-list-session-identifier-function
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Unique" .
+ ,(lambda (sessions)
+ (thread-last sessions
+ (seq-group-by detached-list-session-identifier-function)
+ (seq-map (lambda (it)
+ (pcase-let ((`(,_identifier . ,duplicate-sessions) it))
+ (car duplicate-sessions))))
+ (seq-sort-by #'detached-session-start-time #'>))))))))
+
+(defun detached-list-narrow-after-time (time-threshold)
+ "Narrow to session's created after TIME-THRESHOLD."
+ (interactive
+ (list
+ (read-string "Enter time: ")))
+ (when time-threshold
+ (if-let ((parsed-threshold (detached--list-parse-time time-threshold)))
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(format "+%s" time-threshold) .
+ ,(lambda (sessions)
+ (let ((current-time (time-to-seconds (current-time))))
+ (seq-filter (lambda (it)
+ (< (- current-time
+ (detached-session-start-time it))
+ parsed-threshold))
+ sessions))))))
+ (message "Cannot parse time"))))
+
+(defun detached-list-narrow-before-time (time-threshold)
+ "Narrow to session's created before TIME-THRESHOLD."
+ (interactive
+ (list
+ (read-string "Enter time: ")))
+ (when time-threshold
+ (if-let ((parsed-threshold (detached--list-parse-time time-threshold)))
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(format "-%s" time-threshold) .
+ ,(lambda (sessions)
+ (let ((current-time (time-to-seconds (current-time))))
+ (seq-filter (lambda (it)
+ (> (- current-time
+ (detached-session-start-time it))
+ parsed-threshold))
+ sessions))))))
+ (message "Cannot parse time"))))
+
+(defun detached-list-narrow-host (hostname)
+ "Narrow to sessions from a selected HOSTNAME."
+ (interactive
+ (list
+ (when-let* ((hostnames
+ (thread-last (detached-list--get-narrowed-sessions)
+ (seq-map #'detached-session-host-name)
+ (seq-uniq))))
+ (completing-read
+ "Select host: "
+ hostnames))))
+ (when hostname
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Host: " hostname) .
+ ,(lambda (sessions)
+ (seq-filter (lambda (it)
+ (string-match hostname
+ (detached-session-host-name it)))
+ sessions)))))))
+
+(defun detached-list-narrow-output (regexp)
+ "Narrow to sessions which output contain REGEXP."
+ (interactive
+ (list (read-regexp
+ "Filter session outputs containing (regexp): ")))
+ (when regexp
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Output: " regexp) .
+ ,(lambda (sessions)
+ (detached--grep-sesssions-output sessions regexp)))))))
+
+(defun detached-list-narrow-command (regexp)
+ "Narrow to sessions which command match REGEXP."
+ (interactive
+ (list
+ (if current-prefix-arg
+ (regexp-quote
+ (detached-session-command
+ (detached-session-in-context)))
+ (read-regexp
+ "Filter session commands containing (regexp): "))))
+ (when regexp
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Command: " regexp) .
+ ,(lambda (sessions)
+ (seq-filter (lambda (it)
+ (string-match regexp
+ (detached-session-command it)))
+ sessions)))))))
+
+(defun detached-list-narrow-working-directory (regexp)
+ "Narrow to sessions with working directory matching REGEXP."
+ (interactive
+ (list
+ (if current-prefix-arg
+ (regexp-quote
+ (detached-session-working-directory
+ (detached-session-in-context)))
+ (read-regexp
+ "Filter session working directories containing (regexp): "))))
+ (when regexp
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Working-Directory: " regexp) .
+ ,(lambda (sessions)
+ (seq-filter (lambda (it)
+ (string-match regexp
+ (detached-session-working-directory it)))
+ sessions)))))))
+
+(defun detached-list-narrow-session-directory (session-directory)
+ "Narrow to sessions with SESSION-DIRECTORY."
+ (interactive
+ (list
+ (when-let* ((directories
+ (thread-last (detached-list--get-narrowed-sessions)
+ (seq-map #'detached-session-directory)
+ (seq-uniq))))
+ (completing-read
+ "Select session directory: "
+ directories))))
+ (when session-directory
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Session-Directory: " session-directory) .
+ ,(lambda (sessions)
+ (seq-filter (lambda (it)
+ (string-match session-directory
+ (detached-session-directory it)))
+ sessions)))))))
+
+(defun detached-list-narrow-annotation (regexp)
+ "Narrow to sessions which annotation match REGEXP."
+ (interactive
+ (list (read-regexp
+ "Filter session annotations containing (regexp): ")))
+ (when regexp
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Annotation: " regexp) .
+ ,(lambda (sessions)
+ (seq-filter (lambda (it)
+ (when-let ((annotation (detached--session-annotation it)))
+ (string-match regexp annotation)))
+ sessions)))))))
+
+(defun detached-list-narrow-localhost ()
+ "Narrow to local-host sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Localhost" .
+ ,(lambda (sessions)
+ (seq-filter #'detached-session-localhost-p sessions))))))
+
+(defun detached-list-narrow-remotehost ()
+ "Narrow to remote-host sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Remotehost" .
+ ,(lambda (sessions)
+ (seq-filter #'detached-session-remotehost-p sessions))))))
+
+(defun detached-list-narrow-currenthost ()
+ "Narrow to current-host sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Currenthost" .
+ ,(lambda (sessions)
+ (let ((current-host (car (detached--host))))
+ (seq-filter (lambda (it)
+ (string= (detached-session-host-name it) current-host))
+ sessions)))))))
+
+(defun detached-list-select-filter ()
+ "Select filter from `detached-list-filter' to apply."
+ (interactive)
+ (when-let* ((metadata `(metadata
+ (category . detached)
+ (display-sort-function . identity)))
+ (collection (lambda (string predicate action)
+ (if (eq action 'metadata)
+ metadata
+ (complete-with-action action detached-list-filters string predicate))))
+ (filter-name
+ (completing-read "Select filter: " collection nil t)))
+ (detached-list--apply-filter
+ (alist-get filter-name detached-list-filters nil nil #'string=))))
+
+(defun detached-list-narrow-origin (origin)
+ "Narrow to sessions with a specific ORIGIN."
+ (interactive
+ (list
+ (when-let ((origins
+ (thread-last (detached-list--get-narrowed-sessions)
+ (seq-map #'detached--session-origin)
+ (seq-uniq)
+ (seq-remove #'null)
+ (seq-map #'symbol-name))))
+ (completing-read
+ "Select origin: "
+ origins))))
+ (when origin
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ (,(concat "Origin: " origin) .
+ ,(lambda (sessions)
+ (seq-filter
+ (lambda (it)
+ (string-match origin
+ (symbol-name (detached--session-origin it))))
+ sessions)))))))
+
+(defun detached-list-narrow-active ()
+ "Narrow to active sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Active" .
+ ,(lambda (sessions)
+ (seq-filter #'detached-session-active-p sessions))))))
+
+(defun detached-list-narrow-inactive ()
+ "Narrow to inactive sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Inactive" .
+ ,(lambda (sessions)
+ (seq-remove #'detached-session-active-p sessions))))))
+
+(defun detached-list-narrow-success ()
+ "Narrow to successful sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Success" .
+ ,(lambda (sessions)
+ (seq-remove #'detached-session-failed-p sessions))))))
+
+(defun detached-list-narrow-failure ()
+ "Narrow to failed sessions."
+ (interactive)
+ (detached-list-narrow-sessions
+ `(,@detached-list--narrow-criteria
+ ("Failure" .
+ ,(lambda (sessions)
+ (seq-filter #'detached-session-failed-p sessions))))))
+
+(defun detached-list-mark-regexp (regexp)
+ "Mark sessions which command match REGEXP.
+
+If prefix-argument is provided unmark instead of mark."
+ (interactive
+ (list (read-regexp
+ (concat (if current-prefix-arg "Unmark" "Mark")
+ " session commands containing (regexp): "))))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((session (tabulated-list-get-id)))
+ (when (string-match regexp (detached-session-command session))
+ (if current-prefix-arg
+ (detached-list--unmark-session session)
+ (detached-list--mark-session session))))
+ (forward-line))))
+
+(defun detached-list-delete-session ()
+ "Delete session at point, or all marked sessions."
+ (interactive)
+ (when (y-or-n-p (if detached-list--marked-sessions
+ "Delete all marked sessions? "
+ "Delete session at point? "))
+ (let ((detached--update-database nil))
+ (seq-do
+ (lambda (session)
+ (detached-list--unmark-session session)
+ (detached-delete-session session))
+ (detached-list--get-marked-or-current-sessions)))
+ (detached--db-update-sessions)
+ (detached-list-revert)))
+
+(defun detached-list-mark-session ()
+ "Mark session at point and advance to next session."
+ (interactive)
+ (let* ((session (tabulated-list-get-id)))
+ (detached-list--mark-session session)
+ (forward-line)))
+
+(defun detached-list-unmark-session ()
+ "Unmark session at point and advance to next session."
+ (interactive)
+ (let* ((session (tabulated-list-get-id)))
+ (detached-list--unmark-session session)
+ (forward-line)))
+
+(defun detached-list-unmark-sessions ()
+ "Unmark all sessions."
+ (interactive)
+ (setq detached-list--marked-sessions nil)
+ (detached-list-revert))
+
+(defun detached-list-toggle-mark-session ()
+ "Toggle mark on session at point."
+ (interactive)
+ (let* ((session (tabulated-list-get-id)))
+ (if (detached-list--marked-session-p session)
+ (detached-list--unmark-session session)
+ (detached-list--mark-session session))))
+
+(defun detached-list-toggle-sessions ()
+ "Toggle mark on all sessions."
+ (interactive)
+ (let* ((sessions (seq-map #'car tabulated-list-entries))
+ (unmarked-sessions
+ (seq-remove
+ (lambda (session)
+ (seq-find
+ (lambda (marked-session)
+ (eq (detached-session-id marked-session)
+ (detached-session-id session)))
+ detached-list--marked-sessions))
+ sessions)))
+ (setq detached-list--marked-sessions unmarked-sessions)
+ (detached-list-revert)))
+
+(defun detached-list-revert ()
+ "Update content in buffer."
+ (interactive)
+ (tabulated-list-revert)
+ (detached-list--restore-marks)
+ (when hl-line-mode (hl-line-highlight)))
+
+;;;###autoload
+(defun detached-list-sessions ()
+ "Open list of `detached'."
+ (interactive)
+ (let* ((current-directory default-directory)
+ (buffer (get-buffer-create "*detached-list*"))
+ (window
+ (or
+ (get-buffer-window buffer)
+ (display-buffer buffer detached-list-display-buffer-action))))
+ (select-window window)
+ (setq-local default-directory current-directory)
+ (unless (eq major-mode 'detached-list-mode)
+ (detached-list-mode)
+ (setq tabulated-list-entries
+ (seq-map #'detached-list--get-entry
+ (detached-list--get-narrowed-sessions)))
+ (tabulated-list-print t))))
+
+(defun detached-list-narrow-sessions (criteria)
+ "Narrow session(s) based on CRITERIA."
+ (setq detached-list--narrow-criteria criteria)
+ (when (eq major-mode 'detached-list-mode)
+ (setq tabulated-list-entries
+ (seq-map #'detached-list--get-entry
+ (detached-list--get-narrowed-sessions)))
+ (tabulated-list-print t)
+ (detached-list-revert)))
+
+;;;; Support functions
+
+(defun detached-list--apply-filter (filter)
+ "Apply FILTER."
+ (setq detached-list--narrow-criteria nil)
+ (seq-do (lambda (criteria) (apply criteria)) filter))
+
+(defun detached--revert-selection-change (&rest _)
+ "Revert function to add to `window-selection-change-functions'."
+ (detached-list-revert))
+
+(defun detached-list--initialize-directory (directory)
+ "Initialize sessions in DIRECTORY."
+ (thread-last (detached-get-sessions)
+ (seq-filter (lambda (it) (string= directory (detached-session-directory it))))
+ (seq-do #'detached--initialize-session)))
+
+(defun detached--list-parse-time (time)
+ "Return a value in seconds based on TIME."
+ (when time
+ (cond ((string-match (rx (group (one-or-more digit)) "h") time)
+ (* 60 60 (string-to-number (match-string 1 time))))
+ ((string-match (rx (group (one-or-more digit)) space "day" (zero-or-more "s")) time)
+ (* 60 60 24 (string-to-number (match-string 1 time))))
+ ((string-match (rx (group (one-or-more digit)) space "week" (zero-or-more "s")) time)
+ (* 60 60 24 7 (string-to-number (match-string 1 time))))
+ ((string-match (rx (group (one-or-more digit)) space "month" (zero-or-more "s")) time)
+ (* 60 60 24 7 30 (string-to-number (match-string 1 time))))
+ ('t nil))))
+
+(defun detached-list--db-update ()
+ "Function to run when the database is updated."
+ (when-let ((detached-list-buffer (detached-list--get-list-mode-buffer)))
+ (with-current-buffer detached-list-buffer
+ (detached-list-revert))))
+
+(defun detached-list--get-list-mode-buffer ()
+ "Return buffer with `detached-list-mode'."
+ (seq-find (lambda (buffer)
+ (with-current-buffer buffer
+ (eq major-mode 'detached-list-mode)))
+ (buffer-list)))
+
+(defun detached-list--revert-sessions ()
+ "Recompute `tabulated-list-entries'."
+ (setq tabulated-list-entries
+ (seq-map #'detached-list--get-entry
+ (detached-list--get-narrowed-sessions))))
+
+(defun detached-list--get-entry (session)
+ "Return list entry based on SESSION."
+ `(,session
+ ,(cl-loop for config in detached-list-config
+ vconcat `(,
+ (let ((str (funcall (plist-get config ':function) session)))
+ (if-let ((face (plist-get config :face)))
+ (propertize str 'face face)
+ str))))))
+
+(defun detached-list--get-format ()
+ "Return the format for `detached-list'."
+ (cl-loop for config in detached-list-config
+ vconcat `((,(plist-get config ':name)
+ ,(plist-get config ':length)
+ ,(plist-get config ':sort)))))
+
+(defun detached-list--marked-session-p (session)
+ "Return t if SESSION is marked."
+ (seq-find (lambda (it)
+ (eq (detached-session-id it)
+ (detached-session-id session)))
+ detached-list--marked-sessions))
+
+(defun detached-list--attached-p (session)
+ "Return t if Emacs is attached to SESSION."
+ (let ((id (detached-session-id session)))
+ (seq-find
+ (lambda (buffer)
+ (with-current-buffer buffer
+ (when-let ((buffer-session detached-buffer-session)
+ (buffer-session-id (detached-session-id buffer-session)))
+ (eq buffer-session-id id))))
+ (buffer-list))))
+
+(defun detached-list--unmark-session (session)
+ "Unmark SESSION."
+ (when (detached-list--marked-session-p session)
+ (tabulated-list-put-tag " ")
+ (setq detached-list--marked-sessions
+ (seq-remove (lambda (it)
+ (eq (detached-session-id it)
+ (detached-session-id session)))
+ detached-list--marked-sessions))))
+
+(defun detached-list--mark-session (session)
+ "Mark SESSION."
+ (unless (detached-list--marked-session-p session)
+ (tabulated-list-put-tag (detached-list--mark-identifier))
+ (setq detached-list--marked-sessions
+ (push session detached-list--marked-sessions))))
+
+(defun detached-list--restore-marks ()
+ "Restore mark(s) in `detached-list-mode' buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((session (tabulated-list-get-id)))
+ (when (detached-list--marked-session-p session)
+ (tabulated-list-put-tag (detached-list--mark-identifier))))
+ (forward-line))))
+
+(defun detached-list--mark-identifier ()
+ "Return identifier for marked sessions."
+ (let ((str "*"))
+ (propertize str 'face 'detached-mark-face)))
+
+(defun detached-list--status-str (session)
+ "Return a string representation of SESSION's status."
+ (let* ((status (detached-session-status session))
+ (status-str
+ (cond ((detached-session-active-p session)
+ (alist-get 'active detached-list-state-symbols "?"))
+ ((and (detached-session-inactive-p session) (eq status 'failure))
+ (alist-get 'failure detached-list-state-symbols "?"))
+ ((and (detached-session-inactive-p session) (eq status 'success))
+ (alist-get 'success detached-list-state-symbols "?"))
+ ((not (detached-session-started-p session))
+ (alist-get 'unknown detached-list-state-symbols "?"))
+ (t "?")))
+ (status-face
+ (cond ((and (detached-session-uninitialized-p session)
+ (detached-session-active-p session))
+ 'detached-identifier-face)
+ ((detached-session-active-p session) 'font-lock-type-face)
+ ((eq status 'failure) 'detached-failure-face)
+ ((eq status 'success) 'detached-state-face)
+ (t 'detached-identifier-face)))
+ (attach-str
+ (cond ((eq 'attached (detached--session-initial-mode session))
+ (alist-get 'initially-attached detached-list-state-symbols "?"))
+ ((eq 'detached (detached--session-initial-mode session))
+ (alist-get 'initially-detached detached-list-state-symbols "?"))
+ (t "?")))
+ (initial-mode-face
+ (cond ((eq 'attached (detached--session-initial-mode session)) 'detached-identifier-face)
+ ((eq 'detached (detached--session-initial-mode session)) 'detached-identifier-face)
+ (t "?"))))
+ (string-join
+ `(,(propertize status-str 'face status-face)
+ ,(propertize attach-str 'face initial-mode-face))
+ " ")))
+
+(defun detached-list--command-str (session)
+ "Return command string for SESSION."
+ (let ((command-str (detached-session-command session)))
+ (if (detached-session-uninitialized-p session)
+ (propertize command-str 'face 'detached-uninitialized-face)
+ command-str)))
+
+(defun detached-list--get-marked-or-current-sessions ()
+ "Return a list of relevant sessions."
+ (or detached-list--marked-sessions
+ `(,(tabulated-list-get-id))))
+
+(defun detached-list--get-narrowed-sessions ()
+ "Return a list of narrowed sessions."
+ (let ((sessions (detached-get-sessions)))
+ (seq-do (lambda (it)
+ (pcase-let ((`(,_identifier . ,criteria) it))
+ (setq sessions (funcall criteria sessions))))
+ detached-list--narrow-criteria)
+ sessions))
+
+(cl-defmethod detached--session-in-context ((_mode (derived-mode detached-list-mode)))
+ "Return session when in `detached-list-mode'."
+ (tabulated-list-get-id))
+
+(defun detached--grep-sesssions-output (sessions regexp)
+ "Return a narrowed list with SESSIONS containing REGEXP."
+ (let* ((sessions-and-directories
+ (thread-last sessions
+ (seq-group-by #'detached-session-directory)
+ (seq-filter (lambda (it)
+ ;; Filter out only accessible directories
+ (or (not (file-remote-p (car it)))
+ (file-remote-p (car it) nil t))))))
+ (session-ids
+ (thread-last sessions-and-directories
+ (seq-map
+ (lambda (it)
+ (pcase-let* ((`(,session-directory . ,sessions) it)
+ (default-directory session-directory)
+ (includes
+ (seq-map (lambda (session)
+ (format "--include=%s"
+ (file-name-nondirectory
+ (detached--session-file
+ session
+ 'log))))
+ sessions))
+ (grep-command
+ (string-join `(,detached-grep-program
+ "--files-with-matches"
+ ,@includes
+ "--no-messages"
+ "--ignore-case"
+ "--recursive"
+ ,(format "\"%s\"" regexp))
+ " ")))
+ (split-string
+ (with-connection-local-variables
+ (with-temp-buffer
+ (process-file-shell-command grep-command nil t)
+ (buffer-string)))
+ "\n" t))))
+ (flatten-tree)
+ (seq-remove #'null)
+ (seq-map #'file-name-sans-extension))))
+ (seq-filter (lambda (it)
+ (member (symbol-name (detached-session-id it)) session-ids))
+ sessions)))
+
+;;;; Major mode
+
+(defvar detached-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "a") #'detached-edit-session-annotation)
+ (define-key map (kbd "d") #'detached-list-delete-session)
+ (define-key map (kbd "e") #'detached-edit-and-run-session)
+ (define-key map (kbd "f") #'detached-list-select-filter)
+ (define-key map (kbd "g") #'detached-list-revert)
+ (define-key map (kbd "i") #'detached-list-initialize-session-directory)
+ (define-key map (kbd "j") #'imenu)
+ (define-key map (kbd "k") #'detached-list-kill-session)
+ (define-key map (kbd "m") #'detached-list-mark-session)
+ ;; Narrow
+ (define-key map (kbd "n a") #'detached-list-narrow-annotation)
+ (define-key map (kbd "n c") #'detached-list-narrow-command)
+ (define-key map (kbd "n d") #'detached-list-narrow-session-directory)
+ ;; Host
+ (define-key map (kbd "n h h") #'detached-list-narrow-host)
+ (define-key map (kbd "n h c") #'detached-list-narrow-currenthost)
+ (define-key map (kbd "n h l") #'detached-list-narrow-localhost)
+ (define-key map (kbd "n h r") #'detached-list-narrow-remotehost)
+ (define-key map (kbd "n o") #'detached-list-narrow-output)
+ (define-key map (kbd "n O") #'detached-list-narrow-origin)
+ ;; State
+ (define-key map (kbd "n s a") #'detached-list-narrow-active)
+ (define-key map (kbd "n s f") #'detached-list-narrow-failure)
+ (define-key map (kbd "n s i") #'detached-list-narrow-inactive)
+ (define-key map (kbd "n s s") #'detached-list-narrow-success)
+ (define-key map (kbd "n u") #'detached-list-narrow-unique)
+ (define-key map (kbd "n w") #'detached-list-narrow-working-directory)
+ (define-key map (kbd "n +") #'detached-list-narrow-after-time)
+ (define-key map (kbd "n -") #'detached-list-narrow-before-time)
+ (define-key map (kbd "q") #'detached-list-quit)
+ (define-key map (kbd "r") #'detached-rerun-session)
+ (define-key map (kbd "t") #'detached-list-toggle-mark-session)
+ (define-key map (kbd "T") #'detached-list-toggle-sessions)
+ (define-key map (kbd "u") #'detached-list-unmark-session)
+ (define-key map (kbd "U") #'detached-list-unmark-sessions)
+ (define-key map (kbd "v") #'detached-list-view-session)
+ (define-key map (kbd "w") #'detached-copy-session-command)
+ (define-key map (kbd "W") #'detached-copy-session-output)
+ (define-key map (kbd "x") #'detached-list-detach-from-session)
+ (define-key map (kbd "%") #'detached-list-mark-regexp)
+ (define-key map (kbd "=") #'detached-list-diff-marked-sessions)
+ (define-key map (kbd "-") #'detached-list-widen)
+ (define-key map (kbd "!") #'detached-shell-command)
+ ;; Describe
+ (define-key map (kbd ". s") #'detached-describe-session)
+ (define-key map (kbd ". d") #'detached-describe-duration)
+ (define-key map (kbd "<backspace>") #'detached-list-remove-narrow-criterion)
+ (define-key map (kbd "<return>") #'detached-list-open-session)
+ map)
+ "Keymap used in `detached-list-mode'.")
+
+(defun detached-list--mode-line-indicator ()
+ "Return the mode line indicator based on narrow criteria."
+ (if detached-list--narrow-criteria
+ (string-join
+ (thread-last detached-list--narrow-criteria
+ (seq-map #'car))
+ " > ")
+ ""))
+
+(define-derived-mode detached-list-mode tabulated-list-mode "Detached List"
+ "Mode for `detached' list."
+ (setq tabulated-list-format (detached-list--get-format))
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key nil)
+ (setq imenu-create-index-function #'detached-list-imenu-index)
+ (setq-local eldoc-echo-area-use-multiline-p t)
+ (setq-local eldoc-idle-delay 0)
+ (hl-line-mode)
+ (add-hook 'eldoc-documentation-functions #'detached-list-eldoc nil t)
+ (add-hook 'tabulated-list-revert-hook #'detached-list--revert-sessions nil t)
+ (add-hook 'window-selection-change-functions #'detached--revert-selection-change nil t)
+ (setq-local mode-line-position '((:eval (detached-list--mode-line-indicator))))
+ (tabulated-list-init-header))
+
+(provide 'detached-list)
+
+;;; detached-list.el ends here
--- /dev/null
+;;; detached-org.el --- Detached 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 `detached' with `org'. In particular it
+;; integrates with `ob-shell' in order to detach babel src blocks.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'detached)
+(require 'ob-shell)
+
+;;;; Variables
+
+(defcustom detached-org-session-action
+ '(:attach detached-shell-command-attach-session
+ :view detached-view-dwim
+ :run detached-shell-command)
+ "Actions for a session created with `detached-org'."
+ :group 'detached
+ :type 'plist)
+
+;;;; Functions
+
+;;;###autoload
+(defun detached-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
+`detached' command. The functionality is enabled by setting a header
+property of :detached t in the org babel src block."
+ (pcase-let* ((`(,session ,full-body ,params ,stdin ,cmdline) args))
+ (if (alist-get :detached params)
+ (cl-letf* ((detached-session-origin 'org)
+ (detached-session-action detached-org-session-action)
+ (detached-session-mode 'detached)
+ (new-command (replace-regexp-in-string "\n" " && " full-body))
+ (detached-session (detached-create-session new-command))
+ (dtach-command
+ (if (string= "none" (alist-get :session params))
+ (detached-session-start-command detached-session
+ :type 'string)
+ (format "%s\necho \"[detached]\"" (detached-session-start-command detached-session
+ :type 'string))))
+ ((symbol-function #'org-babel-eval)
+ (lambda (_ command)
+ (start-file-process-shell-command "detached-org" nil command)
+ "[detached]")))
+ (apply org-babel-sh-evaluate-fun `(,session ,dtach-command ,params ,stdin ,cmdline)))
+ (apply org-babel-sh-evaluate-fun args))))
+
+(provide 'detached-org)
+
+;;; detached-org.el ends here
--- /dev/null
+(define-package "detached" "20221129.1430" "A package to launch, and manage, detached processes"
+ '((emacs "27.1"))
+ :commit "6b64d4d8064cee781e071e825857b442ea96c3d9" :authors
+ '(("Niklas Eklund" . "niklas.eklundNOSPAMposteo.net"))
+ :maintainer
+ '("detached.el Development" . "~niklaseklund/detached.elNOSPAMlists.sr.ht")
+ :keywords
+ '("convenience" "processes")
+ :url "https://sr.ht/~niklaseklund/detached.el/")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; detached-shell.el --- Detached 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 `detached' extension which provides integration for `shell'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'detached)
+
+;;;; Variables
+
+(defcustom detached-shell-session-action
+ '(:attach detached-shell-command-attach-session
+ :view detached-view-dwim
+ :run detached-start-shell-command-session)
+ "Actions for a session created with `detached-shell'."
+ :group 'detached
+ :type 'plist)
+
+;;;; Functions
+
+;;;###autoload
+(defun detached-shell-override-history (orig-fun &rest args)
+ "Override history 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 #'detached-shell--comint-read-input-ring-advice)
+ (apply (if (called-interactively-p 'any)
+ #'funcall-interactively #'funcall)
+ orig-fun
+ args)))
+
+;;;###autoload
+(defun detached-shell-save-history-on-kill ()
+ "Add hook to save history when killing `shell' buffer."
+ (add-hook 'kill-buffer-hook #'detached-shell--save-history 0 t))
+
+;;;; Commands
+
+(defun detached-shell-send-input (&optional detached)
+ "Start a `detached-session' and attach to it, unless DETACHED."
+ (interactive "P")
+ (let* ((detached-session-origin 'shell)
+ (detached-session-action detached-shell-session-action)
+ (detached-session-mode (if detached 'detached 'attached))
+ (comint-input-sender #'detached-shell--create-input-sender))
+ (comint-send-input)))
+
+;;;; Support functions
+
+(defun detached-shell--create-input-sender (proc string)
+ "Create a detached session based on STRING and send to PROC."
+ (with-connection-local-variables
+ (let* ((session
+ (detached-create-session (substring-no-properties string)))
+ (command
+ (detached-session-start-command session :type 'string)))
+ (setq detached-buffer-session session)
+ (comint-simple-send proc command))))
+
+(defun detached-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* ((history-file (cond ((string= shell--start-prog "bash") "~/.bash_history")
+ ((string= shell--start-prog "ksh") "~/.sh_history")
+ ((string= shell--start-prog "zsh") "~/.zsh_history")
+ (t nil))))
+ (setq comint-input-ring-file-name
+ (if history-file
+ (concat
+ (file-remote-p default-directory)
+ history-file)
+ comint-input-ring-file-name))
+ (apply orig-fun args)
+ (advice-remove 'comint-read-input-ring #'detached-shell--comint-read-input-ring-advice))))
+
+(defun detached-shell--save-history ()
+ "Save `shell' history."
+ (unless (string-prefix-p detached--shell-command-buffer (buffer-name))
+ (let* ((inhibit-message t))
+ (comint-write-input-ring))))
+
+;;;; Minor mode
+
+(let ((map detached-shell-mode-map))
+ (define-key map (kbd "<S-return>") #'detached-shell-send-input)
+ (define-key map (kbd "<C-return>") #'detached-shell-attach-session))
+
+(provide 'detached-shell)
+
+;;; detached-shell.el ends here
--- /dev/null
+;;; detached-vterm.el --- Detached 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 `detached' with `vterm'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'detached)
+
+(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")
+(declare-function vterm-beginning-of-line "vterm")
+
+(defvar vterm--process)
+
+;;;; Variables
+
+(defcustom detached-vterm-session-action
+ '(:attach detached-shell-command-attach-session
+ :view detached-view-dwim
+ :run detached-shell-command)
+ "Actions for a session created with `detached-vterm'."
+ :group 'detached
+ :type 'plist)
+
+;;;; Commands
+
+(defun detached-vterm-send-input (&optional detached)
+ "Start a `detached-session' and attach to it, unless DETACHED."
+ (interactive)
+ (let* ((input (buffer-substring-no-properties (vterm-beginning-of-line) (vterm-end-of-line)))
+ (detached-session-origin 'vterm)
+ (detached-session-action detached-vterm-session-action)
+ (detached-session-mode
+ (if detached 'detached 'attached))
+ (detached-current-session (detached-create-session input))
+ (command (detached-session-start-command detached-current-session
+ :type 'string)))
+ (vterm-send-C-a)
+ (vterm-send-C-k)
+ (process-send-string vterm--process command)
+ (setq detached-buffer-session detached-current-session)
+ (vterm-send-C-e)
+ (vterm-send-return)))
+
+(defun detached-vterm-attach (session)
+ "Attach to an active `detached' SESSION."
+ (interactive
+ (list
+ (let* ((host-name (car (detached--host)))
+ (sessions
+ (thread-last (detached-get-sessions)
+ (seq-filter (lambda (it)
+ (string= (detached-session-host-name it) host-name)))
+ (seq-filter #'detached-session-active-p))))
+ (detached-completing-read sessions))))
+ (let ((command
+ (detached-session-attach-command session
+ :type 'string)))
+ (setq detached-buffer-session session)
+ (process-send-string vterm--process command)
+ (vterm-send-return)))
+
+(cl-defmethod detached--detach-session ((_mode (derived-mode vterm-mode)))
+ "Detach from session when MODE is `vterm-mode'."
+ (process-send-string
+ vterm--process
+ detached--dtach-detach-character))
+
+;;;; Minor mode
+
+(defvar detached-vterm-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<S-return>") #'detached-vterm-send-input)
+ (define-key map (kbd "<C-return>") #'detached-vterm-attach)
+ (define-key map (kbd "C-c C-.") #'detached-describe-session)
+ (define-key map (kbd detached-detach-key) #'detached-detach-session)
+ map)
+ "Keymap for `detached-vterm-mode'.")
+
+;;;###autoload
+(define-minor-mode detached-vterm-mode
+ "Integrate `detached' in `vterm'."
+ :lighter " detached-vterm"
+ :keymap (let ((map (make-sparse-keymap)))
+ map))
+
+(provide 'detached-vterm)
+
+;;; detached-vterm.el ends here
--- /dev/null
+;;; detached.el --- A package to launch, and manage, detached processes -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+;; Author: Niklas Eklund <niklas.eklundNOSPAMposteo.net>
+;; Maintainer: detached.el Development <~niklaseklund/detached.elNOSPAMlists.sr.ht>
+;; URL: https://sr.ht/~niklaseklund/detached.el/
+;; Version: 0.10.1
+;; Package-Requires: ((emacs "27.1"))
+;; Keywords: convenience processes
+
+;; 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:
+
+;; The detached package allows users to run shell commands detached from
+;; Emacs. These commands are launched in sessions, using the program
+;; dtach[1]. These sessions can be easily created through the command
+;; `detached-shell-command', or any of the commands provided by the
+;; `detached-shell', `detached-eshell' and `detached-compile' extensions.
+
+;; When a session is created, detached makes sure that Emacs is attached
+;; to it the same time, which makes it a seamless experience for the
+;; users. The `detached' package internally creates a `detached-session'
+;; for all commands.
+
+;; [1] https://github.com/crigler/dtach
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'ansi-color)
+(require 'autorevert)
+(require 'comint)
+(require 'notifications)
+(require 'filenotify)
+(eval-when-compile (require 'rx))
+(require 'simple)
+(require 'subr-x)
+(require 'tramp)
+
+;;;; Variables
+
+;;;;; Customizable
+
+(defcustom detached-session-directory
+ (locate-user-emacs-file "detached/sessions")
+ "The directory to store sessions."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-db-directory
+ (locate-user-emacs-file "detached")
+ "The directory to store the `detached' database."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-dtach-program "dtach"
+ "The name of the dtach program."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-tail-program "tail"
+ "The name of the tail program."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-grep-program "grep"
+ "The name of the grep program."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-tee-program "tee"
+ "The name of the tee program."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-script-program "script"
+ "The name of the script program."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-shell-program shell-file-name
+ "Path to the shell to run the dtach command in."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-session-context-lines 50
+ "Number of context lines to display for a session."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-show-session-context t
+ "If session context should be shown when attaching."
+ :type 'boolean
+ :group 'detached)
+
+(defcustom detached-terminal-data-command nil
+ "The command for the tool script, which is used to record terminal data.
+The variable needs to be set in order for terminal data to be
+recorded, instead of plain-text data.
+
+Acceptable values are
+- `gnu/linux'
+- `darwin'
+- a custom string
+"
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-plain-text-commands nil
+ "A list of regexps for commands to run in plain-text mode."
+ :type 'list
+ :group 'detached)
+
+(defcustom detached-annotation-format
+ '((:width 3 :padding 2 :function detached--status-str :face detached-failure-face)
+ (:width 3 :padding 4 :function detached--state-str :face detached-state-face)
+ (:width 10 :padding 4 :function detached--host-str :face detached-host-face)
+ (:width 40 :padding 4 :function detached--working-dir-str :face detached-working-dir-face)
+ (:width 40 :padding 4 :function detached--metadata-str :face detached-metadata-face)
+ (:width 10 :padding 4 :function detached--duration-str :face detached-duration-face)
+ (:width 8 :padding 4 :function detached--size-str :face detached-size-face)
+ (:width 12 :padding 4 :function detached--creation-str :face detached-creation-face))
+ "The format of the annotations."
+ :type '(repeat symbol)
+ :group 'detached)
+
+(defcustom detached-command-format
+ '(:width 90 :padding 4 :function detached-command-str)
+ "The format for displaying the command."
+ :type 'integer
+ :group 'detached)
+
+(defcustom detached-shell-command-session-action
+ '(:attach detached-shell-command-attach-session
+ :view detached-view-dwim
+ :run detached-start-shell-command-session)
+ "Actions for a session created with `detached-shell-command'."
+ :type 'plist
+ :group 'detached)
+
+(defcustom detached-session-command
+ nil
+ "Command to run in session."
+ :group 'detached
+ :type 'string)
+
+(defcustom detached-session-environment
+ nil
+ "A property list with variables for session."
+ :group 'detached
+ :type 'plist)
+
+(defcustom detached-shell-command-initial-input t
+ "Variable to control initial command input for `detached-shell-command'.
+If set to a non nil value the latest entry to
+`detached-shell-command-history' will be used as the initial input in
+`detached-shell-command' when it is used as a command."
+ :type 'bool
+ :group 'detached)
+
+(defcustom detached-degraded-commands nil
+ "A list of commands which `detached' should consider degraded."
+ :type '(repeat (regexp :format "%v"))
+ :group 'detached)
+
+(defcustom detached-notification-function #'detached-state-transition-notifications-message
+ "Variable to set which function to use to issue a notification."
+ :type 'function
+ :group 'detached)
+
+(defcustom detached-detach-key "C-c C-d"
+ "Variable to set the keybinding for detaching."
+ :type 'string
+ :group 'detached)
+
+(defcustom detached-filter-ansi-sequences t
+ "Variable to instruct `detached' to use `ansi-filter'."
+ :type 'bool
+ :group 'detached)
+
+(defcustom detached-log-mode-hook '()
+ "Hook for customizing `detached-log' mode."
+ :type 'hook
+ :group 'detached)
+
+(defcustom detached-shell-mode-filter-functions
+ '(detached--env-message-filter
+ detached--dtach-eof-message-filter)
+ "A list of filter functions that are run in `detached-shell-mode'."
+ :type 'list
+ :group 'detached)
+
+(defcustom detached-dtach-socket-creation-delay 1.0
+ "A maximum delay, in seconds, that is reasonable for dtach socket creation."
+ :type 'float
+ :group 'detached)
+
+(defcustom detached-open-session-display-buffer-action
+ '(display-buffer-pop-up-window)
+ "The action used to display a detached session."
+ :group 'detached
+ :type 'sexp)
+
+(defcustom detached-session-info-buffer-action
+ '(display-buffer-in-side-window
+ (side . bottom)
+ (dedicated . t))
+ "The action used to display a information about a detached session."
+ :group 'detached
+ :type 'sexp)
+
+(defcustom detached-debug-enabled
+ nil
+ "If t enable debug messages in `detached'."
+ :group 'detached
+ :type 'boolean)
+
+;;;;; Public
+
+(defvar detached-session-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "a" #'detached-edit-session-annotation)
+ (define-key map "d" #'detached-detach-session)
+ (define-key map "D" #'detached-describe-duration)
+ (define-key map "e" #'detached-edit-and-run-session)
+ (define-key map "k" #'detached-kill-session)
+ (define-key map "r" #'detached-rerun-session)
+ (define-key map "S" #'detached-describe-session)
+ (define-key map "w" #'detached-copy-session-command)
+ (define-key map "W" #'detached-copy-session-output)
+ map))
+
+(defvar detached-enabled nil)
+
+(defvar detached-session-mode 'attached
+ "Mode of operation for session.
+Valid values are: create, new and attach")
+
+(defvar detached-session-origin nil
+ "Variable to specify the origin of the session.")
+
+(defvar detached-session-action nil
+ "A property list of actions for a session.")
+
+(defvar detached-shell-command-history nil
+ "History of commands run with `detached-shell-command'.")
+
+(defvar detached-local-session nil
+ "If set to t enforces a local session.")
+
+(defvar detached-compile-session-hooks nil
+ "Hooks to run when compiling a session.")
+
+(defvar detached-update-db-hooks nil
+ "Hooks to run when the database is updated.")
+
+(defvar detached-metadata-annotators-alist nil
+ "An alist of annotators for metadata.")
+
+(defvar detached-session-annotation nil
+ "An annotation string.")
+
+(defconst detached-session-version "0.10.1.0"
+ "The version of `detached-session'.
+This version is encoded as [package-version].[revision].")
+
+(defconst detached-minimum-session-version "0.9.2.2"
+ "The version of `detached-session' that the package is compatible with.")
+
+;;;;; Faces
+
+(defgroup detached-faces nil
+ "Faces used by `detached'."
+ :group 'detached
+ :group 'faces)
+
+(defface detached-metadata-face
+ '((t :inherit font-lock-builtin-face))
+ "Face used to highlight metadata in `detached'.")
+
+(defface detached-failure-face
+ '((t :inherit error))
+ "Face used to highlight failure in `detached'.")
+
+(defface detached-state-face
+ '((t :inherit success))
+ "Face used to highlight state in `detached'.")
+
+(defface detached-duration-face
+ '((t :inherit font-lock-builtin-face))
+ "Face used to highlight duration in `detached'.")
+
+(defface detached-size-face
+ '((t :inherit font-lock-function-name-face))
+ "Face used to highlight size in `detached'.")
+
+(defface detached-creation-face
+ '((t :inherit font-lock-comment-face))
+ "Face used to highlight date in `detached'.")
+
+(defface detached-working-dir-face
+ '((t :inherit font-lock-variable-name-face))
+ "Face used to highlight working directory in `detached'.")
+
+(defface detached-host-face
+ '((t :inherit font-lock-constant-face))
+ "Face used to highlight host in `detached'.")
+
+(defface detached-identifier-face
+ '((t :inherit font-lock-comment-face))
+ "Face used to highlight identifier in `detached'.")
+
+(defface detached-mark-face
+ '((t :inherit detached-state-face))
+ "Face used to highlight marked session in `detached-list-mode'.")
+
+(defface detached-annotation-face
+ '((t :inherit font-lock-comment-face))
+ "Face used to highlight the annotation of a session in `eldoc-mode'.")
+
+(defface detached-uninitialized-face
+ '((t :inherit font-lock-comment-face))
+ "Face used to highlight that a session is uninitialized.")
+
+
+;;;;; Private
+
+(defvar detached--sessions-initialized nil
+ "Sessions are initialized.")
+
+(defvar detached--sessions nil
+ "A list of sessions.")
+
+(defvar detached--watched-session-directories nil
+ "An alist where values are a (directory . descriptor).")
+
+(defvar detached--hashed-sessions nil
+ "Hashed sessions.")
+
+(defvar detached--unvalidated-session-ids nil
+ "A list of unvalidated session ids.")
+
+(defvar detached--current-emacsen nil
+ "List of current detached Emacsen.")
+
+(defvar detached--db-watch nil
+ "A descriptor to the `detached-db-directory'.")
+
+(defvar-local detached-buffer-session nil
+ "The `detached-session' session in current buffer.")
+
+(defvar detached-current-session nil
+ "The current session.")
+
+(defvar detached--session-candidates nil
+ "An alist of session candidates.")
+
+(defvar detached--annotation-widths nil
+ "An alist of widths to use for annotation.")
+
+(defvar detached--update-database t
+ "Update the database when value is t.")
+
+(defconst detached--shell-command-buffer "*Detached Shell Command*"
+ "Name of the `detached-shell-command' buffer.")
+
+(defconst detached--dtach-eof-message "\\[EOF - dtach terminating\\]"
+ "Message printed when `dtach' terminates.")
+
+(defconst detached--dtach-detached-message "\\[detached\\]\^M"
+ "Message printed when detaching from `dtach'.")
+
+(defconst detached--dtach-detach-character "\C-\\"
+ "Character used to detach from a session.")
+
+;;;; Data structures
+
+(cl-defstruct (detached-session (:constructor detached--session-create)
+ (:conc-name detached--session-))
+ (id nil :read-only t)
+ (command nil :read-only t)
+ (origin nil :read-only t)
+ (working-directory nil :read-only t)
+ (initial-mode nil)
+ (directory nil :read-only t)
+ (metadata nil :read-only t)
+ (host nil :read-only t)
+ (degraded nil :read-only t)
+ (text-mode nil :read-only t)
+ (env nil :read-only t)
+ (action nil :read-only t)
+ (local nil :read-only t)
+ (annotation)
+ (time nil)
+ (status nil)
+ (size nil)
+ (state nil)
+ (initialized-emacsen nil))
+
+;;;; Macros
+
+(defmacro detached-connection-local-variables (&rest body)
+ "A macro that conditionally use `connection-local-variables' when executing BODY."
+ `(if detached-local-session
+ (progn
+ ,@body)
+ (with-connection-local-variables
+ (progn
+ ,@body))))
+
+(defmacro detached-with-session (session &rest body)
+ "A macro that set up SESSION's environment before evaluating BODY."
+ (declare (indent 1))
+ `(let ((default-directory (detached-session-working-directory ,session))
+ (detached-session-origin (detached--session-origin ,session))
+ (detached-local-session (detached--session-local-p ,session))
+ (detached-session-mode (detached--session-initial-mode ,session))
+ (detached-session-action (detached--session-action ,session))
+ (detached-session-command (detached-session-command ,session))
+ (detached-session-environment (detached--session-env ,session))
+ (detached-current-session ,session))
+ ,@body))
+
+;;;; Commands
+
+;;;###autoload
+(defun detached-shell-command (command &optional suppress-output)
+ "Execute COMMAND with `detached'.
+
+Optionally SUPPRESS-OUTPUT if prefix-argument is provided."
+ (interactive
+ (list
+ (read-shell-command (if shell-command-prompt-show-cwd
+ (format-message "Detached shell command in `%s': "
+ (abbreviate-file-name
+ default-directory))
+ "Detached shell command: ")
+ (when detached-shell-command-initial-input
+ (car detached-shell-command-history))
+ 'detached-shell-command-history)
+ current-prefix-arg))
+ (let* ((detached-session-origin (or detached-session-origin 'shell-command))
+ (detached-session-action (or detached-session-action
+ detached-shell-command-session-action))
+ (detached-session-mode (or detached-session-mode
+ (if suppress-output 'detached 'attached)))
+ (session (detached-create-session command)))
+ (detached-start-session session)))
+
+;;;###autoload
+(defun detached-open-session (session)
+ "Open a `detached' SESSION."
+ (interactive
+ (list (detached-completing-read (detached-get-sessions))))
+ (when (detached-valid-session session)
+ (let ((initialized-session (detached--get-initialized-session session)))
+ (if (detached-session-active-p initialized-session)
+ (detached-attach-session initialized-session)
+ (funcall
+ (detached-session-view-function initialized-session)
+ initialized-session)))))
+
+;;;###autoload
+(defun detached-compile-session (session)
+ "Compile SESSION.
+
+The session is compiled by opening its output and enabling
+`compilation-minor-mode'."
+ (interactive
+ (list (detached-completing-read (detached-get-sessions))))
+ (when (detached-valid-session session)
+ (let ((buffer-name "*detached-session-output*")
+ (file
+ (detached--session-file session 'log))
+ (tramp-verbose 1))
+ (when (file-exists-p file)
+ (with-current-buffer (get-buffer-create buffer-name)
+ (let ((inhibit-read-only t))
+ (setq-local buffer-read-only nil)
+ (erase-buffer)
+ (insert (detached-session-output session))
+ (setq-local default-directory
+ (detached-session-working-directory session))
+ (run-hooks 'detached-compile-session-hooks)
+ (detached-log-mode)
+ (compilation-minor-mode)
+ (setq detached-buffer-session session)
+ (setq-local font-lock-defaults '(compilation-mode-font-lock-keywords t)))
+ (font-lock-mode)
+ (read-only-mode)
+ (goto-char (point-max)))
+ (select-window
+ (display-buffer buffer-name detached-open-session-display-buffer-action))))))
+
+;;;###autoload
+(defun detached-edit-session-annotation (session)
+ "Edit SESSION's annotation."
+ (interactive
+ (list (detached-session-in-context)))
+ (when-let* ((initial-value (or
+ (detached--session-annotation session)
+ ""))
+ (annotation (read-string "Annotation: " initial-value)))
+ (setf (detached--session-annotation session) annotation)
+ (detached--db-update-entry session)))
+
+;;;###autoload
+(defun detached-edit-and-run-session (session &optional toggle-session-mode)
+ "Edit and re-run SESSION at point.
+
+Optionally TOGGLE-SESSION-MODE."
+ (interactive
+ (list (detached-session-in-context)
+ current-prefix-arg))
+ (when session
+ (detached-with-session session
+ (when-let* ((detached-session-command
+ (read-string "Edit command: "
+ (detached-session-command session)))
+ (detached-session-mode
+ (if toggle-session-mode
+ (if (eq 'detached (detached--session-initial-mode session))
+ 'attached
+ 'detached)
+ (detached--session-initial-mode session)))
+ (detached-current-session
+ (detached-create-session detached-session-command)))
+ (detached-start-session detached-current-session)))))
+
+;;;###autoload
+(defun detached-rerun-session (session &optional toggle-session-mode)
+ "Re-run SESSION at point.
+
+Optionally TOGGLE-SESSION-MODE."
+ (interactive
+ (list (detached-session-in-context)
+ current-prefix-arg))
+ (when session
+ (detached-with-session session
+ (let* ((detached-session-mode
+ (if toggle-session-mode
+ (if (eq 'detached (detached--session-initial-mode session))
+ 'attached
+ 'detached)
+ (detached--session-initial-mode session)))
+ (detached-current-session (detached-create-session detached-session-command)))
+ (detached-start-session detached-current-session)))))
+
+;;;###autoload
+(defun detached-describe-session ()
+ "Describe current session."
+ (interactive)
+ (when-let* ((session (detached-session-in-context))
+ (buffer (get-buffer-create "*detached-session-info*"))
+ (window (display-buffer buffer detached-session-info-buffer-action)))
+ (select-window window)
+ (with-current-buffer buffer
+ (erase-buffer)
+ (insert
+ (string-trim
+ (detached--session-header session)))
+ (goto-char (point-min)))))
+
+;;;###autoload
+(defun detached-describe-duration (session)
+ "Describe the SESSION's duration statistics."
+ (interactive
+ (list (detached-session-in-context)))
+ (let* ((statistics (detached-session-duration-statistics session)))
+ (message "%s: %s %s: %s"
+ (propertize "μ" 'face 'detached-mark-face)
+ (if-let ((mean (plist-get statistics :mean)))
+ (detached--duration-str2 (plist-get statistics :mean)) "-")
+ (propertize "σ" 'face 'detached-mark-face)
+ (if-let ((std (plist-get statistics :std)))
+ (detached--duration-str2 std) "-"))))
+
+;;;###autoload
+(defun detached-attach-session (session)
+ "Attach to SESSION."
+ (interactive
+ (list (detached-session-in-context)))
+ (when (and session
+ (detached--valid-dtach-executable-p session))
+ (let ((initialized-session (detached--get-initialized-session session)))
+ (if (detached-session-inactive-p initialized-session)
+ (detached-open-session initialized-session)
+ (funcall (detached-session-attach-function initialized-session)
+ initialized-session)))))
+
+;;;###autoload
+(defun detached-copy-session-output (session)
+ "Copy SESSION's output."
+ (interactive
+ (list (detached-session-in-context)))
+ (when session
+ (with-temp-buffer
+ (insert (detached-session-output session))
+ (when (detached-session-terminal-data-p session)
+ ;; Enable `detached-log-mode' to parse ansi-escape sequences
+ (detached-log-mode))
+ (kill-new (buffer-string)))))
+
+;;;###autoload
+(defun detached-copy-session-command (session)
+ "Copy SESSION's command."
+ (interactive
+ (list (detached-session-in-context)))
+ (kill-new (detached-session-command session)))
+
+;;;###autoload
+(defun detached-insert-session-command (session)
+ "Insert SESSION's command."
+ (interactive
+ (list (detached-completing-read (detached-get-sessions))))
+ (when (detached-valid-session session)
+ (insert (detached-session-command session))))
+
+;;;###autoload
+(defun detached-delete-session (session)
+ "Delete SESSION."
+ (interactive
+ (list (detached-session-in-context)))
+ (when session
+ (if (detached-session-active-p session)
+ (message "Kill session first before removing it.")
+ (detached--db-remove-entry session))))
+
+;;;###autoload
+(defun detached-kill-session (session &optional delete)
+ "Send a TERM signal to SESSION.
+
+Optionally DELETE the session if prefix-argument is provided."
+ (interactive
+ (list (detached-session-in-context)
+ current-prefix-arg))
+ (when (detached-valid-session session)
+ (when-let* ((default-directory (detached-session-directory session)))
+ (if (derived-mode-p 'comint-mode)
+ (call-interactively #'comint-interrupt-subjob)
+ (detached-session-kill session)))
+ (when delete
+ (detached--db-remove-entry session))))
+
+;;;###autoload
+(defun detached-view-session (session)
+ "View the SESSION."
+ (interactive
+ (list (detached-completing-read (detached-get-sessions))))
+ (when (detached-valid-session session)
+ (let* ((buffer-name "*detached-session-output*")
+ (file-path
+ (detached--session-file session 'log))
+ (tramp-verbose 1))
+ (if (file-exists-p file-path)
+ (progn
+ (with-current-buffer (get-buffer-create buffer-name)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (detached-session-output session))
+ (setq-local default-directory (detached-session-working-directory session))
+ (detached-log-mode))
+ (setq detached-buffer-session session)
+ (goto-char (point-max)))
+ (select-window
+ (display-buffer buffer-name detached-open-session-display-buffer-action)))
+ (message "Detached can't find file: %s" file-path)))))
+
+;;;###autoload
+(defun detached-diff-session (session1 session2)
+ "Diff SESSION1 with SESSION2."
+ (interactive
+ (let ((sessions (detached-get-sessions)))
+ `(,(detached-completing-read sessions)
+ ,(detached-completing-read sessions))))
+ (when (and (detached-valid-session session1)
+ (detached-valid-session session2))
+ (let ((buffer1 "*detached-session-output-1*")
+ (buffer2 "*detached-session-output-2*"))
+ (with-current-buffer (get-buffer-create buffer1)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (detached--session-header session1))
+ (insert (detached-session-output session1))
+ (when (detached-session-terminal-data-p session1)
+ ;; Enable `detached-log-mode' to parse ansi-escape sequences
+ (detached-log-mode))))
+ (with-current-buffer (get-buffer-create buffer2)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (detached--session-header session2))
+ (insert (detached-session-output session2))
+ (when (detached-session-terminal-data-p session2)
+ ;; Enable `detached-log-mode' to parse ansi-escape sequences
+ (detached-log-mode))))
+ (ediff-buffers buffer1 buffer2))))
+
+;;;###autoload
+(defun detached-open-session-directory (session)
+ "Open SESSION's log directory."
+ (interactive
+ (list (detached-completing-read (detached-get-sessions))))
+ (let* ((file-path
+ (detached--session-file session 'log))
+ (tramp-verbose 1))
+ (when (file-exists-p file-path)
+ (dired-jump-other-window file-path))))
+
+;;;###autoload
+(defun detached-detach-session ()
+ "Detach from session in current buffer.
+
+This command is only activated if `detached-buffer-session' is an
+active session. For sessions created with `detached-compile' or
+`detached-shell-command', the command will also kill the window."
+ (interactive)
+ (if-let ((has-session (detached-session-p detached-buffer-session)))
+ (detached--detach-session major-mode)
+ (message "No detached-session found in buffer.")))
+
+;;;###autoload
+(defun detached-delete-sessions (&optional all-hosts)
+ "Delete `detached' sessions which belong to the current host, unless ALL-HOSTS."
+ (interactive "P")
+ (let* ((host-name (car (detached--host)))
+ (sessions (if all-hosts
+ (detached-get-sessions)
+ (seq-filter (lambda (it)
+ (string= (detached-session-host-name it) host-name))
+ (detached-get-sessions)))))
+ (seq-do #'detached--db-remove-entry sessions)))
+
+;;;; Functions
+
+;;;;; Session
+
+(defun detached-create-session (command)
+ "Create a `detached' session from COMMAND."
+ (detached-connection-local-variables
+ (detached--create-session-directory)
+ (let ((session
+ (detached--session-create :id (intern (detached--create-id command))
+ :command command
+ :origin detached-session-origin
+ :action detached-session-action
+ :working-directory (detached--get-working-directory)
+ :degraded (detached-degraded-command-p command)
+ :initial-mode detached-session-mode
+ :time `(:start 0.0 :end 0.0 :duration 0.0 :offset 0.0)
+ :status '(unknown . 0)
+ :annotation detached-session-annotation
+ :local detached-local-session
+ :size 0
+ :directory (detached--get-session-directory)
+ :text-mode (detached--text-mode command)
+ :env detached-session-environment
+ :host (detached--host)
+ :metadata (detached-metadata)
+ :state 'unknown
+ :initialized-emacsen `(,(emacs-pid)))))
+ (detached--db-insert-entry session)
+ session)))
+
+(defun detached--start-session-process (session start-command)
+ "Start SESSION with START-COMMAND."
+ (detached-watch-session session)
+ (if (detached--session-local-p session)
+ (apply #'start-process-shell-command `("detached" nil ,start-command))
+ (apply #'start-file-process-shell-command `("detached" nil ,start-command))))
+
+(defun detached-session-candidates (sessions)
+ "Return an alist of SESSIONS candidates."
+ (when sessions
+ (setq detached--annotation-widths
+ (detached--annotation-widths sessions detached-annotation-format))
+ (let ((command-length
+ (thread-last sessions
+ (seq-map #'detached-session-command)
+ (seq-map #'length)
+ (seq-max)
+ (min (plist-get detached-command-format :width)))))
+ (let ((command-fun (plist-get detached-command-format :function)))
+ (setq detached--session-candidates
+ (thread-last sessions
+ (seq-map (lambda (it)
+ `(,(apply command-fun `(,it ,command-length))
+ . ,it)))
+ (detached--session-deduplicate)
+ (seq-map (lambda (it)
+ `(,(concat (car it)
+ (make-string (plist-get detached-command-format :padding) ?\s))
+ . ,(cdr it))))))))))
+
+(defun detached-session-annotation (item)
+ "Associate ITEM to a session and return ts annotation."
+ (let ((session (cdr (assoc item detached--session-candidates))))
+ (string-join
+ (cl-loop for annotation in detached-annotation-format
+ collect (let ((str (funcall (plist-get annotation :function) session))
+ (width (alist-get (plist-get annotation :function) detached--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 detached-initialize-sessions ()
+ "Initialize `detached' sessions from the database."
+
+ ;; Initialize sessions
+ (unless detached--sessions-initialized
+ (unless (file-exists-p detached-db-directory)
+ (make-directory detached-db-directory t))
+ (detached--db-initialize)
+ (detached--register-detached-emacs)
+ (setq detached--db-watch
+ (file-notify-add-watch detached-db-directory
+ '(change attribute-change)
+ #'detached--db-directory-event))
+
+ (setq detached--sessions-initialized t)
+
+ ;; Hash sessions and set the status for all sessions to uninitialized
+ (setq detached--hashed-sessions
+ (let* ((sessions (detached--db-get-sessions))
+ (ht (make-hash-table :test #'equal :size (length sessions))))
+ (seq-do (lambda (session)
+ (puthash (detached-session-id session) 'uninitialized ht))
+ sessions)
+ ht))
+
+ ;; Initialize accessible sessions
+ (let ((detached--current-emacsen (detached--active-detached-emacsen)))
+ (detached--update-detached-emacsen)
+ (let ((detached--update-database nil))
+ (thread-last (detached--db-get-sessions)
+ (seq-filter #'detached--session-accessible-p)
+ (seq-do #'detached--initialize-session)))
+ (detached--db-update-sessions))))
+
+(defun detached-valid-session (session)
+ "Ensure that SESSION is valid.
+
+If session is not valid trigger an automatic cleanup on SESSION's host."
+ (when (detached-session-p session)
+ (if (not (detached--session-missing-p session))
+ t
+ (let ((hostname (detached-session-host-name session)))
+ (message "Session does not exist. Initiate session cleanup on host %s" hostname)
+ (detached--cleanup-host-sessions hostname)
+ nil))))
+
+(defun detached-session-exit-code-status (session)
+ "Return status based on exit-code in SESSION."
+ (let ((detached-env-message
+ (with-temp-buffer
+ (insert-file-contents (detached--session-file session 'log))
+ (goto-char (point-max))
+ (thing-at-point 'line t)))
+ (failure-message (rx "detached-exit-code: " (group (one-or-more digit)))))
+ (cond ((null detached-env-message) `(success . 0))
+ ((string-match failure-message detached-env-message)
+ `(failure . ,(string-to-number (match-string 1 detached-env-message))))
+ (t `(success . 0)))))
+
+(defun detached-state-transitionion-echo-message (session)
+ "Issue a notification when SESSION transitions from active to inactive.
+This function uses the echo area."
+ (let ((status (pcase (detached-session-status session)
+ ('success "Detached finished")
+ ('failure "Detached failed"))))
+ (message "%s [%s]: %s" status (detached-session-host-name session) (detached-session-command session))))
+
+(defun detached-state-transition-notifications-message (session)
+ "Issue a notification when SESSION transitions from active to inactive.
+This function uses the `notifications' library."
+ (let ((status (detached-session-status session))
+ (host (detached-session-host-name session)))
+ (notifications-notify
+ :title (pcase status
+ ('success (format "Detached finished [%s]" host))
+ ('failure (format "Detached failed [%s]" host)))
+ :body (detached-session-command session)
+ :urgency (pcase status
+ ('success 'normal)
+ ('failure 'critical)))))
+
+(defun detached-view-dwim (session)
+ "View SESSION in a do what I mean fashion."
+ (let ((status (detached-session-status session)))
+ (cond ((eq 'success status)
+ (detached-view-session session))
+ ((eq 'failure status)
+ (detached-compile-session session))
+ ((eq 'unknown status)
+ (detached-view-session session))
+ (t (message "Detached session is in an unexpected state.")))))
+
+(defun detached-get-sessions ()
+ "Return as initialized sessions as possible."
+ ;; Try to initialize unknown sessions
+ (when-let* ((detached--update-database nil)
+ (initialized-sessions
+ (thread-last (detached--uninitialized-sessions)
+ (seq-filter #'detached--session-accessible-p)
+ (seq-do #'detached--initialize-session))))
+ (detached--db-update-sessions))
+ (detached--db-get-sessions))
+
+(defun detached-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 (detached-select-host-session)))
+ (when (detached-valid-session session)
+ (if (detached-session-active-p session)
+ (cl-letf ((detached-current-session session)
+ (comint-input-sender #'detached-shell--attach-input-sender)
+ ((symbol-function 'comint-add-to-input-history) (lambda (_) t)))
+ (setq detached-buffer-session session)
+ (let ((kill-ring nil))
+ (comint-kill-input))
+ (insert "[attached]")
+ (comint-send-input))
+ (detached-open-session session))))
+
+(defun detached-shell-command-attach-session (session)
+ "Attach to SESSION with `async-shell-command'."
+ (let* ((inhibit-message t))
+ (detached-with-session session
+ (cl-letf* (((symbol-function #'set-process-sentinel) #'ignore)
+ (detached-session-mode 'attached)
+ (buffer (get-buffer-create detached--shell-command-buffer))
+ (default-directory (detached-session-directory session))
+ (command (detached-session-attach-command session :type 'string)))
+ (when (get-buffer-process buffer)
+ (setq buffer (generate-new-buffer (buffer-name buffer))))
+ (funcall #'async-shell-command command buffer)
+ (with-current-buffer buffer
+ (setq-local default-directory (detached-session-working-directory session))
+ (setq detached-buffer-session detached-current-session))))))
+
+(defun detached-start-shell-command-session (session)
+ "Start SESSION as a `shell-command'."
+ (cl-letf* ((inhibit-message t)
+ (default-directory (if (detached--session-local-p session)
+ (detached-session-directory session)
+ (detached-session-working-directory session)))
+ ((symbol-function #'set-process-sentinel) #'ignore)
+ (buffer (detached--generate-buffer detached--shell-command-buffer
+ (lambda (buffer)
+ (not (get-buffer-process buffer)))))
+ (command (detached-session-start-command session
+ :type 'string)))
+ (detached-watch-session session)
+ (funcall #'async-shell-command command buffer)
+ (with-current-buffer buffer
+ (setq detached-buffer-session session))))
+
+(defun detached-start-session (session)
+ "Start SESSION."
+ (when (detached--valid-dtach-executable-p session)
+ (if (eq 'detached (detached--session-initial-mode session))
+ (detached--start-session-process session
+ (detached-session-start-command
+ session
+ :type 'string))
+ (detached-with-session session
+ (funcall (detached-session-run-function session) session)))))
+
+(defun detached-watch-session (session)
+ "Start to watch SESSION.
+
+If there is no file-notify watch on SESSION's directory it should be
+added. This watch will ensure that when a socket is created the
+session is set to active and when the socket is deleted it is set to
+inactive. However there could be situations where the watch creation
+is delayed and takes place after the socket appears. This is most
+likely to happen on remote hosts. If so we fallback to a timer for
+session validation."
+ (detached--create-session-validator session)
+ (detached--watch-session-directory (detached-session-directory session)))
+
+;;;;; Public session functions
+
+(cl-defun detached-session-start-command (session &key type)
+ "Return command to start SESSION with specified TYPE."
+ (when (detached--valid-dtach-executable-p session)
+ (detached-watch-session session)
+ (detached-connection-local-variables
+ (let* ((socket (detached--session-file session 'socket t))
+ (detached-session-mode (detached--session-initial-mode session))
+ (log (detached--session-file session 'log t))
+ (dtach-arg (if (eq 'detached (detached--session-initial-mode session))
+ "-n"
+ "-c"))
+ (dtach-command-fun (lambda (session)
+ (let ((detached-session-mode (detached--session-initial-mode session)))
+ `(,detached-dtach-program
+ ,dtach-arg
+ ,socket
+ "-z"
+ ,detached-shell-program
+ "-c"
+ ,(if (eq type 'string)
+ (shell-quote-argument (detached--detached-command session))
+ (detached--detached-command session))))))
+ (command
+ (if (eq 'detached (detached--session-initial-mode session))
+ (funcall dtach-command-fun session)
+ (if (not (detached-session-degraded-p session))
+ (funcall dtach-command-fun session)
+ (detached--start-session-process session
+ (string-join
+ (funcall dtach-command-fun session) " "))
+ `(,detached-tail-program
+ "-F"
+ "-n"
+ ,(number-to-string detached-session-context-lines)
+ ,log)))))
+ (pcase type
+ ('string (string-join command " "))
+ ('list command)
+ (_ nil))))))
+
+(cl-defun detached-session-attach-command (session &key type)
+ "Return command to attach SESSION with specified TYPE."
+ (when (detached--valid-dtach-executable-p session)
+ (detached-connection-local-variables
+ (let* ((socket (detached--session-file session 'socket t))
+ (log (detached--session-file session 'log t))
+ (command
+ (if (detached-session-degraded-p session)
+ `(,detached-tail-program "-F"
+ "-n"
+ ,(number-to-string detached-session-context-lines)
+ ,log)
+ (append
+ (when detached-show-session-context
+ `(,detached-tail-program "-n"
+ ,(number-to-string detached-session-context-lines)
+ ,(concat log ";")))
+ `(,detached-dtach-program "-a"
+ ,socket
+ "-r" "none")))))
+ (pcase type
+ ('string (string-join command " "))
+ ('list command)
+ (_ nil))))))
+
+
+(defun detached-session-kill (session)
+ "Kill SESSION."
+ (interactive
+ (list (detached-session-in-context)))
+ (when session
+ (if (detached-session-active-p session)
+ (cl-letf* (((getenv "HISTFILE") "")
+ (default-directory (detached-session-directory session))
+ (buffer (get-buffer-create (format "*dtach-%s*" (detached-session-id session))))
+ (termination-delay 0.5)
+ (comint-exec-hook
+ `(,(lambda ()
+ (when-let ((process (get-buffer-process (current-buffer))))
+ (run-with-timer termination-delay nil
+ (lambda ()
+ ;; Attach to session
+ (with-current-buffer buffer
+ (let ((detached-show-session-context nil))
+ (when detached-debug-enabled
+ (message "Kill function attaching to session %s" (detached-session-id session)))
+ (detached-shell-attach-session session))
+ (run-with-timer termination-delay nil
+ (lambda ()
+ ;; Send termination signal to session
+ (when detached-debug-enabled
+ (message "Kill function sending termination signal to session %s" (detached-session-id session)))
+ (with-current-buffer buffer
+ (call-interactively #'comint-interrupt-subjob)
+ (let ((kill-buffer-query-functions nil))
+ (kill-buffer)))))))))))))
+ (apply #'make-comint-in-buffer `("dtach" ,buffer ,detached-shell-program nil)))
+ (message "Session %s is already inactive." (detached-session-id session)))))
+
+(defun detached-session-output (session)
+ "Return content of SESSION's output."
+ (let* ((filename (detached--session-file session 'log))
+ (detached-message
+ (rx (regexp "\\[detached-exit-code: .*\\]"))))
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (detached--maybe-watch-session session)
+ (goto-char (point-max))
+ (forward-line -1)
+ (let ((beginning (point-min))
+ (end (if (string-match detached-message (thing-at-point 'line t))
+ (and (forward-line -1) (point))
+ (point-max))))
+ (buffer-substring beginning end)))))
+
+(defun detached-session-state (session)
+ "Return SESSION's state."
+ (detached--session-state session))
+
+(defun detached-session-status (session)
+ "Return status for SESSION."
+ (pcase-let ((`(,status . ,_exit-code)
+ (detached--session-status session)))
+ status))
+
+(defun detached-session-host-name (session)
+ "Return SESSION's host name."
+ (pcase-let ((`(,name . ,_type)
+ (detached--session-host session)))
+ name))
+
+(defun detached-session-start-time (session)
+ "Return SESSION's start time."
+ (plist-get (detached--session-time session) :start))
+
+(defun detached-session-end-time (session)
+ "Return SESSION's end time."
+ (plist-get (detached--session-time session) :end))
+
+(defun detached-session-duration (session)
+ "Return SESSION's duration."
+ (if (detached-session-inactive-p session)
+ (plist-get
+ (detached--session-time session) :duration)
+ (- (time-to-seconds) (detached-session-start-time session))))
+
+(defun detached-session-host-type (session)
+ "Return the type of SESSION's host."
+ (pcase-let ((`(,_name . ,type)
+ (detached--session-host session)))
+ type))
+
+(defun detached-session-exit-code (session)
+ "Return exit code for SESSION."
+ (pcase-let ((`(,_status . ,exit-code)
+ (detached--session-status session)))
+ exit-code))
+
+(defun detached-session-id (session)
+ "Return SESSION's id."
+ (detached--session-id session))
+
+(defun detached-session-identifier (session)
+ "Return SESSION's identifier string."
+ (string-join
+ `(,(detached-session-command session)
+ ,(detached--host-str session)
+ ,(detached-session-working-directory session))
+ ", "))
+
+(defun detached-session-view-function (session)
+ "Return SESSION's view function."
+ (or
+ (plist-get (detached--session-action session) :view)
+ #'detached-view-dwim))
+
+(defun detached-session-attach-function (session)
+ "Return SESSION's attach function."
+ (or
+ (plist-get (detached--session-action session) :attach)
+ #'detached-shell-command-attach-session))
+
+(defun detached-session-run-function (session)
+ "Return SESSION's run function."
+ (or
+ (plist-get (detached--session-action session) :run)
+ #'detached-start-shell-command-session))
+
+(defun detached-session-callback-function (session)
+ "Return SESSION's callback function."
+ (or
+ (plist-get (detached--session-action session) :callback)
+ #'ignore))
+
+(defun detached-session-environment-property (session property)
+ "Return PROPERTY from SESSION environment."
+ (plist-get (detached--session-env session) property))
+
+(defun detached-session-status-function (session)
+ "Return SESSION's status function."
+ (or
+ (plist-get (detached--session-action session) :status)
+ #'detached-session-exit-code-status))
+
+(defun detached-session-command (session)
+ "Return command run in SESSION."
+ (detached--session-command session))
+
+(defun detached-session-directory (session)
+ "Return directory where SESSION files are located."
+ (detached--session-directory session))
+
+(defun detached-session-working-directory (session)
+ "Return SESSION's working directory."
+ (detached--session-working-directory session))
+
+(defun detached-session-in-context ()
+ "Return session from current context."
+ (let ((session
+ (or (detached--session-in-context major-mode)
+ (detached-completing-read (detached-get-sessions)))))
+ (when (detached-session-p session)
+ session)))
+
+(defun detached-session-duration-statistics (session)
+ "Return duration statistics for SESSION."
+ (when-let* ((identifier (detached-session-identifier session))
+ (sessions (thread-last (detached-get-sessions)
+ (seq-filter (lambda (it)
+ (string= identifier (detached-session-identifier it))))
+ (seq-remove #'detached-session-failed-p)
+ (seq-filter #'detached-session-inactive-p))))
+ (detached--get-duration-statistics sessions)))
+
+(defun detached-session-validated-p (session)
+ "Return t if SESSION has been validated."
+ (not
+ (member (detached-session-id session)
+ detached--unvalidated-session-ids)))
+
+(defun detached-session-failed-p (session)
+ "Return t if SESSION failed."
+ (eq 'failure (detached-session-status session)))
+
+(defun detached-session-remotehost-p (session)
+ "Return t if SESSION is running on a remote host."
+ (eq 'remotehost (detached-session-host-type session)))
+
+(defun detached-session-localhost-p (session)
+ "Return t if SESSION is running on the local host."
+ (eq 'localhost (detached-session-host-type session)))
+
+(defun detached-session-started-p (session)
+ "Return t if SESSION has been started."
+ (not (eq 'unknown (detached-session-state session))))
+
+(defun detached-session-active-p (session)
+ "Return t if SESSION is active."
+ (eq 'active (detached-session-state session)))
+
+(defun detached-session-inactive-p (session)
+ "Return t if SESSION is inactive."
+ (eq 'inactive (detached-session-state session)))
+
+(defun detached-session-degraded-p (session)
+ "Return t if SESSION is degraded."
+ (detached--session-degraded session))
+
+(defun detached-session-uninitialized-p (session)
+ "Return t if SESSION is uninitialized."
+ (eq 'uninitialized
+ (gethash (detached-session-id session) detached--hashed-sessions)))
+
+(defun detached-session-initialized-p (session)
+ "Return t if SESSION is initialized."
+ (eq 'initialized
+ (gethash (detached-session-id session) detached--hashed-sessions)))
+
+(defun detached-session-terminal-data-p (session)
+ "Return t if SESSION is run with text mode set to terminal data."
+ (eq 'terminal-data
+ (detached--session-text-mode session)))
+
+(defun detached-session-watched-p (session)
+ "Return t if SESSION is being watched."
+ (detached--watched-session-directory-p
+ (detached-session-directory session)))
+
+;;;;; Other
+
+(defun detached-degraded-command-p (command)
+ "Return t if COMMAND is degraded."
+ (>
+ (thread-last detached-degraded-commands
+ (seq-filter (lambda (regexp)
+ (string-match-p regexp command)))
+ (length))
+ 0))
+
+(defun detached-metadata ()
+ "Return a property list with metadata."
+ (let ((metadata '()))
+ (seq-doseq (annotator detached-metadata-annotators-alist)
+ (push `(,(car annotator) . ,(funcall (cdr annotator))) metadata))
+ metadata))
+
+(defun detached-select-host-session ()
+ "Return selected session."
+ (let* ((host-name (car (detached--host)))
+ (sessions
+ (thread-last (detached-get-sessions)
+ (seq-filter (lambda (it)
+ (string= (detached-session-host-name it) host-name)))
+ (seq-filter #'detached-session-active-p))))
+ (detached-completing-read sessions)))
+
+(defun detached-completing-read (sessions)
+ "Select a session from SESSIONS through `completing-read'."
+ (let* ((candidates (detached-session-candidates sessions))
+ (metadata `(metadata
+ (category . detached)
+ (cycle-sort-function . identity)
+ (display-sort-function . identity)
+ (annotation-function . detached-session-annotation)
+ (affixation-function .
+ ,(lambda (cands)
+ (seq-map (lambda (s)
+ `(,s nil ,(detached-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)))
+ (detached--decode-session cand)))
+
+(defun detached-command-str (session max-length)
+ "Return SESSION's command as a string restrict it to MAX-LENGTH."
+ (let ((command (detached-session-command session)))
+ (if (<= (length command) max-length)
+ (truncate-string-to-width
+ command
+ max-length
+ 0 ?\s)
+ (concat (substring (detached-session-command session) 0 (- max-length 3)) "..."))))
+
+;;;; Support functions
+
+;;;;; Session
+
+(defun detached--determine-session-state (session)
+ "Return t if SESSION is active."
+ (if (file-exists-p
+ (detached--session-file session 'socket))
+ 'active
+ 'inactive))
+
+
+(defun detached--valid-dtach-executable-p (session)
+ "Verify that dtach executable is accessible for SESSION."
+ (let ((default-directory (detached-session-directory session)))
+ (detached-connection-local-variables
+ (if (executable-find detached-dtach-program t)
+ t
+ (error "The `detached-dtach-program' doesn't contain a path to a dtach executable")))))
+
+(defun detached--state-transition-p (session)
+ "Return t if SESSION has transitioned from active to inactive."
+ (and
+ (eq 'active (detached--session-state session))
+ (eq 'inactive (detached--determine-session-state session))))
+
+(defun detached--session-accessible-p (session)
+ "Return t if SESSION is accessible."
+ (or (detached-session-localhost-p session)
+ (file-remote-p (detached-session-directory session) nil t)))
+
+(defun detached--watched-session-directory-p (directory)
+ "Return t if DIRECTORY is being watched."
+ (alist-get directory
+ detached--watched-session-directories
+ nil nil #'string=))
+
+(defun detached--session-local-p (session)
+ "Return t if SESSION is forced to run locally."
+ (detached--session-local session))
+
+(defun detached--session-missing-p (session)
+ "Return t if SESSION is missing."
+ (not
+ (file-exists-p
+ (detached--session-file session 'log))))
+
+(defun detached--session-header (session)
+ "Return header for SESSION."
+ (string-join
+ `(,(format "Command: %s" (detached-session-command session))
+ ,(format "Working directory: %s" (detached--working-dir-str session))
+ ,(format "Host: %s" (detached-session-host-name session))
+ ,(format "Id: %s" (symbol-name (detached-session-id session)))
+ ,(format "Status: %s" (detached-session-status session))
+ ,(format "Annotation: %s" (if-let ((annotation (detached--session-annotation session))) annotation ""))
+ ,(format "Exit-code: %s" (detached-session-exit-code session))
+ ,(format "Metadata: %s" (detached--metadata-str session))
+ ,(format "Created at: %s" (detached--creation-str session))
+ ,(format "Duration: %s\n" (detached--duration-str session))
+ "")
+ "\n"))
+
+(defun detached--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 'detached-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 detached--decode-session (item)
+ "Return the session associated with ITEM."
+ (cdr (assoc item detached--session-candidates)))
+
+(defun detached--create-session-validator (session)
+ "Create a function to validate SESSION.
+
+It can take some time for a dtach socket to be created. Therefore all
+sessions are created with state unknown. This function creates a
+function to verify that a session was created correctly. If the
+session is missing its deleted from the database."
+ (let ((session-id (detached-session-id session))
+ (start-time
+ `(:start ,(time-to-seconds (current-time)) :end 0.0 :duration 0.0 :offset 0.0)))
+ (push session-id detached--unvalidated-session-ids)
+ (run-with-timer detached-dtach-socket-creation-delay
+ nil
+ (lambda ()
+ (when (member session-id detached--unvalidated-session-ids)
+ (when detached-debug-enabled
+ (message "Session %s is set to active by validator" session-id))
+ (let ((session (detached--db-get-session session-id)))
+ (setq detached--unvalidated-session-ids
+ (delete session-id detached--unvalidated-session-ids))
+ (setf (detached--session-state session) 'active)
+ (setf (detached--session-time session) start-time)
+ (detached--db-update-entry session)))))))
+
+(defun detached--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
+ (detached-session-id session))
+ (pcase file
+ ('socket ".socket")
+ ('log ".log"))))
+ (remote-local-path (file-remote-p (expand-file-name file-name (detached-session-directory session)) 'localname))
+ (full-path (expand-file-name file-name (detached-session-directory session))))
+ (if (and local remote-local-path)
+ remote-local-path
+ full-path)))
+
+(defun detached--cleanup-host-sessions (hostname)
+ "Run cleanup on HOSTNAME sessions."
+ (thread-last (detached--db-get-sessions)
+ (seq-filter (lambda (it) (string= hostname (detached-session-host-name it))))
+ (seq-filter #'detached--session-missing-p)
+ (seq-do #'detached--db-remove-entry)))
+
+(defun detached--maybe-watch-session (session)
+ "Maybe watch SESSION."
+ (and (detached-session-active-p session)
+ (not (detached-session-watched-p session))
+ (detached--watch-session-directory
+ (detached-session-directory session))))
+
+(defun detached--create-session-directory ()
+ "Create session directory if it doesn't exist."
+ (let ((directory (detached--get-session-directory)))
+ (unless (file-exists-p directory)
+ (make-directory directory t))))
+
+(defun detached--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)))
+
+(defun detached--get-session-directory ()
+ "Return the session directory."
+ (if detached-local-session
+ detached-session-directory
+ (concat (file-remote-p default-directory) detached-session-directory)))
+
+(cl-defgeneric detached--session-in-context (_mode)
+ "Default implementation."
+ detached-buffer-session)
+
+(cl-defgeneric detached--detach-session (_mode)
+ "Default implementation."
+ (message "`detached' doesn't know how to detach from a session in this mode"))
+
+(cl-defmethod detached--detach-session ((_mode (derived-mode detached-log-mode)))
+ "Detach from session when MODE is `detached-log-mode'."
+ (detached--quit-session-buffer))
+
+(cl-defmethod detached--detach-session ((_mode (derived-mode shell-mode)))
+ "Detach from session when MODE is `shell-mode'."
+ (if (detached-session-degraded-p detached-buffer-session)
+ (comint-interrupt-subjob)
+ (detached--detach-from-comint-process))
+ (when (string-match detached--shell-command-buffer (buffer-name))
+ (detached--quit-session-buffer)))
+
+(cl-defmethod detached--detach-session ((_mode (derived-mode comint-mode)))
+ "Detach from session when MODE is `comint-mode'."
+ (detached--detach-from-comint-process)
+ (detached--quit-session-buffer))
+
+(defun detached--detach-from-comint-process ()
+ "Detach from the underlying `comint' process."
+ (when-let ((active-session (detached-session-active-p
+ (alist-get (detached-session-id detached-buffer-session)
+ detached--sessions)))
+ (dtach-process (get-buffer-process (current-buffer))))
+ (comint-simple-send dtach-process detached--dtach-detach-character)
+ (setq detached-buffer-session nil)))
+
+(defun detached--quit-session-buffer ()
+ "Quit session buffer."
+ (message "[detached]")
+ (let ((kill-buffer-query-functions nil))
+ (if (= (length (window-list)) 1)
+ (kill-buffer)
+ (kill-buffer-and-window))))
+
+(defun detached--get-duration-statistics (sessions)
+ "Return a plist of duration statistics for SESSIONS."
+ (let* ((durations (seq-map #'detached-session-duration sessions))
+ (mean (/ (seq-reduce #'+ durations 0) (seq-length durations)))
+ (std (sqrt (/ (seq-reduce (lambda (sum duration)
+ (+ sum (* (- duration mean)
+ (- duration mean))))
+ durations
+ 0.0)
+ (seq-length durations)))))
+ `(:durations ,durations :mean ,mean :std ,std)))
+
+(defun detached-shell--attach-input-sender (proc _string)
+ "Attach to `detached--session' and send the attach command to PROC."
+ (let* ((input
+ (detached-session-attach-command detached-current-session
+ :type 'string)))
+ (comint-simple-send proc input)))
+
+;;;;; Database
+
+(defun detached--db-initialize ()
+ "Return all sessions stored in database."
+ (let ((db (expand-file-name "detached-sessions.db" detached-db-directory)))
+ (when (file-exists-p db)
+ (with-temp-buffer
+ (insert-file-contents db)
+ (cl-assert (bobp))
+ (if (detached--verify-db-compatibility)
+ (setq detached--sessions
+ (read (current-buffer)))
+ (warn "Detached database has version %s while minimum version is %s"
+ (detached--db-session-version) detached-minimum-session-version))))))
+
+(defun detached--db-session-version ()
+ "Return `detached-session-version' from database."
+ (let ((header (thing-at-point 'line))
+ (regexp (rx "Detached Session Version: " (group (one-or-more (or digit punct))))))
+ (string-match regexp header)
+ (match-string 1 header)))
+
+(defun detached--db-insert-entry (session)
+ "Insert SESSION into `detached--sessions' and update database."
+ (push `(,(detached-session-id session) . ,session) detached--sessions)
+ (when detached--update-database
+ (detached--db-update-sessions)))
+
+(defun detached--db-remove-entry (session)
+ "Remove SESSION from `detached--sessions', delete log and update database."
+ (let ((log (detached--session-file session 'log)))
+ (when (file-exists-p log)
+ (delete-file log)))
+ (setq detached--sessions
+ (assq-delete-all (detached-session-id session) detached--sessions))
+ (when detached--update-database
+ (detached--db-update-sessions)))
+
+(defun detached--db-update-entry (session)
+ "Update SESSION in `detached--sessions' and the database."
+ (setf (alist-get (detached--session-id session) detached--sessions) session)
+ (when detached--update-database
+ (detached--db-update-sessions)))
+
+(defun detached--db-get-session (id)
+ "Return session with ID."
+ (alist-get id detached--sessions))
+
+(defun detached--db-get-sessions ()
+ "Return all sessions stored in the database."
+ (seq-map #'cdr detached--sessions))
+
+(defun detached--db-update-sessions ()
+ "Write `detached--sessions' to database."
+ (run-hooks 'detached-update-db-hooks)
+ (let ((db (expand-file-name "detached-sessions.db" detached-db-directory)))
+ (with-temp-file db
+ (insert (format ";; Detached Session Version: %s\n\n" detached-session-version))
+ (prin1 detached--sessions (current-buffer)))))
+
+(defun detached--read-detached-emacsen ()
+ "Read the PIDs of detached Emacsen."
+ (let ((file (expand-file-name "detached-emacsen" detached-db-directory)))
+ (when (file-exists-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (cl-assert (bobp))
+ (read (current-buffer))))))
+
+(defun detached--register-detached-emacs ()
+ "Register the Emacs process."
+ (let* ((file (expand-file-name "detached-emacsen" detached-db-directory))
+ (emacs-process (process-attributes (emacs-pid)))
+ (emacsen (detached--read-detached-emacsen)))
+ (setf (alist-get (emacs-pid) emacsen) emacs-process)
+ (with-temp-file file
+ (insert (format ";; Detached Emacsen\n\n"))
+ (prin1 emacsen (current-buffer)))))
+
+(defun detached--primary-detached-emacs-p (session)
+ "Return t if current Emacs is primary Emacs for SESSION."
+ (let ((emacsen (detached--read-detached-emacsen))
+ (initialized-emacsen (detached--session-initialized-emacsen
+ session)))
+ (thread-last initialized-emacsen
+ (seq-find (lambda (pid)
+ (when-let ((emacs-process (alist-get pid emacsen))
+ (process-attrs (process-attributes pid)))
+ (and
+ ;; Make sure the args are the same
+ (string= (alist-get 'args emacs-process)
+ (alist-get 'args process-attrs))
+ ;; Make sure process id of the parent is the same
+ (= (alist-get 'ppid emacs-process)
+ (alist-get 'ppid process-attrs))
+ ;; Make sure current Emacs is the right Emacs
+ (= pid (emacs-pid)))))))))
+
+(defun detached--update-detached-emacsen ()
+ "Update list of detached Emacsen."
+ (with-temp-file (expand-file-name "detached-emacsen" detached-db-directory)
+ (insert (format ";; Detached Emacsen\n\n"))
+ (prin1 detached--current-emacsen (current-buffer))))
+
+(defun detached--active-detached-emacsen ()
+ "Return a list of active detached Emacsen."
+ (thread-last (detached--read-detached-emacsen)
+ (seq-filter (lambda (emacs-process)
+ (when-let ((process-attrs (process-attributes (car emacs-process))))
+ (and
+ ;; Make sure the args are the same
+ (string= (alist-get 'args (cdr emacs-process))
+ (alist-get 'args process-attrs))
+ ;; Make sure process id of the parent is the same
+ (= (alist-get 'ppid (cdr emacs-process))
+ (alist-get 'ppid process-attrs))))))))
+
+(defun detached--get-initialized-session (session)
+ "Return an initialized copy of SESSION."
+ (if (detached-session-uninitialized-p session)
+ (progn
+ (detached--initialize-session session)
+ (detached--db-update-sessions)
+ (detached--db-get-session (detached-session-id session)))
+ session))
+
+(defun detached--verify-db-compatibility ()
+ "Verify that the database version is compatible with the package."
+ (let ((minimum-version
+ (detached--decode-version-string detached-minimum-session-version))
+ (db-version
+ (detached--decode-version-string (detached--db-session-version))))
+ (if (> (plist-get db-version :major) (plist-get minimum-version :major))
+ t
+ (when (= (plist-get db-version :major) (plist-get minimum-version :major))
+ (if (> (plist-get db-version :minor) (plist-get minimum-version :minor))
+ t
+ (when (= (plist-get db-version :minor) (plist-get minimum-version :minor))
+ (if (> (plist-get db-version :patch) (plist-get minimum-version :patch))
+ t
+ (when (= (plist-get db-version :patch) (plist-get minimum-version :patch))
+ (>= (plist-get db-version :revision) (plist-get minimum-version :revision))))))))))
+
+;;;;; Other
+
+(defun detached--decode-version-string (version)
+ "Return a decode property list of VERSION."
+ (let ((version-regexp
+ (rx (group (one-or-more digit)) "."
+ (group (one-or-more digit)) "."
+ (group (one-or-more digit)) "."
+ (group (one-or-more digit)))))
+ (when (string-match version-regexp version)
+ `(:major ,(string-to-number (match-string 1 version))
+ :minor ,(string-to-number (match-string 2 version))
+ :patch ,(string-to-number (match-string 3 version))
+ :revision ,(string-to-number (match-string 4 version))))))
+
+(defun detached--dtach-arg ()
+ "Return dtach argument based on `detached-session-mode'."
+ (pcase detached-session-mode
+ ('detached "-n")
+ ('attached "-c")
+ ('attach "-a")
+ (_ (error "`detached-session-mode' has an unknown value"))))
+
+(defun detached--session-state-transition-update (session &optional approximate)
+ "Update SESSION due to state transition.
+
+Optionally specify if the end-time should be APPROXIMATE or not."
+ (let ((session-size (file-attribute-size
+ (file-attributes
+ (detached--session-file session 'log))))
+ (session-time (detached--update-session-time session approximate))
+ (status-fun (detached-session-status-function session)))
+ (setf (detached--session-size session) session-size)
+ (setf (detached--session-time session) session-time)
+ (setf (detached--session-state session) 'inactive)
+ (setf (detached--session-status session) (funcall status-fun session)))
+
+ ;; Send notification
+ (funcall detached-notification-function session)
+
+ ;; Update session in database
+ (detached--db-update-entry session)
+
+ ;; Execute callback
+ (funcall (detached-session-callback-function session)
+ session))
+
+(defun detached--detached-command (session)
+ "Return the detached command for SESSION.
+
+If SESSION is degraded fallback to a command that doesn't rely on tee."
+ (let* ((log (detached--session-file session 'log t))
+ (begin-shell-group (if (string= "fish" (file-name-nondirectory detached-shell-program))
+ "begin;"
+ "{"))
+ (end-shell-group (if (or (string= "fish" (file-name-nondirectory detached-shell-program)))
+ "end"
+ "}"))
+ (redirect
+ (if (detached--session-degraded session)
+ (format "&> %s" log)
+ (format "2>&1 | %s %s" detached-tee-program log)))
+ (shell (format "%s -c" detached-shell-program))
+ (command
+ (shell-quote-argument
+ (format "if %s; then true; else echo \"[detached-exit-code: $?]\"; fi"
+ (if (and (detached-session-terminal-data-p session)
+ detached-terminal-data-command)
+ (format "TERM=eterm-color %s"
+ (format
+ (detached--get-terminal-data-command)
+ (detached-session-command session)))
+ (detached-session-command session))))))
+ (format "%s %s %s; %s %s" begin-shell-group shell command end-shell-group redirect)))
+
+(defun detached--get-terminal-data-command ()
+ "Return terminal data command."
+ (pcase detached-terminal-data-command
+ ('gnu/linux (concat detached-script-program " --quiet --flush --return --command \"%s\" /dev/null"))
+ ('darwin (concat detached-script-program " -F -q /dev/null %s"))
+ ((and (pred stringp) command) command)
+ (_ (error "Unable to determine script command, set `detached-terminal-data-command' properly"))))
+
+(defun detached--text-mode (command)
+ "Return the text mode to run in COMMAND in."
+ (if (seq-find (lambda (regexp)
+ (string-match-p regexp command))
+ detached-plain-text-commands)
+ 'plain-text
+ 'terminal-data))
+
+(defun detached--host ()
+ "Return a cons with (host . type)."
+ (let ((remote
+ (and (file-remote-p default-directory)
+ (not detached-local-session))))
+ `(,(if remote (file-remote-p default-directory 'host) (system-name)) . ,(if remote 'remotehost 'localhost))))
+
+(defun detached--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 (detached--session-time session) :start))
+ (end-time))
+ (if approximate
+ (setq end-time
+ (time-to-seconds
+ (file-attribute-modification-time
+ (file-attributes
+ (detached--session-file session 'log)))))
+ (setq end-time (time-to-seconds)))
+ `(:start ,start-time :end ,end-time :duration ,(- end-time start-time))))
+
+(defun detached--create-id (command)
+ "Return a hash identifier for COMMAND."
+ (let ((current-time (number-to-string (time-to-seconds))))
+ (secure-hash 'md5 (concat command current-time))))
+
+(defun detached--env-message-filter (str)
+ "Remove `detached-env' message in STR."
+ (replace-regexp-in-string "\n?.*detached-exit-code:.*\n?" "" str))
+
+(defun detached--dtach-eof-message-filter (str)
+ "Remove `detached--dtach-eof-message' in STR."
+ (replace-regexp-in-string (format "\n?%s\^M\n" detached--dtach-eof-message) "" str))
+
+(defun detached--dtach-detached-message-filter (str)
+ "Remove `detached--dtach-detached-message' in STR."
+ (replace-regexp-in-string (format "\n?%s\n" detached--dtach-detached-message) "" str))
+
+(defun detached--watch-session-directory (session-directory)
+ "Watch for events in SESSION-DIRECTORY."
+ (unless (detached--watched-session-directory-p session-directory)
+ (push
+ `(,session-directory . ,(file-notify-add-watch
+ session-directory
+ '(change)
+ #'detached-session-directory-event))
+ detached--watched-session-directories)))
+
+(defun detached-session-directory-event (event)
+ "Act on an EVENT in a directory in `detached--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))
+ ;; Session becomes inactive
+ (when (and (eq action 'deleted)
+ (string= "socket" (file-name-extension file)))
+
+ (when-let* ((id (intern (file-name-base file)))
+ (session (detached--db-get-session id))
+ (session-directory (detached-session-directory session))
+ (is-primary
+ (detached--primary-detached-emacs-p session)))
+ (when detached-debug-enabled
+ (message "Session %s is set to inactive by notify-watch event" (detached-session-id session)))
+
+ ;; Remove from un-validated sessions
+ (setq detached--unvalidated-session-ids
+ (delete id detached--unvalidated-session-ids))
+
+ ;; Update session
+ (detached--session-state-transition-update session)
+
+ ;; Remove session directory from `detached--watch-session-directory'
+ ;; if there is no active session associated with the directory
+ (unless
+ (thread-last (detached--db-get-sessions)
+ (seq-filter #'detached-session-active-p)
+ (seq-map #'detached-session-directory)
+ (seq-uniq)
+ (seq-filter (lambda (it) (string= it session-directory))))
+ (file-notify-rm-watch
+ (alist-get session-directory detached--watched-session-directories nil nil #'string=))
+ (setq detached--watched-session-directories
+ (assoc-delete-all session-directory detached--watched-session-directories)))))
+
+ ;; Session becomes active
+ (when (and (eq action 'created)
+ (string= "log" (file-name-extension file)))
+ (when-let* ((id (intern (file-name-base file)))
+ (session (detached--db-get-session id))
+ (session-directory (detached-session-directory session))
+ (is-primary (detached--primary-detached-emacs-p session)))
+ (when detached-debug-enabled
+ (message "Session %s is set to active by notify-watch event" (detached-session-id session)))
+ (setq detached--unvalidated-session-ids
+ (delete (detached-session-id session) detached--unvalidated-session-ids))
+ (setf (detached--session-state session) 'active)
+ (setf (detached--session-time session) `(:start ,(time-to-seconds (current-time)) :end 0.0 :duration 0.0 :offset 0.0))
+ (detached--db-update-entry session)))))
+
+(defun detached--initialize-session (session)
+ "Initialize SESSION."
+ (puthash (detached-session-id session) 'initialized detached--hashed-sessions)
+
+ (let* ((emacsen
+ (thread-last `(,(emacs-pid) ,@(detached--session-initialized-emacsen session))
+ (seq-filter (lambda (it)
+ (alist-get it detached--current-emacsen)))
+ (seq-uniq))))
+ (setf (detached--session-initialized-emacsen session) emacsen))
+
+ (if (detached-session-active-p session)
+ (if (detached--state-transition-p session)
+ (detached--session-state-transition-update session 'approximate)
+ (detached--db-update-entry session)
+ (detached--watch-session-directory (detached-session-directory session)))))
+
+(defun detached--uninitialized-sessions ()
+ "Return a list of uninitialized sessions."
+ (seq-filter #'detached-session-uninitialized-p
+ (detached--db-get-sessions)))
+
+(defun detached--db-directory-event (event)
+ "Act on EVENT in `detached-db-directory'.
+
+If event is cased by an update to the `detached' database, re-initialize
+`detached--sessions'."
+ (pcase-let* ((`(,_descriptor ,action ,file) event)
+ (database-updated (and (string-match "detached-sessions.db$" file)
+ (or (eq 'attribute-changed action)
+ (eq 'changed action))))
+ (detached--current-emacsen (detached--active-detached-emacsen)))
+ (when database-updated
+ ;; Re-initialize the sessions
+ (detached--db-initialize)
+ ;; Initialize unknown sessions
+ (seq-do (lambda (session)
+ (unless (gethash (detached-session-id session) detached--hashed-sessions)
+ (if (not (detached--session-accessible-p session))
+ (puthash (detached-session-id session) 'uninitialized detached--hashed-sessions)
+ (detached--initialize-session session))))
+ (detached--db-get-sessions)))))
+
+(defun detached--annotation-widths (sessions annotation-format)
+ "Return widths for ANNOTATION-FORMAT based on SESSIONS."
+ (seq-map (lambda (it) (detached--annotation-width sessions it)) annotation-format))
+
+(defun detached--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)))))
+
+(defun detached--generate-buffer (name reuse-p &optional number)
+ "Reuse or generate new buffer like built-in function `generate-new-buffer'.
+NAME is used the same way as `generate-new-buffer' but if a buffer which
+REUSE-P for buffer returns nil, return buffer instead.
+
+NUMBER is used internally for recursive calls, but can be used to
+start searching at NUMBER offset."
+ (let* ((buffer-name (if number
+ (format "%s<%d>" name number)
+ name))
+ (buffer (get-buffer buffer-name))
+ (number (or number 1)))
+ (if (and buffer (not (funcall reuse-p buffer)))
+ (detached--generate-buffer name reuse-p (1+ number))
+ (get-buffer-create buffer-name))))
+
+(defun detached--metadata-git-branch ()
+ "Return current git branch."
+ (let ((args '("symbolic-ref" "HEAD" "--short")))
+ (with-temp-buffer
+ (when (= 0 (apply #'process-file `("git" nil t nil ,@args)))
+ (unless (bobp)
+ (goto-char (point-min))
+ (buffer-substring-no-properties (point) (line-end-position)))))))
+
+;;;;; UI
+
+(defun detached--metadata-str (session)
+ "Return SESSION's metadata as a string."
+ (string-join
+ (thread-last (detached--session-metadata session)
+ (seq-filter (lambda (it) (cdr it)))
+ (seq-map
+ (lambda (it)
+ (concat (symbol-name (car it)) ": " (cdr it)))))
+ ""))
+
+(defun detached--duration-str (session)
+ "Return SESSION's duration time."
+ (if (detached-session-started-p session)
+ (detached--duration-str2 (detached-session-duration session))
+ ""))
+
+(defun detached--duration-str2 (duration)
+ "Return propertized DURATION."
+ (let* ((duration (round duration))
+ (hours (/ duration 3600))
+ (minutes (/ (mod duration 3600) 60))
+ (seconds (mod duration 60)))
+ (cond ((> duration (* 60 60)) (format "%sh %sm %ss" hours minutes seconds))
+ ((> duration 60) (format "%sm %ss" minutes seconds))
+ (t (format "%ss" seconds)))))
+
+(defun detached--creation-str (session)
+ "Return SESSION's creation time."
+ (if (detached-session-started-p session)
+ (format-time-string
+ "%b %d %H:%M"
+ (detached-session-start-time session))
+ ""))
+
+(defun detached--size-str (session)
+ "Return the size of SESSION's output."
+ (if (detached-session-active-p session)
+ ""
+ (file-size-human-readable
+ (detached--session-size session))))
+
+(defun detached--status-str (session)
+ "Return string if SESSION has failed."
+ (pcase (detached-session-status session)
+ ('failure "!")
+ ('success "")
+ ('unknown "")))
+
+(defun detached--state-str (session)
+ "Return string based on SESSION state."
+ (pcase (detached-session-state session)
+ ('active (if (detached--session-accessible-p session)
+ "*"
+ "?"))
+ ('inactive "")
+ ('unknown "?")))
+
+(defun detached--working-dir-str (session)
+ "Return working directory of SESSION."
+ (let ((working-directory
+ (detached-session-working-directory session)))
+ (if-let ((remote (file-remote-p working-directory)))
+ (string-remove-prefix remote working-directory)
+ working-directory)))
+
+(defun detached--host-str (session)
+ "Return host name of SESSION."
+ (detached-session-host-name session))
+
+;;;; Minor modes
+
+(defvar detached-shell-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd detached-detach-key) #'detached-detach-session)
+ (define-key map (kbd "C-c C-.") #'detached-describe-session)
+ map)
+ "Keymap for `detached-shell-mode'.")
+
+;;;###autoload
+(define-minor-mode detached-shell-mode
+ "Integrate `detached' in `shell-mode'."
+ :lighter " detached-shell"
+ :keymap (let ((map (make-sparse-keymap)))
+ map)
+ (if detached-shell-mode
+ (dolist (filter detached-shell-mode-filter-functions)
+ (add-hook 'comint-preoutput-filter-functions filter 0 t))
+ (dolist (filter detached-shell-mode-filter-functions)
+ (remove-hook 'comint-preoutput-filter-functions filter t))))
+
+;;;; Major modes
+
+(defvar detached-log-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd detached-detach-key) #'detached-detach-session)
+ (define-key map (kbd "C-c C-.") #'detached-describe-session)
+ map)
+ "Keymap for `detached-log-mode'.")
+
+;;;###autoload
+(define-derived-mode detached-log-mode nil "Detached Log"
+ "Major mode for `detached' logs."
+ (when detached-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))
+
+;; TODO Deprecate the following functions:
+
+(cl-defgeneric detached--shell-command (entity &optional concat)
+ "Return shell command for ENTITY optionally CONCAT.")
+
+(cl-defmethod detached--shell-command ((command string) &optional concat)
+ "Return shell command for COMMAND.
+
+Optionally CONCAT the command return command into a string."
+ (detached--shell-command (detached-create-session command) concat))
+
+(cl-defmethod detached--shell-command ((session detached-session) &optional concat)
+ "Return shell command for SESSION.
+
+Optionally CONCAT the command return command into a string."
+ (if (detached--session-degraded session)
+ (detached--tail-command session concat)
+ (detached--dtach-command session concat)))
+
+(cl-defgeneric detached--tail-command (entity &optional concat)
+ "Return tail command for ENTITY optionally CONCAT.")
+
+(cl-defmethod detached--tail-command ((command string) &optional concat)
+ "Return tail command for COMMAND.
+
+Optionally CONCAT the command return command into a string."
+ (detached--tail-command (detached-create-session command) concat))
+
+(cl-defmethod detached--tail-command ((session detached-session) &optional concat)
+ "Return tail command for SESSION.
+
+Optionally CONCAT the command return command into a string."
+ (detached-connection-local-variables
+ (let* ((log (detached--session-file session 'log t))
+ (tail-command `(,detached-tail-program "-F"
+ "-n"
+ ,(number-to-string detached-session-context-lines)
+ ,log)))
+ (cond ((eq 'detached detached-session-mode)
+ (detached--dtach-command session))
+ ((eq 'attached detached-session-mode)
+ (let ((detached-session-mode 'detached)
+ (detached-current-session session))
+ (detached-start-session (detached-session-command session))
+ (if concat
+ (string-join tail-command " ")
+ tail-command)))
+ ((eq 'attach detached-session-mode)
+ (if concat
+ (string-join tail-command " ")
+ tail-command))))))
+
+(cl-defgeneric detached--dtach-command (entity &optional concat)
+ "Return dtach command for ENTITY optionally CONCAT.")
+
+(cl-defmethod detached--dtach-command ((command string) &optional concat)
+ "Return dtach command for COMMAND.
+
+Optionally CONCAT the command return command into a string."
+ (detached--dtach-command (detached-create-session command) concat))
+
+(cl-defmethod detached--dtach-command ((session detached-session) &optional concat)
+ "Return dtach command for SESSION.
+
+Optionally CONCAT the command return command into a string."
+ (detached-connection-local-variables
+ (let* ((socket (detached--session-file session 'socket t))
+ (log (detached--session-file session 'log t))
+ (dtach-arg (detached--dtach-arg)))
+ (if (eq detached-session-mode 'attach)
+ (if concat
+ (string-join
+ `(,(when detached-show-session-context
+ (format "%s -n %s %s;" detached-tail-program detached-session-context-lines log))
+ ,detached-dtach-program
+ ,dtach-arg
+ ,socket
+ "-r none")
+ " ")
+ (append
+ (when detached-show-session-context
+ `(,detached-tail-program "-n"
+ ,(number-to-string detached-session-context-lines)
+ ,(concat log ";")))
+ `(,detached-dtach-program ,dtach-arg ,socket "-r" "none")))
+ (if concat
+ (string-join
+ `(,detached-dtach-program
+ ,dtach-arg
+ ,socket "-z"
+ ,detached-shell-program "-c"
+ ,(shell-quote-argument (detached--detached-command session)))
+ " ")
+ `(,detached-dtach-program
+ ,dtach-arg ,socket "-z"
+ ,detached-shell-program "-c"
+ ,(detached--detached-command session)))))))
+
+(provide 'detached)
+
+;;; detached.el ends here
--- /dev/null
+This is detached.info, produced by makeinfo version 7.0 from
+detached.texi.
+
+This manual describes the design of the ‘detached’ (version 0.10.1, last
+updated 1 November 2022) package, as well as its options and
+customizations.
+
+ Copyright © 2020-2022 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.3 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with no Front-Cover Texts,
+ and with no Back-Cover Texts. A copy of the license is included in
+ the section entitled “GNU Free Documentation License”.
+
+INFO-DIR-SECTION Emacs misc features
+START-INFO-DIR-ENTRY
+* Detached: (detached). Launch, interact and manage detached processes.
+END-INFO-DIR-ENTRY
+
+\1f
+File: detached.info, Node: Top, Next: Overview, Up: (dir)
+
+Detached processes for GNU Emacs
+********************************
+
+This manual describes the design of the ‘detached’ (version 0.10.1, last
+updated 1 November 2022) package, as well as its options and
+customizations.
+
+ Copyright © 2020-2022 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.3 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with no Front-Cover Texts,
+ and with no Back-Cover Texts. A copy of the license is included in
+ the section entitled “GNU Free Documentation License”.
+
+* Menu:
+
+* Overview::
+* Dependencies::
+* Installation::
+* Configuration::
+* Workflows::
+* Customization::
+* Design::
+* Known limitations::
+* Contributions::
+* Acknowledgments::
+
+— The Detailed Node Listing —
+
+Installation
+
+* Install from source::
+* Install from package archives::
+* Install from Guix::
+
+Workflows
+
+* Integration with shells::
+* Integration with compile and shell-command::
+* Session management::
+
+Session management
+
+* Detached list sessions::
+
+Customization
+
+* Notifications::
+* Detached list::
+
+Design
+
+* Sessions::
+
+Sessions
+
+* Session creation::
+* Session initialization::
+* Session transition::
+
+Known limitations
+
+* Quotation marks::
+* Reproducible environments::
+
+Acknowledgments
+
+* Code contributors::
+* Idea contributors::
+
+
+\1f
+File: detached.info, Node: Overview, Next: Dependencies, Prev: Top, Up: Top
+
+1 Overview
+**********
+
+The ‘detached’ package allows Emacs to run processes which are
+independent from Emacs itself. This is accomplished by offloading the
+process creation to the program ‘dtach’.
+
+ The package introduces a concept of a detached session. A session
+constitutes of three parts:
+
+ • a dtach process
+ • a log with all the process output
+ • a datastructure in Emacs-Lisp
+
+ After a session has been created, Emacs can optionally attach to the
+process. This is something that can be done seamlessly and therefore
+provides no disruption in the ordinary workflows. Another feature
+provided by the package is its monitoring of sessions. It will notify
+the user whenever a session transitions from active to inactive. Since
+all the output of the session is captured, and stored persistently, it
+can be thought of as a text representation of the process.
+
+ The package provides integration with the following built-in Emacs
+packages:
+
+ • ‘compile’
+ • ‘dired’
+ • ‘eshell’
+ • ‘org’
+
+ It also offers support for some 3rd-party packages. For a full list
+of all supported packages, see the variable
+‘detached-init-package-integration’.
+
+\1f
+File: detached.info, Node: Dependencies, Next: Installation, Prev: Overview, Up: Top
+
+2 Dependencies
+**************
+
+The package has no dependencies to other Emacs packages. The
+requirements are that it needs to run on either ‘Linux’ or ‘macOS,’
+since those are the operating systems supported by the program ‘dtach’.
+Apart from dtach, the complete list of external tools to get all the
+features from the package are:
+
+ • ‘tail’
+ • ‘script’
+ • ‘grep’
+ • ‘tee’
+
+\1f
+File: detached.info, Node: Installation, Next: Configuration, Prev: Dependencies, Up: Top
+
+3 Installation
+**************
+
+The ‘detached’ package can be installed from ‘GNU ELPA’ which is enabled
+by default. It is also available for installation through the ‘Guix’
+package manager.
+
+* Menu:
+
+* Install from source::
+* Install from package archives::
+* Install from Guix::
+
+\1f
+File: detached.info, Node: Install from source, Next: Install from package archives, Up: Installation
+
+3.1 Install from source
+=======================
+
+Download the source code from ‘sourcehut’.
+
+ git clone https://git.sr.ht/~niklaseklund/detached.el ~/.config/emacs/packages/detached.el
+
+ Add the following code to ‘init.el’.
+
+ (add-to-list 'load-path "~/.config/emacs/packages/detached.el")
+
+\1f
+File: detached.info, Node: Install from package archives, Next: Install from Guix, Prev: Install from source, Up: Installation
+
+3.2 Install from package archives
+=================================
+
+Run ‘M-x package-refresh-contents’ to make sure the list of packages are
+up to date. List all the packages with ‘M-x package-list-packages’ and
+and find ‘detached’. Press return to get information about the package,
+and press install.
+
+\1f
+File: detached.info, Node: Install from Guix, Prev: Install from package archives, Up: Installation
+
+3.3 Install from Guix
+=====================
+
+To install ‘detached’ with Guix run the following command in a terminal.
+
+ guix install emacs-detached
+
+\1f
+File: detached.info, Node: Configuration, Next: Workflows, Prev: Installation, Up: Top
+
+4 Configuration
+***************
+
+This is a a minimal ‘use-package’ configuration.
+
+ (use-package detached
+ :init
+ (detached-init)
+ :bind (([remap async-shell-command] . detached-shell-command)
+ ([remap compile] . detached-compile)
+ ([remap recompile] . detached-compile-recompile))
+ :custom ((detached-terminal-data-command system-type)
+ (detached-terminal-data-command system-type)))
+
+\1f
+File: detached.info, Node: Workflows, Next: Customization, Prev: Configuration, Up: Top
+
+5 Workflows
+***********
+
+* Menu:
+
+* Integration with shells::
+* Integration with compile and shell-command::
+* Session management::
+
+\1f
+File: detached.info, Node: Integration with shells, Next: Integration with compile and shell-command, Up: Workflows
+
+5.1 Integration with shells
+===========================
+
+The package supports integration with ‘shell’, ‘eshell’ and ‘vterm’.
+All of the these extensions work similarly, each implementing a detached
+minor mode, ‘detached-.*mode’. Each of the minor modes provides
+keybindings for the following operations:
+
+ • Creating a session
+ • Detaching from a session
+ • Attach to a session
+
+ When creating a session Emacs will automatically attach to the
+underlying ‘dtach’ process and the result will look the same as if
+‘detached’ wasn’t used. The difference is that the user can detach from
+the session with the keybinding determined by the ‘detached-detach-key’.
+If the prefix argument is provided when creating the session detached
+will not attach to the session. To later attach to a running session
+the user can do this with the attach command, by default bound to
+‘C-<return>’.
+
+\1f
+File: detached.info, Node: Integration with compile and shell-command, Next: Session management, Prev: Integration with shells, Up: Workflows
+
+5.2 Integration with compile and shell-command
+==============================================
+
+When creating a session with ‘detached-compile’ or
+‘detached-shell-command’ Emacs will attach to the process and show the
+result in a buffer. It is possible to detach from the process with the
+‘detached-detach-key’ and the buffer will then be closed. Later on to
+attach to a session use any of the commands provided mentioned in
+Session management.
+
+\1f
+File: detached.info, Node: Session management, Prev: Integration with compile and shell-command, Up: Workflows
+
+5.3 Session management
+======================
+
+The package offers two different interfaces for session management,
+‘detached-open-session’ and ‘detached-list-sessions’. The former uses
+the completing-read interface, whilst the latter uses the tabulated list
+interface. Each of the interfaces can be used to interact with a
+session. The ‘detached-list-sessions’ interface is however more feature
+rich, and is what is recommended from the package author.
+
+* Menu:
+
+* Detached list sessions::
+
+\1f
+File: detached.info, Node: Detached list sessions, Up: Session management
+
+5.3.1 Detached list sessions
+----------------------------
+
+After opening ‘detached-list-sessions’ the user can press ‘?’ to view a
+list of all commands accessible in the buffer. Generally speaking there
+are commands to either operate on the session at point, such as
+rerunning it and deleting it. Or there are commands that operate on
+multiple sessions at once, such as marking sessions or narrow the list
+of sessions based on a criteria.
+
+ Narrow criteria are composable so that they each take effect after
+each other. For example narrowing based on local sessions, narrows the
+list of candidates, which further can be narrowed to sessions where the
+command match a regular expression. The mode also features a command
+‘detached-list-select-filter’ which allows the user to select a
+preconfigured set of criteria defined in ‘detached-list-filters’.
+
+\1f
+File: detached.info, Node: Customization, Next: Design, Prev: Workflows, Up: Top
+
+6 Customization
+***************
+
+* Menu:
+
+* Notifications::
+* Detached list::
+
+\1f
+File: detached.info, Node: Notifications, Next: Detached list, Up: Customization
+
+6.1 Notifications
+=================
+
+By default ‘detached’ uses the built in ‘notifications’ library to issue
+notifications to the user. This solution is dependent on ‘dbus’, and if
+that doesn’t work the user has the posbility to customize the
+‘detached-notification-function’.
+
+ The variable can be changed to:
+ • a custom function, created by the user
+ • the ‘detached-state-transition-echo-message’, which uses the echo
+ area
+ • the ‘detached-extra-alert-notification’, which relies on the
+ 3rd-party package ‘alert’
+
+\1f
+File: detached.info, Node: Detached list, Prev: Notifications, Up: Customization
+
+6.2 Detached list
+=================
+
+The buffer created by ‘detached-list-sessions’ can be customized in its
+appearance. This is done through the
+‘detached-list-display-buffer-action’. By default it will use:
+
+ '(display-buffer-same-window
+ (inhibit-same-window . nil))
+
+ Which makes the buffer replace the buffer in the current window. For
+those that prefer a popup window, created at the bottom of the frame,
+the following value can be used:
+
+ '(display-buffer-at-bottom
+ (window-height . 0.33))
+
+\1f
+File: detached.info, Node: Design, Next: Known limitations, Prev: Customization, Up: Top
+
+7 Design
+********
+
+* Menu:
+
+* Sessions::
+
+\1f
+File: detached.info, Node: Sessions, Up: Design
+
+7.1 Sessions
+============
+
+* Menu:
+
+* Session creation::
+* Session initialization::
+* Session transition::
+
+\1f
+File: detached.info, Node: Session creation, Next: Session initialization, Up: Sessions
+
+7.1.1 Session creation
+----------------------
+
+When creating a session ‘three actions’ are taken:
+ • The session’s directory is getting watched, unless its already
+ watched
+ • A timer-based validator function is being created
+ • The session object is added to the list of unvalidated sessions
+
+ The steps taken above is done in order to handle a couple of
+different scenarios:
+ • The underlying ‘dtach’ session is never created, the validator will
+ recognize this and never insert the session into the database
+ • The session is correctly created and is running when the validator
+ is called, it will update the state from ‘unknown’ to ‘active’ and
+ insert the object into the database
+ • The session is finished quickly before the validator is being run,
+ it will trigger a session directory event, this will update the
+ session and insert it into the database, at the same time it is
+ removed from the list of ‘unvalidated’ sessions which will cause
+ the ‘validator’ to not do anything
+
+ The logic described mean that the Emacs that creates the session is
+responsible for validating the session. Only when a session has been
+validated, or become inactive, it will be added to the database. When
+it is added to the database it will cause other ‘Emacsen’ to read from
+the database and then become aware of existence the session.
+
+\1f
+File: detached.info, Node: Session initialization, Next: Session transition, Prev: Session creation, Up: Sessions
+
+7.1.2 Session initialization
+----------------------------
+
+The initialization of ‘sessions’ when ‘detached’ is loaded is performed
+in the following steps:
+ • All known sessions are read from the database
+ • The directory where the database resides are being watched in order
+ to detect updates made to the database
+ • A hash-table is created where all keys are session ids, and the
+ values are the status, which is initialized to ‘uninitialized’
+ • For all sessions that are accessible, which is either local
+ sessions or remote sessions with an active connection
+ • The hash-table is updated to ‘initialized’
+ • The sessions ‘initialized-emacsen’ property is updated with
+ the process id of the current Emacs
+ • If the session is registered as ‘active’ the session is
+ updated if it has transitioned to ‘inactive’, otherwise its
+ session directory is being watched
+ • If the session is missing, ‘e.g.’ it has been deleted from the
+ computer, the session is removed from the database
+
+\1f
+File: detached.info, Node: Session transition, Prev: Session initialization, Up: Sessions
+
+7.1.3 Session transition
+------------------------
+
+The ‘detached’ sessions are read from the persistent ‘detached.db’ file
+when the package is loaded. All ‘Emacsen’ that loads ‘detached’ are
+reading and writing to the same database file, that allows the sessions
+to be shared among Emacsen.
+
+ To avoid all Emacsen from sending a notification when a session
+becomes inactive the responsibility is determined dynamically. All
+Emacsen, where detached is loaded, registers their process in a file
+named ‘detached-emacsen’. Initialization of sessions are done on a
+session basis
+
+\1f
+File: detached.info, Node: Known limitations, Next: Contributions, Prev: Design, Up: Top
+
+8 Known limitations
+*******************
+
+The ‘detached’ package have some known limitations. It is designed
+around the idea that a single command is executed. Therefore it does
+not support a session that can be re-used over time, which is a common
+use-case with for example ‘tmux’.
+
+* Menu:
+
+* Quotation marks::
+* Reproducible environments::
+
+\1f
+File: detached.info, Node: Quotation marks, Next: Reproducible environments, Up: Known limitations
+
+8.1 Quotation marks
+===================
+
+The way the package transforms, the command the user wants to run, into
+a ‘detached’ command behaves incorrectly when it contain double
+quotation marks. For example the following command:
+
+ git shortlog --summary --numbered --all --no-merges --since="01 Jan 2022"
+
+ Will unfortunately not be interpreted correctly. Instead the user
+needs to use single quotation marks in order for it to work:
+
+ git shortlog --summary --numbered --all --no-merges --since='01 Jan 2022'
+
+\1f
+File: detached.info, Node: Reproducible environments, Prev: Quotation marks, Up: Known limitations
+
+8.2 Reproducible environments
+=============================
+
+The package works best when sessions can be re-run. For this to work,
+the command needs to be robust against changes in the environment.
+Since only a single command is run there can be no dependency to
+previously run commands in the same shell, when the session is created.
+If the command the user wants to run have such requirements the best
+thing to do is to create a shell script that can set up that
+environment, and execute that script instead.
+
+ The tool ‘direnv’ could ideally be used with ‘detached’, however
+there seems to be no way to make it work for remote processes. So the
+recommendation for that use-case is the same as above, create a shell
+script. For example a script named ‘direnv_command’ with the following
+content:
+
+ #!/usr/bin/env bash
+ direnv exec . "$@"
+
+ Then the following command would be reproducible.
+
+ direnv_command python foo.py
+
+\1f
+File: detached.info, Node: Contributions, Next: Acknowledgments, Prev: Known limitations, Up: Top
+
+9 Contributions
+***************
+
+The package is part of ‘ELPA’, which means that if you want to
+contribute, you must have a copyright assignement
+(https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html).
+
+\1f
+File: detached.info, Node: Acknowledgments, Prev: Contributions, Up: Top
+
+10 Acknowledgments
+******************
+
+This package wouldn’t have been were it is today without these
+contributors.
+
+* Menu:
+
+* Code contributors::
+* Idea contributors::
+
+\1f
+File: detached.info, Node: Code contributors, Next: Idea contributors, Up: Acknowledgments
+
+10.1 Code contributors
+======================
+
+ • rosetail (https://gitlab.com/rosetail)
+ • protesilaos (https://lists.sr.ht/~protesilaos)
+ • Stefan Monnier (https://www.iro.umontreal.ca/~monnier)
+ • dpettersson
+ • Greg Pfeil (http://technomadic.org)
+
+\1f
+File: detached.info, Node: Idea contributors, Prev: Code contributors, Up: Acknowledgments
+
+10.2 Idea contributors
+======================
+
+ • rosetail (https://gitlab.com/rosetail) for all the great ideas and
+ improvements to the package. Without those contributions
+ ‘detached.el‘ would be a less sophisticated package.
+ • Troy de Freitas (https://gitlab.com/ntdef) for solving the problem
+ of getting ‘detached.el‘ to work with ‘filenotify‘ on macOS.
+ • Daniel Mendler (https://gitlab.com/minad) for helping out in
+ improving ‘detached.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.
+
+
+\1f
+Tag Table:
+Node: Top\7f854
+Node: Overview\7f2367
+Node: Dependencies\7f3658
+Node: Installation\7f4170
+Node: Install from source\7f4561
+Node: Install from package archives\7f4978
+Node: Install from Guix\7f5431
+Node: Configuration\7f5694
+Node: Workflows\7f6247
+Node: Integration with shells\7f6475
+Node: Integration with compile and shell-command\7f7524
+Node: Session management\7f8132
+Node: Detached list sessions\7f8755
+Node: Customization\7f9707
+Node: Notifications\7f9874
+Node: Detached list\7f10535
+Node: Design\7f11154
+Node: Sessions\7f11292
+Node: Session creation\7f11453
+Node: Session initialization\7f12969
+Node: Session transition\7f14207
+Node: Known limitations\7f14903
+Node: Quotation marks\7f15352
+Node: Reproducible environments\7f15984
+Node: Contributions\7f17044
+Node: Acknowledgments\7f17387
+Node: Code contributors\7f17639
+Node: Idea contributors\7f18008
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
--- /dev/null
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+\1f
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "H" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs misc features
+* Detached: (detached). Launch, interact and manage detached processes.
projects / emacsconfig.git / commitdiff