emacs-elpa-diffs
[Top][All Lists]
Advanced

[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"))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]