[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/detached 4ed1a3a5b9: Add mean/std duration to session
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/detached 4ed1a3a5b9: Add mean/std duration to session |
|
Date: |
Mon, 14 Nov 2022 15:57:39 -0500 (EST) |
branch: externals/detached
commit 4ed1a3a5b9a1f675fa2f71a89825e43fad6c6e97
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>
Add mean/std duration to session
Implement detached-list-describe-duration command. This allows the
user to quickly summarize the mean and standard deviations of commands
that are equivalent to session at point.
---
CHANGELOG.org | 1 +
detached-compile.el | 92 +++++++-------
detached-consult.el | 72 +++++------
detached-dired.el | 14 +--
detached-eshell.el | 50 ++++----
detached-extra.el | 26 ++--
detached-init.el | 88 ++++++-------
detached-list.el | 28 +++--
detached-org.el | 34 ++---
detached-vterm.el | 46 +++----
detached.el | 63 +++++++++-
doc/detached.info | 2 +-
test/detached-test.el | 336 +++++++++++++++++++++++++-------------------------
13 files changed, 460 insertions(+), 392 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index fd5a47de49..b40e4d745a 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -6,6 +6,7 @@
- Add =edit-and-run= command, which is convenient when a session command needs
to be tweaked before re-running.
- Fix bug caused by incorrect adaptation to detached-local-session
+- Implement mean and std duration for sessions
* Version 0.9.2 (2022-11-01)
diff --git a/detached-compile.el b/detached-compile.el
index 2a7f2dee58..ab3b86d7ef 100644
--- a/detached-compile.el
+++ b/detached-compile.el
@@ -34,8 +34,8 @@
(defcustom detached-compile-session-action
'(:attach detached-compile-attach
- :view detached-compile-session
- :run detached-compile)
+ :view detached-compile-session
+ :run detached-compile)
"Actions for a session created with `detached-compile'."
:group 'detached
:type 'plist)
@@ -48,18 +48,18 @@
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 ((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 'create-and-attach))
- (detached--current-session (detached-create-session command)))
- (compile command comint)))
+ (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
'create-and-attach))
+ (detached--current-session (detached-create-session command)))
+ (compile command comint)))
;;;###autoload
(defun detached-compile-recompile (&optional edit-command)
@@ -67,11 +67,11 @@ Optionally enable COMINT if prefix-argument is provided."
Optionally EDIT-COMMAND."
(interactive "P")
(let* ((detached-enabled t)
- (detached-session-action detached-compile-session-action)
- (detached-session-origin 'compile)
- (detached-session-mode 'create-and-attach)
- (detached--current-session edit-command))
- (recompile edit-command)))
+ (detached-session-action detached-compile-session-action)
+ (detached-session-origin 'compile)
+ (detached-session-mode 'create-and-attach)
+ (detached--current-session edit-command))
+ (recompile edit-command)))
(defun detached-compile-kill ()
"Kill a 'detached' session."
@@ -110,42 +110,42 @@ Optionally EDIT-COMMAND."
(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))
- (if (eq detached-session-mode 'create)
- (detached-start-detached-session detached--current-session)
- (apply compilation-start `(,(detached--shell-command
detached--current-session t)
- ,(or mode 'detached-compilation-mode)
- ,name-function
- ,highlight-regexp))))
- (apply compilation-start args)))
+ (pcase-let ((`(,_command ,mode ,name-function ,highlight-regexp)
args))
+ (if (eq detached-session-mode 'create)
+ (detached-start-detached-session
detached--current-session)
+ (apply compilation-start `(,(detached--shell-command
detached--current-session t)
+ ,(or
mode 'detached-compilation-mode)
+
,name-function
+
,highlight-regexp))))
+ (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))))))
+ (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))))))
+ (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))))))
+ (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'."
@@ -156,10 +156,10 @@ Optionally EDIT-COMMAND."
(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)
+ (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
diff --git a/detached-consult.el b/detached-consult.el
index decf864c55..5c6bf89c24 100644
--- a/detached-consult.el
+++ b/detached-consult.el
@@ -41,14 +41,14 @@
(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)
+ 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."
@@ -57,34 +57,34 @@ See `consult-multi' for a description of the source values."
(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))))))
+ :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))))))
+ :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
@@ -195,11 +195,11 @@ See `consult-multi' for a description of the source
values."
"Enhanced `detached-open-session' command."
(interactive)
(unless (require 'consult nil 'noerror)
- (error "Install Consult to use detached-consult"))
+ (error "Install Consult to use detached-consult"))
(consult--multi detached-consult-sources
- :prompt "Select session: "
- :require-match t
- :sort nil))
+ :prompt "Select session: "
+ :require-match t
+ :sort nil))
(provide 'detached-consult)
diff --git a/detached-dired.el b/detached-dired.el
index 6b353a7742..62feea3117 100644
--- a/detached-dired.el
+++ b/detached-dired.el
@@ -34,13 +34,13 @@
(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)
- (detached-start-session command)
- nil)))
- (pcase-let* ((`(,command ,arg ,file-list) args)
- (modified-args `(,(string-remove-suffix " &" command) ,arg
,file-list)))
- (apply dired-do-shell-command modified-args))))
+ ((symbol-function #'dired-run-shell-command)
+ (lambda (command)
+ (detached-start-session command)
+ 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)
diff --git a/detached-eshell.el b/detached-eshell.el
index 28a72f6ff4..4046d65143 100644
--- a/detached-eshell.el
+++ b/detached-eshell.el
@@ -35,8 +35,8 @@
(defcustom detached-eshell-session-action
'(:attach detached-shell-command-attach-session
- :view detached-view-dwim
- :run detached-shell-command)
+ :view detached-view-dwim
+ :run detached-shell-command)
"Actions for a session created with `detached-eshell'."
:group 'detached
:type 'plist)
@@ -47,13 +47,13 @@
(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--shell-command session)))
- (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)))))
+ (command (string-trim-right (string-join (flatten-list args) "
")))
+ (session (detached-create-session command))
+ (command (detached--shell-command session)))
+ (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
@@ -63,11 +63,11 @@
If prefix-argument directly DETACH from the session."
(interactive "P")
(let* ((detached-session-origin 'eshell)
- (detached-session-mode (if detach 'create 'create-and-attach))
- (detached-enabled t)
- (detached--current-session nil))
- (advice-add #'eshell-external-command :around
#'detached-eshell-external-command)
- (call-interactively #'eshell-send-input)))
+ (detached-session-mode (if detach 'create 'create-and-attach))
+ (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."
@@ -123,11 +123,11 @@ If prefix-argument directly DETACH from the session."
(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)
+ (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
@@ -135,14 +135,14 @@ If prefix-argument directly DETACH from the session."
"Integrate `detached' in `eshell-mode'."
:lighter " detached-eshell"
:keymap (let ((map (make-sparse-keymap)))
- map)
+ 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)))
+ (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)
diff --git a/detached-extra.el b/detached-extra.el
index 8ba21d8254..c73f0aecab 100644
--- a/detached-extra.el
+++ b/detached-extra.el
@@ -42,29 +42,29 @@
Optionally USE-COMINT-MODE"
(if (functionp cmd)
- (funcall cmd)
- (let ((detached-session-origin 'projectile))
- (detached-compile cmd use-comint-mode))))
+ (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-start-session command t)))
+ (detached-session-origin 'rsync))
+ (detached-start-session command t)))
;;;###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)))))
+ (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)
diff --git a/detached-init.el b/detached-init.el
index 9a45019764..8db433fbe7 100644
--- a/detached-init.el
+++ b/detached-init.el
@@ -80,29 +80,29 @@
(defvar detached-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)
- (define-key map "=" #'detached-diff-session)
- map))
+ (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)
+ (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))
+
(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
@@ -113,14 +113,14 @@
(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))))
+ (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
@@ -141,55 +141,55 @@
(defun detached-init--org ()
"Initialize integration with `org'."
(advice-add 'org-babel-sh-evaluate
- :around #'detached-org-babel-sh))
+ :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))
+ :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))
+ :override #'detached-extra-dired-rsync))
(defun detached-init--projectile ()
"Initialize integration with `projectile'."
(advice-add 'projectile-run-compilation
- :override #'detached-extra-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)))
+ (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-action-map
embark-general-map))
- (add-to-list 'embark-keymap-alist '(detached . embark-detached-map))))
+ (defvar embark-detached-map (make-composed-keymap detached-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)))
+ (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)))
+ (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))
+ (detached-initialize-sessions))
;; Required for `detached-shell-command' which is always provided
(add-hook 'shell-mode-hook #'detached-shell-mode))
diff --git a/detached-list.el b/detached-list.el
index a6764781eb..6310eee9cf 100644
--- a/detached-list.el
+++ b/detached-list.el
@@ -38,7 +38,7 @@
(: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 20 :face
detached-duration-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)
@@ -70,7 +70,7 @@ detached list implements."
:type '(alist :key-type string))
(defcustom detached-list-session-identifier-function
- #'detached-list-session-identifier
+ #'detached-session-identifier
"The function to use for identifying a session."
:group 'detached
:type 'sexp)
@@ -114,16 +114,20 @@ detached list implements."
,(detached--session-command session))))
(string-join (seq-remove #'null strs) "\n")))))
-(defun detached-list-session-identifier (session)
- "Return a string identifier for SESSION."
- (string-join
- `(,(detached--session-command session)
- ,(detached--host-str session)
- ,(detached--session-directory session))
- ", "))
-
;;;; Commands
+(defun detached-list-describe-duration (session)
+ "Describe the SESSION's duration statistics."
+ (interactive
+ (list (detached--get-session major-mode)))
+ (let ((mean (detached-session-mean-duration session))
+ (std (detached-session-std-duration session)))
+ (message "%s: %s %s: %s"
+ (propertize "μ" 'face 'detached-mark-face)
+ (if mean (detached--duration-str2 mean) "-")
+ (propertize "σ" 'face 'detached-mark-face)
+ (if std (detached--duration-str2 std) "-"))))
+
(defun detached-list-initialize-session-directory (&optional all)
"Initialize a session-directory.
@@ -931,7 +935,9 @@ If prefix-argument is provided unmark instead of mark."
(define-key map (kbd "=") #'detached-list-diff-marked-sessions)
(define-key map (kbd "-") #'detached-list-widen)
(define-key map (kbd "!") #'detached-shell-command)
- (define-key map (kbd ".") #'detached-describe-session)
+ ;; Describe
+ (define-key map (kbd ". s") #'detached-describe-session)
+ (define-key map (kbd ". d") #'detached-list-describe-duration)
(define-key map (kbd "<backspace>")
#'detached-list-remove-narrow-criterion)
(define-key map (kbd "<return>") #'detached-list-open-session)
map)
diff --git a/detached-org.el b/detached-org.el
index 7f81a2207e..dc887b68c2 100644
--- a/detached-org.el
+++ b/detached-org.el
@@ -33,8 +33,8 @@
(defcustom detached-org-session-action
'(:attach detached-shell-command-attach-session
- :view detached-view-dwim
- :run detached-shell-command)
+ :view detached-view-dwim
+ :run detached-shell-command)
"Actions for a session created with `detached-org'."
:group 'detached
:type 'plist)
@@ -49,21 +49,21 @@ 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 'create)
- (new-command (replace-regexp-in-string "\n" " && "
full-body))
- (dtach-command
- (if (string= "none" (alist-get :session params))
- (detached--dtach-command new-command t)
- (format "%s\necho \"[detached]\""
(detached--dtach-command new-command t))))
- ((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))))
+ (if (alist-get :detached params)
+ (cl-letf* ((detached-session-origin 'org)
+ (detached-session-action
detached-org-session-action)
+ (detached-session-mode 'create)
+ (new-command (replace-regexp-in-string "\n"
" && " full-body))
+ (dtach-command
+ (if (string= "none" (alist-get :session
params))
+ (detached--dtach-command
new-command t)
+ (format "%s\necho \"[detached]\""
(detached--dtach-command new-command t))))
+ ((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)
diff --git a/detached-vterm.el b/detached-vterm.el
index af9db0d970..f8222b55f6 100644
--- a/detached-vterm.el
+++ b/detached-vterm.el
@@ -40,8 +40,8 @@
(defcustom detached-vterm-session-action
'(:attach detached-shell-command-attach-session
- :view detached-view-dwim
- :run detached-shell-command)
+ :view detached-view-dwim
+ :run detached-shell-command)
"Actions for a session created with `detached-vterm'."
:group 'detached
:type 'plist)
@@ -54,18 +54,18 @@
Optionally DETACH from it."
(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 detach 'create 'create-and-attach))
- (detached--current-session (detached-create-session input))
- (command (detached--shell-command detached--current-session t)))
- (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)))
+ (detached-session-origin 'vterm)
+ (detached-session-action detached-vterm-session-action)
+ (detached-session-mode
+ (if detach 'create 'create-and-attach))
+ (detached--current-session (detached-create-session input))
+ (command (detached--shell-command detached--current-session
t)))
+ (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."
@@ -79,9 +79,9 @@ Optionally DETACH from it."
(seq-filter #'detached-session-active-p))))
(detached-completing-read sessions))))
(let ((detached-session-mode 'attach))
- (setq detached--buffer-session session)
- (process-send-string vterm--process (detached--shell-command session t))
- (vterm-send-return)))
+ (setq detached--buffer-session session)
+ (process-send-string vterm--process (detached--shell-command session t))
+ (vterm-send-return)))
(cl-defmethod detached--detach-session ((_mode (derived-mode vterm-mode)))
"Detach from session when MODE is `vterm-mode'."
@@ -93,11 +93,11 @@ Optionally DETACH from it."
(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)
+ (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
@@ -105,7 +105,7 @@ Optionally DETACH from it."
"Integrate `detached' in `vterm'."
:lighter " detached-vterm"
:keymap (let ((map (make-sparse-keymap)))
- map))
+ map))
(provide 'detached-vterm)
diff --git a/detached.el b/detached.el
index 33218c2420..a2e32467dd 100644
--- a/detached.el
+++ b/detached.el
@@ -310,6 +310,9 @@ This version is encoded as [package-version].[revision].")
;;;;; Private
+(defvar detached--session-durations nil
+ "An hash-table with duration sessions.")
+
(defvar detached--sessions-initialized nil
"Sessions are initialized.")
@@ -802,6 +805,9 @@ Optionally SUPPRESS-OUTPUT."
sessions)
ht))
+ ;; Hash sessions and their duration times
+ (detached--initialize-sessions-duration-hashtable)
+
;; Initialize accessible sessions
(let ((detached--current-emacsen (detached--active-detached-emacsen)))
(detached--update-detached-emacsen)
@@ -963,6 +969,20 @@ This function uses the `notifications' library."
(detached--session-time session) :duration)
(- (time-to-seconds) (detached-session-start-time session))))
+(defun detached-session-mean-duration (session)
+ "Return SESSION's mean duration."
+ (when-let* ((duration-statistics
+ (gethash (detached-session-identifier session)
+ detached--session-durations nil)))
+ (plist-get duration-statistics :mean)))
+
+(defun detached-session-std-duration (session)
+ "Return SESSION's std duration."
+ (when-let* ((duration-statistics
+ (gethash (detached-session-identifier session)
+ detached--session-durations nil)))
+ (plist-get duration-statistics :std)))
+
(defun detached-session-host-type (session)
"Return the type of SESSION's host."
(pcase-let ((`(,_name . ,type)
@@ -979,6 +999,14 @@ This function uses the `notifications' library."
"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-directory session))
+ ", "))
+
(defun detached-session-view-function (session)
"Return SESSION's view function."
(or
@@ -1391,6 +1419,35 @@ Optionally make the path LOCAL to host."
(kill-buffer)
(kill-buffer-and-window))))
+(defun detached--initialize-sessions-duration-hashtable ()
+ "Initialize the `detached--session-durations'."
+ (let* ((sessions (detached-get-sessions))
+ (grouped-sessions
+ (thread-last sessions
+ (seq-filter #'detached-session-inactive-p)
+ (seq-remove #'detached-session-failed-p)
+ (seq-group-by #'detached-session-identifier))))
+ (setq detached--session-durations
+ (make-hash-table :test #'equal :size (seq-length grouped-sessions)))
+ (thread-last grouped-sessions
+ (seq-do (lambda (it)
+ (pcase-let* ((`(,identifier . ,sessions) it))
+ (puthash identifier
+ (detached--get-duration-statistics
sessions)
+ detached--session-durations)))))))
+
+(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)))
+
;;;;; Database
(defun detached--db-initialize ()
@@ -1823,7 +1880,11 @@ start searching at NUMBER offset."
(defun detached--duration-str (session)
"Return SESSION's duration time."
- (let* ((duration (round (detached-session-duration 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)))
diff --git a/doc/detached.info b/doc/detached.info
index 8dbcebd47d..8c833929d1 100644
--- a/doc/detached.info
+++ b/doc/detached.info
@@ -1,4 +1,4 @@
-This is detached.info, produced by makeinfo version 7.0 from
+This is detached.info, produced by makeinfo version 6.7 from
detached.texi.
This manual describes the design of the ‘detached’ (version 0.9.2, last
diff --git a/test/detached-test.el b/test/detached-test.el
index 69a2e0e6e9..6834e91a27 100644
--- a/test/detached-test.el
+++ b/test/detached-test.el
@@ -31,38 +31,38 @@
(defmacro detached-test--with-temp-database (&rest body)
"Initialize a detached database and evaluate BODY."
`(let* ((temp-directory (make-temp-file "detached" t))
- (detached-db-directory (expand-file-name "detached-sessions.db"
temp-directory))
- (detached-session-directory (expand-file-name "sessions"
temp-directory))
- (detached--sessions)
- (detached--sessions-initialized))
- (unwind-protect
- (progn
- (detached-initialize-sessions)
- ,@body)
- (delete-directory temp-directory t))))
+ (detached-db-directory (expand-file-name
"detached-sessions.db" temp-directory))
+ (detached-session-directory (expand-file-name "sessions"
temp-directory))
+ (detached--sessions)
+ (detached--sessions-initialized))
+ (unwind-protect
+ (progn
+ (detached-initialize-sessions)
+ ,@body)
+ (delete-directory temp-directory t))))
(cl-defun detached-test--create-session (&key command host)
"Create session with COMMAND running on HOST."
(cl-letf* (((symbol-function #'detached--host) (lambda () host))
- ((symbol-function #'detached-metadata) (lambda () nil))
- ((symbol-function #'detached--watch-session-directory) #'ignore)
- ((symbol-function #'emacs-pid) (lambda () 1))
- (session (detached-create-session command)))
- (detached-test--change-session-state session 'activate)
- (detached--db-insert-entry session)
- session))
+ ((symbol-function #'detached-metadata) (lambda () nil))
+ ((symbol-function #'detached--watch-session-directory)
#'ignore)
+ ((symbol-function #'emacs-pid) (lambda () 1))
+ (session (detached-create-session command)))
+ (detached-test--change-session-state session 'activate)
+ (detached--db-insert-entry session)
+ session))
(defun detached-test--change-session-state (session state)
"Set STATE of SESSION."
(pcase state
- ('activate
- (dolist (type `(socket log))
- (with-temp-file (detached--session-file session type))))
- ('deactivate
- (delete-file (detached--session-file session 'socket)))
- ('kill
- (delete-file (detached--session-file session 'socket))
- (delete-file (detached--session-file session 'log)))))
+ ('activate
+ (dolist (type `(socket log))
+ (with-temp-file (detached--session-file session type))))
+ ('deactivate
+ (delete-file (detached--session-file session 'socket)))
+ ('kill
+ (delete-file (detached--session-file session 'socket))
+ (delete-file (detached--session-file session 'log)))))
;;;; Tests
@@ -90,134 +90,134 @@
(ert-deftest detached-test-dtach-command ()
(detached-test--with-temp-database
(cl-letf* ((detached-dtach-program "dtach")
- (detached-shell-program "bash")
- (session (detached-create-session "ls -la"))
- (detached-show-session-context t)
- (detached-session-context-lines 20)
- (detached-tail-program "tail")
- ((symbol-function #'detached-create-session)
- (lambda (_)
- session))
- ((symbol-function #'detached--detached-command)
- (lambda (_)
- (format "{ detached-command }"))))
- (let* ((detached-session-mode 'create-and-attach)
- (expected `(,detached-dtach-program
- "-c" ,(detached--session-file session 'socket t)
- "-z" ,detached-shell-program
- "-c"
- "{ detached-command }"))
- (expected-concat (format "%s -c %s -z %s -c %s"
- detached-dtach-program
- (detached--session-file session 'socket t)
- detached-shell-program
- "\\{\\ detached-command\\ \\}")))
- (should (equal expected (detached--dtach-command session)))
- (should (equal expected-concat (detached--dtach-command session t))))
- (let* ((detached-session-mode 'attach)
- (log (detached--session-file session 'log t))
- (expected `(,detached-tail-program
- ,(format "--lines=%s" detached-session-context-lines)
- ,(format "%s;" log)
- ,detached-dtach-program "-a" ,(detached--session-file
session 'socket t) "-r" "none"))
- (expected-concat (format "%s %s; %s -a %s -r none"
- (format "%s --lines=%s"
detached-tail-program detached-session-context-lines)
- log
- detached-dtach-program
- (detached--session-file session 'socket
t))))
- (should (equal expected (detached--dtach-command session)))
- (should (equal expected-concat (detached--dtach-command session t)))))))
+ (detached-shell-program "bash")
+ (session (detached-create-session "ls -la"))
+ (detached-show-session-context t)
+ (detached-session-context-lines 20)
+ (detached-tail-program "tail")
+ ((symbol-function #'detached-create-session)
+ (lambda (_)
+ session))
+ ((symbol-function #'detached--detached-command)
+ (lambda (_)
+ (format "{ detached-command }"))))
+ (let* ((detached-session-mode 'create-and-attach)
+ (expected `(,detached-dtach-program
+ "-c" ,(detached--session-file
session 'socket t)
+ "-z" ,detached-shell-program
+ "-c"
+ "{ detached-command }"))
+ (expected-concat (format "%s -c %s -z %s -c %s"
+
detached-dtach-program
+
(detached--session-file session 'socket t)
+
detached-shell-program
+ "\\{\\
detached-command\\ \\}")))
+ (should (equal expected (detached--dtach-command session)))
+ (should (equal expected-concat (detached--dtach-command session t))))
+ (let* ((detached-session-mode 'attach)
+ (log (detached--session-file session 'log t))
+ (expected `(,detached-tail-program
+ ,(format "--lines=%s"
detached-session-context-lines)
+ ,(format "%s;" log)
+ ,detached-dtach-program "-a"
,(detached--session-file session 'socket t) "-r" "none"))
+ (expected-concat (format "%s %s; %s -a %s -r none"
+
(format "%s --lines=%s" detached-tail-program detached-session-context-lines)
+ log
+
detached-dtach-program
+
(detached--session-file session 'socket t))))
+ (should (equal expected (detached--dtach-command session)))
+ (should (equal expected-concat (detached--dtach-command session
t)))))))
(ert-deftest detached-test-metadata ()
;; No annotators
(let ((detached-metadata-annotators-alist '()))
- (should (not (detached-metadata))))
+ (should (not (detached-metadata))))
;; Two annotators
(let ((detached-metadata-annotators-alist
- '((git-branch . (lambda () "foo"))
- (username . (lambda () "bar"))))
- (expected '((username . "bar")
- (git-branch . "foo"))))
- (should (equal (detached-metadata) expected))))
+ '((git-branch . (lambda () "foo"))
+ (username . (lambda () "bar"))))
+ (expected '((username . "bar")
+ (git-branch . "foo"))))
+ (should (equal (detached-metadata) expected))))
(ert-deftest detached-test-session-file ()
;; Local files
(cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory)
(concat directory file)))
- ((symbol-function #'file-remote-p) (lambda (_directory
_localname) "/home/user/tmp"))
- (session (detached--session-create :id 's12345 :directory
"/home/user/tmp/")))
- (should (string= "/home/user/tmp/s12345.log" (detached--session-file
session 'log)))
- (should (string= "/home/user/tmp/s12345.socket" (detached--session-file
session 'socket))))
+ ((symbol-function #'file-remote-p) (lambda (_directory
_localname) "/home/user/tmp"))
+ (session (detached--session-create :id 's12345
:directory "/home/user/tmp/")))
+ (should (string= "/home/user/tmp/s12345.log" (detached--session-file
session 'log)))
+ (should (string= "/home/user/tmp/s12345.socket" (detached--session-file
session 'socket))))
;; Remote files
(cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory)
(concat directory file)))
- ((symbol-function #'file-remote-p) (lambda (_directory
_localname) "/ssh:foo:/home/user/tmp/"))
- (session (detached--session-create :id 's12345 :directory
"/ssh:foo:/home/user/tmp/")))
- (should (string= "/ssh:foo:/home/user/tmp/s12345.log"
(detached--session-file session 'log)))
- (should (string= "/ssh:foo:/home/user/tmp/s12345.socket"
(detached--session-file session 'socket)))))
+ ((symbol-function #'file-remote-p) (lambda (_directory
_localname) "/ssh:foo:/home/user/tmp/"))
+ (session (detached--session-create :id 's12345
:directory "/ssh:foo:/home/user/tmp/")))
+ (should (string= "/ssh:foo:/home/user/tmp/s12345.log"
(detached--session-file session 'log)))
+ (should (string= "/ssh:foo:/home/user/tmp/s12345.socket"
(detached--session-file session 'socket)))))
(ert-deftest detached-test-host ()
(cl-letf (((symbol-function #'system-name) (lambda () "localhost")))
- (should (equal '("localhost" . localhost) (detached--host))))
+ (should (equal '("localhost" . localhost) (detached--host))))
(let ((default-directory "/ssh:remotehost:/home/user/git"))
- (should (equal '("remotehost" . remotehost) (detached--host)))))
+ (should (equal '("remotehost" . remotehost) (detached--host)))))
(ert-deftest detached-test-session-active-p ()
(detached-test--with-temp-database
(let ((session (detached-test--create-session :command "foo" :host '("bar"
. localhost))))
- (should (eq 'active (detached--determine-session-state session)))
- (detached-test--change-session-state session 'deactivate)
- (should (eq 'inactive (detached--determine-session-state session))))))
+ (should (eq 'active (detached--determine-session-state session)))
+ (detached-test--change-session-state session 'deactivate)
+ (should (eq 'inactive (detached--determine-session-state session))))))
(ert-deftest detached-test-session-dead-p ()
(detached-test--with-temp-database
(let ((session (detached-test--create-session :command "foo" :host '("bar"
. localhost))))
- (should (not (detached--session-missing-p session)))
- (detached-test--change-session-state session 'deactivate)
- (should (not (detached--session-missing-p session)))
- (detached-test--change-session-state session 'kill)
- (should (detached--session-missing-p session)))))
+ (should (not (detached--session-missing-p session)))
+ (detached-test--change-session-state session 'deactivate)
+ (should (not (detached--session-missing-p session)))
+ (detached-test--change-session-state session 'kill)
+ (should (detached--session-missing-p session)))))
(ert-deftest detached-test-cleanup-host-sessions ()
(detached-test--with-temp-database
(cl-letf* ((session1 (detached-test--create-session :command "foo" :host
'("remotehost" . remotehost)))
- (session2 (detached-test--create-session :command "bar" :host
'("localhost" . localhost)))
- (session3 (detached-test--create-session :command "baz" :host
'("localhost" . localhost)))
- (host '("localhost" . localhost))
- ((symbol-function #'detached--host) (lambda () host)))
- ;; One inactive, one missing, one active
- (detached-test--change-session-state session1 'deactivate)
- (detached-test--change-session-state session2 'kill)
- (detached--cleanup-host-sessions "localhost")
- (detached--db-get-sessions)
- (should (seq-set-equal-p
- (detached--db-get-sessions)
- `(,session1 ,session3))))))
+ (session2 (detached-test--create-session :command
"bar" :host '("localhost" . localhost)))
+ (session3 (detached-test--create-session :command
"baz" :host '("localhost" . localhost)))
+ (host '("localhost" . localhost))
+ ((symbol-function #'detached--host) (lambda () host)))
+ ;; One inactive, one missing, one active
+ (detached-test--change-session-state session1 'deactivate)
+ (detached-test--change-session-state session2 'kill)
+ (detached--cleanup-host-sessions "localhost")
+ (detached--db-get-sessions)
+ (should (seq-set-equal-p
+ (detached--db-get-sessions)
+ `(,session1 ,session3))))))
(ert-deftest detached-test-dtach-arg ()
(let ((detached-session-mode 'create))
- (should (string= "-n" (detached--dtach-arg))))
+ (should (string= "-n" (detached--dtach-arg))))
(let ((detached-session-mode 'create-and-attach))
- (should (string= "-c" (detached--dtach-arg))))
+ (should (string= "-c" (detached--dtach-arg))))
(let ((detached-session-mode 'attach))
- (should (string= "-a" (detached--dtach-arg))))
+ (should (string= "-a" (detached--dtach-arg))))
(let ((detached-session-mode nil))
- (should-error (detached--dtach-arg))))
+ (should-error (detached--dtach-arg))))
;;;;; Database
(ert-deftest detached-test-db-insert-session ()
(detached-test--with-temp-database
(let* ((session (detached-test--create-session :command "foo" :host
'("localhost" . localhost))))
- (should (equal (detached--db-get-sessions) `(,session))))))
+ (should (equal (detached--db-get-sessions) `(,session))))))
(ert-deftest detached-test-db-remove-session ()
(detached-test--with-temp-database
(let* ((session1 (detached-test--create-session :command "foo" :host
'("host" . localhost)))
- (session2 (detached-test--create-session :command "bar" :host
'("host" . localhost))))
- (should (seq-set-equal-p `(,session1 ,session2)
(detached--db-get-sessions)))
- (detached--db-remove-entry session1)
- (should (seq-set-equal-p `(,session2) (detached--db-get-sessions))))))
+ (session2 (detached-test--create-session :command "bar" :host
'("host" . localhost))))
+ (should (seq-set-equal-p `(,session1 ,session2)
(detached--db-get-sessions)))
+ (detached--db-remove-entry session1)
+ (should (seq-set-equal-p `(,session2) (detached--db-get-sessions))))))
(ert-deftest detached-test-db-update-session ()
(detached-test--with-temp-database
@@ -232,62 +232,62 @@
(ert-deftest detached-test-detached-command ()
(let ((detached-shell-program "bash")
- (detached-script-program "script")
- (detached-tee-program "tee")
- (detached-terminal-data-command "script --quiet --flush --return
--command \"%s\" /dev/null")
- (terminal-data-session
- (detached--session-create :directory "/tmp/detached/"
- :working-directory "/home/user/"
- :command "ls -la"
- :degraded nil
- :env 'terminal-data
- :id 'foo123))
- (degraded-plain-text-session
- (detached--session-create :directory "/tmp/detached/"
- :working-directory "/home/user/"
- :command "ls -la"
- :degraded t
- :env 'plain-text
- :id 'foo123)))
- (should (string= "{ bash -c if\\ TERM\\=eterm-color\\ script\\ --quiet\\
--flush\\ --return\\ --command\\ \\\"ls\\ -la\\\"\\ /dev/null\\;\\ then\\
true\\;\\ else\\ echo\\ \\\"\\[detached-exit-code\\:\\ \\$\\?\\]\\\"\\;\\ fi; }
2>&1 | tee /tmp/detached/foo123.log"
- (detached--detached-command terminal-data-session)))
- (should (string= "{ bash -c if\\ ls\\ -la\\;\\ then\\ true\\;\\ else\\
echo\\ \\\"\\[detached-exit-code\\:\\ \\$\\?\\]\\\"\\;\\ fi; } &>
/tmp/detached/foo123.log"
- (detached--detached-command
degraded-plain-text-session)))))
+ (detached-script-program "script")
+ (detached-tee-program "tee")
+ (detached-terminal-data-command "script --quiet --flush
--return --command \"%s\" /dev/null")
+ (terminal-data-session
+ (detached--session-create :directory "/tmp/detached/"
+
:working-directory "/home/user/"
+ :command "ls
-la"
+ :degraded nil
+ :env
'terminal-data
+ :id 'foo123))
+ (degraded-plain-text-session
+ (detached--session-create :directory "/tmp/detached/"
+
:working-directory "/home/user/"
+ :command "ls
-la"
+ :degraded t
+ :env
'plain-text
+ :id
'foo123)))
+ (should (string= "{ bash -c if\\ TERM\\=eterm-color\\ script\\
--quiet\\ --flush\\ --return\\ --command\\ \\\"ls\\ -la\\\"\\ /dev/null\\;\\
then\\ true\\;\\ else\\ echo\\ \\\"\\[detached-exit-code\\:\\
\\$\\?\\]\\\"\\;\\ fi; } 2>&1 | tee /tmp/detached/foo123.log"
+ (detached--detached-command
terminal-data-session)))
+ (should (string= "{ bash -c if\\ ls\\ -la\\;\\ then\\ true\\;\\ else\\
echo\\ \\\"\\[detached-exit-code\\:\\ \\$\\?\\]\\\"\\;\\ fi; } &>
/tmp/detached/foo123.log"
+ (detached--detached-command
degraded-plain-text-session)))))
(ert-deftest detached-test-degraded-command-p ()
(let ((detached-degraded-commands '("ls")))
- (should (not (detached-degraded-command-p "cd")))
- (should (detached-degraded-command-p "ls -la"))))
+ (should (not (detached-degraded-command-p "cd")))
+ (should (detached-degraded-command-p "ls -la"))))
(ert-deftest detached-test-get-session-directory ()
(let ((default-directory "/ssh:remotehost:/home/user/git")
- (detached-session-directory "/tmp/detached"))
- ;; Remote session directory
- (should (string= "/ssh:remotehost:/tmp/detached"
(detached--get-session-directory)))
- (let ((detached-local-session t))
- ;; Enforced local session directory with `detached-local-session'
- (should (string= "/tmp/detached" (detached--get-session-directory)))))
+ (detached-session-directory "/tmp/detached"))
+ ;; Remote session directory
+ (should (string= "/ssh:remotehost:/tmp/detached"
(detached--get-session-directory)))
+ (let ((detached-local-session t))
+ ;; Enforced local session directory with `detached-local-session'
+ (should (string= "/tmp/detached" (detached--get-session-directory)))))
(let ((default-directory "/home/user/git")
- (detached-session-directory "/tmp/detached"))
- ;; Local session directory
- (should (string= "/tmp/detached" (detached--get-session-directory)))))
+ (detached-session-directory "/tmp/detached"))
+ ;; Local session directory
+ (should (string= "/tmp/detached" (detached--get-session-directory)))))
;;;;; String representations
(ert-deftest detached-test-duration-str ()
(should (string= "1s" (detached--duration-str
- (detached--session-create :time '(:duration 1) :state
'inactive))))
+ (detached--session-create
:time '(:duration 1) :state 'inactive))))
(should (string= "1m 1s" (detached--duration-str
- (detached--session-create :time '(:duration 61)
:state 'inactive))))
+
(detached--session-create :time '(:duration 61) :state 'inactive))))
(should (string= "1h 1m 1s" (detached--duration-str
- (detached--session-create :time '(:duration
3661) :state 'inactive)))))
+
(detached--session-create :time '(:duration 3661) :state 'inactive)))))
(ert-deftest detached-test-creation-str ()
;; Make sure to set the TIMEZONE before executing the test to avoid
;; differences between machines
(cl-letf* (((getenv "TZ") "UTC0")
- (session (detached--session-create :time `(:start
1620463748.7636228))))
- (should (string= "May 08 08:49" (detached--creation-str session)))))
+ (session (detached--session-create :time `(:start
1620463748.7636228))))
+ (should (string= "May 08 08:49" (detached--creation-str session)))))
(ert-deftest detached-test-size-str ()
(should (string= "100" (detached--size-str (detached--session-create :size
100 :state 'inactive))))
@@ -301,45 +301,45 @@
(ert-deftest detached-test-state-str ()
;; Accessible sessions
(cl-letf (((symbol-function #'detached--session-accessible-p) (lambda (_)
t)))
- (should (string= "*" (detached--state-str
- (detached--session-create :state 'active))))
- (should (string= "" (detached--state-str
- (detached--session-create :state 'inactive))))
- (should (string= "?" (detached--state-str
- (detached--session-create :state 'unknown)))))
+ (should (string= "*" (detached--state-str
+ (detached--session-create
:state 'active))))
+ (should (string= "" (detached--state-str
+ (detached--session-create
:state 'inactive))))
+ (should (string= "?" (detached--state-str
+ (detached--session-create
:state 'unknown)))))
;; Inaccessible sessions
(cl-letf (((symbol-function #'detached--session-accessible-p) (lambda (_)
nil)))
- (should (string= "?" (detached--state-str
- (detached--session-create :state 'active))))
- (should (string= "" (detached--state-str
- (detached--session-create :state 'inactive))))
- (should (string= "?" (detached--state-str
- (detached--session-create :state 'unknown))))))
+ (should (string= "?" (detached--state-str
+ (detached--session-create
:state 'active))))
+ (should (string= "" (detached--state-str
+ (detached--session-create
:state 'inactive))))
+ (should (string= "?" (detached--state-str
+ (detached--session-create
:state 'unknown))))))
(ert-deftest detached-test-working-dir-str ()
(should
(string= "/home/user/repo"
- (detached--working-dir-str
- (detached--session-create :working-directory
"/ssh:remote:/home/user/repo"))))
+ (detached--working-dir-str
+ (detached--session-create :working-directory
"/ssh:remote:/home/user/repo"))))
(should
(string= "~/repo"
- (detached--working-dir-str
- (detached--session-create :working-directory "~/repo")))))
+ (detached--working-dir-str
+ (detached--session-create :working-directory
"~/repo")))))
(ert-deftest detached-test-verify-db-compatbility ()
;; Database version is older than minimum version
(cl-letf (((symbol-function #'detached--db-session-version) (lambda ()
(format "0.9.1.1")))
- (detached-minimum-session-version "0.9.1.2"))
- (should (not (detached--verify-db-compatibility))))
+ (detached-minimum-session-version "0.9.1.2"))
+ (should (not (detached--verify-db-compatibility))))
;; Database version is equal to minimum version
(cl-letf (((symbol-function #'detached--db-session-version) (lambda ()
(format "0.9.1.1")))
- (detached-minimum-session-version "0.9.1.1"))
- (should (detached--verify-db-compatibility)))
+ (detached-minimum-session-version "0.9.1.1"))
+ (should (detached--verify-db-compatibility)))
;; Database version is newer than minimum version
(cl-letf (((symbol-function #'detached--db-session-version) (lambda ()
(format "0.9.1.2")))
- (detached-minimum-session-version "0.9.1.1"))
- (should (detached--verify-db-compatibility))))
+ (detached-minimum-session-version "0.9.1.1"))
+ (should (detached--verify-db-compatibility))))
;;;;; Output filters
@@ -347,17 +347,17 @@
(let ((str "
[EOF - dtach terminating]
user@machine "))
- (should (string= "
user@machine " (detached--dtach-eof-message-filter str)))))
+ (should (string= "
user@machine " (detached--dtach-eof-message-filter str)))))
(ert-deftest detached-test-dtach-detached-message-filter ()
(let ((str "
[detached]
user@machine "))
- (should (string= "
user@machine " (detached--dtach-detached-message-filter str)))))
+ (should (string= "
user@machine " (detached--dtach-detached-message-filter str)))))
(ert-deftest detached-test-env-message-filter ()
(let ((str "output\n[detached-exit-code: 127]\n"))
- (should (string= "output" (detached--env-message-filter str)))))
+ (should (string= "output" (detached--env-message-filter str)))))
(provide 'detached-test)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/detached 4ed1a3a5b9: Add mean/std duration to session,
ELPA Syncer <=