[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/detached 26210dc5a8 28/38: Improve the core structure
From: |
ELPA Syncer |
Subject: |
[elpa] externals/detached 26210dc5a8 28/38: Improve the core structure |
Date: |
Thu, 17 Nov 2022 17:57:56 -0500 (EST) |
branch: externals/detached
commit 26210dc5a845e3a9fd9e044ea19029ccaa69ed42
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>
Improve the core structure
Make the code easier to follow by trying to always create sessions and
pass them around to different functions instead of having some
functions rely on commands.
Also start to harmonize the functions in detached.el so that they can
be re-used in detached-list.el
---
detached-compile.el | 39 +++++++++----
detached-dired.el | 3 +-
detached-extra.el | 8 ++-
detached-init.el | 4 +-
detached-list.el | 26 ++++-----
detached.el | 160 ++++++++++++++++++++++++++++++----------------------
6 files changed, 145 insertions(+), 95 deletions(-)
diff --git a/detached-compile.el b/detached-compile.el
index bac300e545..a9b9cb9b63 100644
--- a/detached-compile.el
+++ b/detached-compile.el
@@ -35,7 +35,7 @@
(defcustom detached-compile-session-action
'(:attach detached-compile-attach
:view detached-compile-session
- :run detached-compile)
+ :run detached-compile-start-session)
"Actions for a session created with `detached-compile'."
:group 'detached
:type 'plist)
@@ -57,8 +57,7 @@ Optionally enable COMINT if prefix-argument is provided."
(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))
- (detached-current-session (detached-create-session command)))
+ (detached-session-mode (or detached-session-mode 'attached)))
(compile command comint)))
;;;###autoload
@@ -70,8 +69,15 @@ Optionally EDIT-COMMAND."
(detached-session-action detached-compile-session-action)
(detached-session-origin 'compile)
(detached-session-mode 'attached)
- (detached-current-session edit-command))
- (recompile edit-command)))
+ (command
+ (if edit-command
+ (compilation-read-command
+ (detached-session-command detached-buffer-session))
+ (detached-session-command detached-buffer-session)))
+ (detached-session-environment
+ (detached--session-env detached-buffer-session))
+ (detached-current-session (detached-create-session command)))
+ (apply #'compilation-start `(,command))))
(defun detached-compile-kill ()
"Kill a 'detached' session."
@@ -90,6 +96,13 @@ Optionally EDIT-COMMAND."
(default-directory (detached-session-directory session)))
(compilation-start (detached-session-command session)))))
+;;;###autoload
+(defun detached-compile-start-session (session)
+ "Start SESSION with `detached-compile'."
+ (let* ((detached-enabled t)
+ (detached-current-session session))
+ (detached-compile (detached-session-command session))))
+
;;;;; Support functions
;;;###autoload
@@ -109,17 +122,23 @@ 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))
+ (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))))
(if (eq detached-session-mode 'detached)
- (detached-start-session2 detached-current-session)
+ (detached-start-session detached-current-session)
(apply compilation-start `(,(if (detached-session-started-p
detached-current-session)
(detached-session-attach-command
detached-current-session
:type 'string)
(detached-session-start-command
detached-current-session
:type
'string))
- ,(or
mode 'detached-compilation-mode)
-
,name-function
-
,highlight-regexp))))
+ ,@(plist-get (detached--session-env
detached-current-session) :compilation-args)))))
(apply compilation-start args)))
(defun detached-compile--replace-modesetter ()
diff --git a/detached-dired.el b/detached-dired.el
index 62feea3117..b20becbe16 100644
--- a/detached-dired.el
+++ b/detached-dired.el
@@ -36,7 +36,8 @@
(cl-letf* ((detached-session-origin 'dired)
((symbol-function #'dired-run-shell-command)
(lambda (command)
- (detached-start-session 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)))
diff --git a/detached-extra.el b/detached-extra.el
index 20270666ad..cb3e3f4872 100644
--- a/detached-extra.el
+++ b/detached-extra.el
@@ -49,9 +49,11 @@ Optionally 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)))
+ (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)
diff --git a/detached-init.el b/detached-init.el
index 8db433fbe7..efc98d437d 100644
--- a/detached-init.el
+++ b/detached-init.el
@@ -78,7 +78,7 @@
:group 'detached
:type 'list)
-(defvar detached-action-map
+(defvar detached-embark-action-map
(let ((map (make-sparse-keymap)))
(define-key map "a" #'detached-attach-session)
(define-key map "c" #'detached-compile-session)
@@ -166,7 +166,7 @@
(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))
+ (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 ()
diff --git a/detached-list.el b/detached-list.el
index 00477254ef..d419559c49 100644
--- a/detached-list.el
+++ b/detached-list.el
@@ -119,7 +119,7 @@ detached list implements."
(defun detached-list-describe-duration (session)
"Describe the SESSION's duration statistics."
(interactive
- (list (detached--get-session major-mode)))
+ (list (detached-session-in-context)))
(let ((mean (detached-session-mean-duration session))
(std (detached-session-std-duration session)))
(message "%s: %s %s: %s"
@@ -222,7 +222,7 @@ Optionally DELETE the session if prefix-argument is
provided."
(defun detached-list-view-session (session)
"View SESSION."
(interactive
- (list (detached--get-session major-mode)))
+ (list (detached-session-in-context)))
(let ((detached-open-session-display-buffer-action
detached-list-open-session-display-buffer-action))
(detached-view-dwim session)))
@@ -247,16 +247,16 @@ Optionally TOGGLE-SUPPRESS-OUTPUT."
(bury-buffer buffer)))
(detached-edit-and-run-session session)))
-(defun detached-list-rerun-session (session &optional toggle-suppress-output)
+(defun detached-list-rerun-session (session &optional toggle-session-mode)
"Rerun SESSION at point.
-Optionally TOGGLE-SUPPRESS-OUTPUT."
+Optionally TOGGLE-SESSION-MODE."
(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))
+ (if toggle-session-mode
+ (if (eq 'attached (detached--session-initial-mode session))
'attached
'detached)
(detached--session-initial-mode session))))
@@ -384,7 +384,7 @@ Optionally TOGGLE-SUPPRESS-OUTPUT."
(if current-prefix-arg
(regexp-quote
(detached-session-command
- (detached--get-session major-mode)))
+ (detached-session-in-context)))
(read-regexp
"Filter session commands containing (regexp): "))))
(when regexp
@@ -404,7 +404,7 @@ Optionally TOGGLE-SUPPRESS-OUTPUT."
(if current-prefix-arg
(regexp-quote
(detached-session-working-directory
- (detached--get-session major-mode)))
+ (detached-session-in-context)))
(read-regexp
"Filter session working directories containing (regexp): "))))
(when regexp
@@ -840,7 +840,7 @@ If prefix-argument is provided unmark instead of mark."
detached-list--narrow-criteria)
sessions))
-(cl-defmethod detached--get-session ((_mode (derived-mode detached-list-mode)))
+(cl-defmethod detached--session-in-context ((_mode (derived-mode
detached-list-mode)))
"Return session when in `detached-list-mode'."
(tabulated-list-get-id))
@@ -895,7 +895,7 @@ If prefix-argument is provided unmark instead of mark."
(let ((map (make-sparse-keymap)))
(define-key map (kbd "a") #'detached-list-edit-annotation)
(define-key map (kbd "d") #'detached-list-delete-session)
- (define-key map (kbd "e") #'detached-list-edit-and-run-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)
@@ -923,14 +923,14 @@ If prefix-argument is provided unmark instead of mark."
(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-list-rerun-session)
+ (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-list-copy-session-command)
- (define-key map (kbd "W") #'detached-list-copy-session-output)
+ (define-key map (kbd "w") #'detached-copy-session-command)
+ (define-key map (kbd "W") #'detached-copy-session)
(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)
diff --git a/detached.el b/detached.el
index 9806b344f2..fc5d90b97e 100644
--- a/detached.el
+++ b/detached.el
@@ -149,11 +149,23 @@ Acceptable values are
(defcustom detached-shell-command-session-action
'(:attach detached-shell-command-attach-session
:view detached-view-dwim
- :run detached-shell-command)
+ :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
@@ -217,7 +229,7 @@ If set to a non nil value the latest entry to
(defvar detached-enabled nil)
-(defvar detached-session-mode nil
+(defvar detached-session-mode 'attached
"Mode of operation for session.
Valid values are: create, new and attach")
@@ -419,8 +431,8 @@ Optionally SUPPRESS-OUTPUT if prefix-argument is provided."
detached-shell-command-session-action))
(detached-session-mode (or detached-session-mode
(if suppress-output 'detached 'attached)))
- (detached-current-session (detached-create-session command)))
- (detached-start-session command suppress-output)))
+ (session (detached-create-session command)))
+ (detached-start-session session)))
;;;###autoload
(defun detached-open-session (session)
@@ -468,46 +480,58 @@ The session is compiled by opening its output and enabling
(display-buffer buffer-name
detached-open-session-display-buffer-action))))))
;;;###autoload
-(defun detached-edit-and-run-session (session &optional suppress-output)
- "Edit SESSION and run, optionally SUPPRESS-OUTPUT."
+(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-completing-read (detached-get-sessions))
+ (list (detached-session-in-context)
current-prefix-arg))
- (when (detached-valid-session session)
- (let* ((detached-local-session (detached--session-local session))
- (default-directory
- (detached-session-working-directory session))
- (detached-session-mode (or detached-session-mode
- (detached--session-initial-mode
session)))
+ (when-let* ((detached-session-command
+ (read-string "Edit command: "
+ (detached-session-command session))))
+ (let* ((detached-session-mode
+ (if toggle-session-mode
+ (if (eq 'detached (detached--session-initial-mode session))
+ 'attached
+ 'detached)
+ (detached--session-initial-mode session)))
+ (default-directory (detached-session-working-directory session))
+ (detached-local-session (detached-session-local-p session))
(detached-session-action (detached--session-action session))
- (command
- (read-string "Edit command: " (detached-session-command session))))
- (if suppress-output
- (detached-start-session command suppress-output)
- (funcall (detached-session-run-function session) command)))))
+ (detached-session-environment (detached--session-env session))
+ (detached-current-session
+ (detached-create-session detached-session-command)))
+ (detached-start-session detached-current-session))))
;;;###autoload
-(defun detached-rerun-session (session &optional suppress-output)
- "Rerun SESSION, optionally SUPPRESS-OUTPUT."
+(defun detached-rerun-session (session &optional toggle-session-mode)
+ "Re-run SESSION at point.
+
+Optionally TOGGLE-SESSION-MODE."
(interactive
- (list (detached-completing-read (detached-get-sessions))
+ (list (detached-session-in-context)
current-prefix-arg))
- (when (detached-valid-session session)
- (let* ((detached-local-session (detached--session-local session))
- (default-directory
- (detached-session-working-directory session))
- (detached-session-mode (or detached-session-mode
- (detached--session-initial-mode
session)))
- (detached-session-action (detached--session-action session))
- (command (detached-session-command session)))
- (if suppress-output
- (detached-start-session command suppress-output)
- (funcall (detached-session-run-function session) command)))))
+ (let* ((detached-session-mode
+ (if toggle-session-mode
+ (if (eq 'detached (detached--session-initial-mode session))
+ 'attached
+ 'detached)
+ (detached--session-initial-mode session)))
+ ;; TODO: Implement macro detached-with-session
+ (default-directory (detached-session-working-directory session))
+ (detached-local-session (detached-session-local-p session))
+ (detached-session-action (detached--session-action session))
+ (detached-session-environment (detached--session-env session))
+ (detached-current-session
+ (detached-create-session (detached-session-command session))))
+ (detached-start-session detached-current-session)))
+;;;###autoload
(defun detached-describe-session ()
"Describe current session."
(interactive)
- (when-let* ((session (detached--get-session major-mode))
+ (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)
@@ -534,8 +558,8 @@ The session is compiled by opening its output and enabling
(defun detached-copy-session (session)
"Copy SESSION's output."
(interactive
- (list (detached-completing-read (detached-get-sessions))))
- (when (detached-valid-session session)
+ (list (detached-session-in-context)))
+ (when session
(with-temp-buffer
(insert (detached-session-output session))
(when (detached-session-terminal-data-p session)
@@ -547,7 +571,7 @@ The session is compiled by opening its output and enabling
(defun detached-copy-session-command (session)
"Copy SESSION's command."
(interactive
- (list (detached-completing-read (detached-get-sessions))))
+ (list (detached-session-in-context)))
(kill-new (detached-session-command session)))
;;;###autoload
@@ -694,6 +718,7 @@ active session. For sessions created with
`detached-compile' or
: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
@@ -702,18 +727,6 @@ active session. For sessions created with
`detached-compile' or
(detached--watch-session-directory (detached-session-directory session))
session)))
-;;;###autoload
-(defun detached-start-session (command &optional suppress-output)
- "Start a `detached' session running COMMAND.
-
-Optionally SUPPRESS-OUTPUT."
- (let* ((detached-session-mode
- (if suppress-output
- 'detached
- detached-session-mode))
- (session (detached-create-session command)))
- (detached-start-session2 session)))
-
(defun detached--start-session-process (session start-command)
"Start SESSION with START-COMMAND."
(if (detached-session-local-p session)
@@ -884,25 +897,32 @@ This function uses the `notifications' library."
;;;;; Public session functions
-(defun detached-start-session2 (session)
+(defun detached-start-shell-command-session (session)
+ "Start SESSION as a `shell-command'."
+ (cl-letf* ((inhibit-message t)
+ ((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)))
+ (funcall #'async-shell-command command buffer)
+ (with-current-buffer buffer
+ (setq detached-buffer-session session))))
+
+(defun detached-start-session (session)
"Start SESSION."
(if (eq 'detached (detached--session-initial-mode session))
(detached--start-session-process session
(detached-session-start-command
session
:type 'string))
- ;; TODO: Change this part it should use the run function of the session
- ;; So that this function can be used regardless of origin being shell
command or compile
- (cl-letf* ((inhibit-message t)
- ((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
detached-current-session
- :type 'string)))
- (funcall #'async-shell-command command buffer)
- (with-current-buffer buffer
- (setq detached-buffer-session detached-current-session)))))
+ (let* ((default-directory (detached-session-working-directory 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-environment (detached--session-env session)))
+ (funcall (detached-session-run-function session) session))))
(cl-defun detached-session-start-command (session &key type)
"Return command to start SESSION with specified TYPE."
@@ -1082,7 +1102,7 @@ This function uses the `notifications' library."
"Return SESSION's run function."
(or
(plist-get (detached--session-action session) :run)
- #'detached-start-session))
+ #'detached-start-shell-command-session))
(defun detached-session-callback-function (session)
"Return SESSION's callback function."
@@ -1108,6 +1128,14 @@ This function uses the `notifications' library."
"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-valid-session session)
+ session)))
+
(defun detached-session-started-p (session)
"Return t if SESSION has been started."
(eq 'active (detached-session-state session)))
@@ -1168,10 +1196,6 @@ This function uses the `notifications' library."
;;;;; Other
-(cl-defgeneric detached--get-session (_mode)
- "Return session."
- detached-buffer-session)
-
(defun detached-degraded-command-p (command)
"Return t if COMMAND is degraded."
(>
@@ -1376,6 +1400,10 @@ Optionally make the path LOCAL to host."
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"))
- [elpa] externals/detached 4b3609385d 01/38: Start session rewrite, (continued)
- [elpa] externals/detached 4b3609385d 01/38: Start session rewrite, ELPA Syncer, 2022/11/17
- [elpa] externals/detached f0f9728e2c 31/38: Make local predicate private, ELPA Syncer, 2022/11/17
- [elpa] externals/detached 09b37f681c 30/38: Add detached-with-session macro, ELPA Syncer, 2022/11/17
- [elpa] externals/detached a57a728382 22/38: Remove detached-session-mode 'attach, ELPA Syncer, 2022/11/17
- [elpa] externals/detached 4e36d9de69 10/38: Make current session public, ELPA Syncer, 2022/11/17
- [elpa] externals/detached f896cd9777 32/38: Reformat code, ELPA Syncer, 2022/11/17
- [elpa] externals/detached 0d607044d9 03/38: Add session started predicate, ELPA Syncer, 2022/11/17
- [elpa] externals/detached 4eb5e3e9aa 04/38: Add side effect to start command, ELPA Syncer, 2022/11/17
- [elpa] externals/detached b3fa3b9893 13/38: Move functions to end to prepare for deprecation, ELPA Syncer, 2022/11/17
- [elpa] externals/detached 1604a7b5b8 11/38: Make detached-buffer-session public, ELPA Syncer, 2022/11/17
- [elpa] externals/detached 26210dc5a8 28/38: Improve the core structure,
ELPA Syncer <=