branch: externals/dtache
commit c57f57a49e46abdb802868f10069021b0cf200d3
Author: Niklas Eklund <niklas.ekl...@posteo.net>
Commit: Niklas Eklund <niklas.ekl...@posteo.net>
Update host property
This patch updates the host property to a property list instead of
just a name. The name of the localhost is therefore not shown as
localhost anymore but as its real name.
This patch can potentially break user configurations if they have
customized the dtache-annotation-format.
---
README.org | 2 +-
dtache-consult.el | 26 ++++++++++++--------------
dtache-eshell.el | 4 ++--
dtache-shell.el | 4 ++--
dtache.el | 41 +++++++++++++++++++++++------------------
test/dtache-test.el | 29 ++++++++++++++++-------------
6 files changed, 56 insertions(+), 50 deletions(-)
diff --git a/README.org b/README.org
index d49eb98337..1df5519e32 100644
--- a/README.org
+++ b/README.org
@@ -274,7 +274,7 @@ Users can customize the appearance of annotations in
=dtache-open-session= by mo
(defvar dtache-annotation-format
`((:width 3 :function dtache--state-str :face dtache-state-face)
(:width 3 :function dtache--status-str :face dtache-failure-face)
- (:width 10 :function dtache--session-host :face dtache-host-face)
+ (:width 10 :function dtache--host-str :face dtache-host-face)
(:width 40 :function dtache--working-dir-str :face
dtache-working-dir-face)
(:width 30 :function dtache--metadata-str :face dtache-metadata-face)
(:width 10 :function dtache--duration-str :face dtache-duration-face)
diff --git a/dtache-consult.el b/dtache-consult.el
index 8550d4fd15..0eefdfce7c 100644
--- a/dtache-consult.el
+++ b/dtache-consult.el
@@ -126,12 +126,11 @@ See `consult-multi' for a description of the source
values."
:action (lambda (x) (dtache-open-session (dtache--decode-session x)))
:items
,(lambda ()
- (let ((host "localhost"))
- (mapcar #'car
- (seq-filter
- (lambda (x)
- (string= (dtache--session-host (cdr x)) host))
- (dtache-session-candidates (dtache-get-sessions))))))
+ (mapcar #'car
+ (seq-filter
+ (lambda (x)
+ (eq 'local (plist-get (dtache--session-host (cdr x)) :type)))
+ (dtache-session-candidates (dtache-get-sessions)))))
"Local host `dtache' sessions as a source for `consult'."))
(defvar dtache-consult--source-remote-session
@@ -142,12 +141,11 @@ See `consult-multi' for a description of the source
values."
:action (lambda (x) (dtache-open-session (dtache--decode-session x)))
:items
,(lambda ()
- (let ((host "localhost"))
- (mapcar #'car
- (seq-remove
- (lambda (x)
- (string= (dtache--session-host (cdr x)) host))
- (dtache-session-candidates (dtache-get-sessions)))))))
+ (mapcar #'car
+ (seq-filter
+ (lambda (x)
+ (eq 'remote (plist-get (dtache--session-host (cdr x))
:type)))
+ (dtache-session-candidates (dtache-get-sessions))))))
"Remote host `dtache' sessions as a source for `consult'.")
(defvar dtache-consult--source-current-session
@@ -158,10 +156,10 @@ See `consult-multi' for a description of the source
values."
:action (lambda (x) (dtache-open-session (dtache--decode-session x)))
:items
,(lambda ()
- (let ((host (dtache--host)))
+ (let ((host-name (plist-get (dtache--host) :name)))
(mapcar #'car (seq-filter
(lambda (x)
- (string= (dtache--session-host (cdr x)) host))
+ (string= (plist-get (dtache--session-host (cdr x))
:name) host-name))
(dtache-session-candidates (dtache-get-sessions)))))))
"Current host `dtache' sessions as a source for `consult'.")
diff --git a/dtache-eshell.el b/dtache-eshell.el
index 1f4e09dd9a..160432f51c 100644
--- a/dtache-eshell.el
+++ b/dtache-eshell.el
@@ -51,11 +51,11 @@
(defun dtache-eshell-select-session ()
"Return selected session."
- (let* ((current-host (dtache--host))
+ (let* ((host-name (plist-get (dtache--host) :name))
(sessions
(thread-last (dtache-get-sessions)
(seq-filter (lambda (it)
- (string= (dtache--session-host it)
current-host)))
+ (string= (plist-get (dtache--session-host
it) :name) host-name)))
(seq-filter #'dtache--determine-session-state))))
(dtache-completing-read sessions)))
diff --git a/dtache-shell.el b/dtache-shell.el
index c560be4f55..6bb6fbaed2 100644
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -53,11 +53,11 @@
(defun dtache-shell-select-session ()
"Return selected session."
- (let* ((current-host (dtache--host))
+ (let* ((host-name (plist-get (dtache--host) :name))
(sessions
(thread-last (dtache-get-sessions)
(seq-filter (lambda (it)
- (string= (dtache--session-host it)
current-host)))
+ (string= (plist-get (dtache--session-host
it) :name) host-name)))
(seq-filter (lambda (it) (eq 'active
(dtache--determine-session-state it)))))))
(dtache-completing-read sessions)))
diff --git a/dtache.el b/dtache.el
index 2ada2599db..73d6e97351 100644
--- a/dtache.el
+++ b/dtache.el
@@ -83,7 +83,7 @@
(defcustom dtache-annotation-format
'((:width 3 :function dtache--state-str :face dtache-state-face)
(:width 3 :function dtache--status-str :face dtache-failure-face)
- (:width 10 :function dtache--session-host :face dtache-host-face)
+ (:width 10 :function dtache--host-str :face dtache-host-face)
(:width 40 :function dtache--working-dir-str :face dtache-working-dir-face)
(:width 30 :function dtache--metadata-str :face dtache-metadata-face)
(:width 10 :function dtache--duration-str :face dtache-duration-face)
@@ -139,7 +139,7 @@ Valid values are: create, new and attach")
(defvar dtache-metadata-annotators-alist nil
"An alist of annotators for metadata.")
-(defconst dtache-session-version "0.3.1"
+(defconst dtache-session-version "0.3.2"
"The version of `dtache-session'.
This version is encoded as [package-version].[revision].")
@@ -489,11 +489,11 @@ compilation or `shell-command' the command will also kill
the window."
(defun dtache-delete-sessions (&optional all-hosts)
"Delete `dtache' sessions on current host, unless ALL-HOSTS."
(interactive "P")
- (let* ((host (dtache--host))
+ (let* ((host-name (plist-get (dtache--host) :name))
(sessions (if all-hosts
(dtache-get-sessions)
(seq-filter (lambda (it)
- (string= (dtache--session-host it) host))
+ (string= (plist-get (dtache--session-host
it) :name) host-name))
(dtache-get-sessions)))))
(seq-do #'dtache--db-remove-entry sessions)))
@@ -588,12 +588,12 @@ Optionally SUPPRESS-OUTPUT."
(dtache--db-initialize)
(seq-do (lambda (session)
;; Remove missing local sessions
- (if (and (string= "localhost" (dtache--session-host session))
+ (if (and (eq 'local (plist-get (dtache--session-host session)
:type))
(dtache--session-missing-p session))
(dtache--db-remove-entry session)
;; Update local active sessions
- (when (and (string= "localhost" (dtache--session-host session))
+ (when (and (eq 'local (plist-get (dtache--session-host
session) :type))
(eq 'active (dtache--session-state session)))
(dtache--update-session session))))
(dtache--db-get-sessions))
@@ -619,7 +619,7 @@ If session is not valid trigger an automatic cleanup on
SESSION's host."
(if (not (dtache--session-missing-p session))
t
(let ((host (dtache--session-host session)))
- (message "Session does not exist. Initiate sesion cleanup on host %s"
host)
+ (message "Session does not exist. Initiate sesion cleanup on host %s"
(plist-get host :name))
(dtache--cleanup-host-sessions host)
nil))))
@@ -804,7 +804,7 @@ Optionally CONCAT the command return command into a string."
#'identity
`(,(format "Command: %s" (dtache--session-command session))
,(format "Working directory: %s" (dtache--working-dir-str session))
- ,(format "Host: %s" (dtache--session-host session))
+ ,(format "Host: %s" (plist-get (dtache--session-host session) :name))
,(format "Id: %s" (symbol-name (dtache--session-id session)))
,(format "Status: %s" (dtache--session-status session))
,(format "Metadata: %s" (dtache--metadata-str session))
@@ -836,10 +836,10 @@ Optionally CONCAT the command return command into a
string."
"Update `dtache' sessions.
Sessions running on current host or localhost are updated."
- (let ((current-host (dtache--host)))
+ (let ((host-name (plist-get (dtache--host) :name)))
(seq-do (lambda (it)
- (if (and (or (string= current-host (dtache--session-host it))
- (string= "localhost" (dtache--session-host it)))
+ (if (and (or (string= host-name (plist-get (dtache--session-host
it) :name))
+ (eq 'local (plist-get (dtache--session-host it)
:name)))
(or (eq 'active (dtache--session-state it))
(dtache--state-transition-p it)))
(dtache--update-session it)))
@@ -879,10 +879,11 @@ Optionally make the path LOCAL to host."
(defun dtache--cleanup-host-sessions (host)
"Run cleanuup on HOST sessions."
- (thread-last (dtache--db-get-sessions)
- (seq-filter (lambda (it) (string= host (dtache--session-host
it))))
- (seq-filter #'dtache--session-missing-p)
- (seq-do #'dtache--db-remove-entry)))
+ (let ((host-name (plist-get host :name)))
+ (thread-last (dtache--db-get-sessions)
+ (seq-filter (lambda (it) (string= host-name (plist-get
(dtache--session-host it) :name))))
+ (seq-filter #'dtache--session-missing-p)
+ (seq-do #'dtache--db-remove-entry))))
(defun dtache--session-output (session)
"Return content of SESSION's output."
@@ -1050,9 +1051,9 @@ If SESSION is nonattachable fallback to a command that
doesn't rely on tee."
(defun dtache--host ()
"Return name of host."
- (or
- (file-remote-p default-directory 'host)
- "localhost"))
+ (let ((remote (file-remote-p default-directory)))
+ `(:type ,(if remote 'remote 'local)
+ :name ,(if remote (file-remote-p default-directory 'host)
(system-name)))))
(defun dtache--update-session-time (session &optional approximate)
"Update SESSION's time property.
@@ -1187,6 +1188,10 @@ session and trigger a state transition."
(string-remove-prefix remote working-directory)
working-directory)))
+(defun dtache--host-str (session)
+ "Return host name of SESSION."
+ (plist-get (dtache--session-host session) :name))
+
;;;; Minor modes
;;;###autoload
diff --git a/test/dtache-test.el b/test/dtache-test.el
index 2534647c5f..ae0e91b96c 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -46,6 +46,7 @@
"Create session with COMMAND running on HOST."
(cl-letf* (((symbol-function #'dtache--host) (lambda () host))
((symbol-function #'dtache-metadata) (lambda () nil))
+ ((symbol-function #'dtache--watch-session-directory) #'ignore)
(session (dtache-create-session command)))
(dtache-test--change-session-state session 'activate)
session))
@@ -139,20 +140,21 @@
(dtache--session-create :command "12345678"))))))
(ert-deftest dtache-test-host ()
- (should (string= "localhost" (dtache--host)))
+ (cl-letf (((symbol-function #'system-name) (lambda () "localhost")))
+ (should (equal '(:type local :name "localhost") (dtache--host))))
(let ((default-directory "/ssh:remotehost:/home/user/git"))
- (should (string= "remotehost" (dtache--host)))))
+ (should (equal '(:type remote :name "remotehost") (dtache--host)))))
(ert-deftest dtache-test-session-active-p ()
(dtache-test--with-temp-database
- (let ((session (dtache-test--create-session :command "foo" :host
"localhost")))
+ (let ((session (dtache-test--create-session :command "foo" :host '(:type
local :name "bar"))))
(should (eq 'active (dtache--determine-session-state session)))
(dtache-test--change-session-state session 'deactivate)
(should (eq 'inactive (dtache--determine-session-state session))))))
(ert-deftest dtache-test-session-dead-p ()
(dtache-test--with-temp-database
- (let ((session (dtache-test--create-session :command "foo" :host
"localhost")))
+ (let ((session (dtache-test--create-session :command "foo" :host '(:type
local :name "bar"))))
(should (not (dtache--session-missing-p session)))
(dtache-test--change-session-state session 'deactivate)
(should (not (dtache--session-missing-p session)))
@@ -161,15 +163,16 @@
(ert-deftest dtache-test-cleanup-host-sessions ()
(dtache-test--with-temp-database
- (cl-letf* ((session1 (dtache-test--create-session :command "foo" :host
"remotehost"))
- (session2 (dtache-test--create-session :command "bar" :host
"localhost"))
- (session3 (dtache-test--create-session :command "baz" :host
"localhost"))
- (host "localhost")
+ (cl-letf* ((session1 (dtache-test--create-session :command "foo" :host
'(:type remote :name "remotehost")))
+ (session2 (dtache-test--create-session :command "bar" :host
'(:type local :name "localhost")))
+ (session3 (dtache-test--create-session :command "baz" :host
'(:type local :name "localhost")))
+ (host '(:type local :name "localhost"))
((symbol-function #'dtache--host) (lambda () host)))
;; One inactive, one missing, one active
(dtache-test--change-session-state session1 'deactivate)
(dtache-test--change-session-state session2 'kill)
(dtache--cleanup-host-sessions host)
+ (dtache--db-get-sessions)
(should (seq-set-equal-p
(dtache--db-get-sessions)
`(,session1 ,session3))))))
@@ -188,21 +191,21 @@
(ert-deftest dtache-test-db-insert-session ()
(dtache-test--with-temp-database
- (let* ((session (dtache-test--create-session :command "foo" :host
"localhost")))
+ (let* ((session (dtache-test--create-session :command "foo" :host '(:type
local :name "localhost"))))
(should (equal (dtache--db-get-sessions) `(,session))))))
(ert-deftest dtache-test-db-remove-session ()
(dtache-test--with-temp-database
- (let* ((host "localhost")
- (session1 (dtache-test--create-session :command "foo" :host host))
- (session2 (dtache-test--create-session :command "bar" :host host)))
+ (let* ((host '(:type local :name "host"))
+ (session1 (dtache-test--create-session :command "foo" :host '(:type
local :name "host")))
+ (session2 (dtache-test--create-session :command "bar" :host '(:type
local :name "host"))))
(should (seq-set-equal-p `(,session1 ,session2)
(dtache--db-get-sessions)))
(dtache--db-remove-entry session1)
(should (seq-set-equal-p `(,session2) (dtache--db-get-sessions))))))
(ert-deftest dtache-test-db-update-session ()
(dtache-test--with-temp-database
- (let* ((session (dtache-test--create-session :command "foo" :host
"localhost"))
+ (let* ((session (dtache-test--create-session :command "foo" :host '(:type
local :name "host")))
(id (dtache--session-id session))
(copy))
(setq copy (copy-dtache-session session))
