Run in terminal

README.md

@@ -367,6 +367,10 @@ shell. The source block content is copied to the clipboard, so you can do
 (setq devops-terminal-program 'ghostel)
 ```
 
+### Run a block in the terminal
+
+`M-x devops-run-in-terminal` runs the shell block at point in that ghostel terminal, whatever `devops-terminal-program` is. Use it for commands babel handles badly: ones that ask for a password, follow a log (`tail -f`), or take over the screen (`htop`). The block runs at its `:dir`, else its heading's target (unless `:target nil`), else `default-directory`, with its `:var` arguments exported. A terminal that is busy with a command is left alone.
+
 ## devops-lob
 
 `devops.el` uses org's Library of Babel (LOB) to save commonly used server commands. 

devops-test.el

@@ -1734,20 +1734,29 @@ override (issue #14)."
   "Run BODY with a stand-in for the ghostel package.
 `ghostel' records the buffer name and environment it was called with in
 `started' and returns a buffer of that name; `ghostel-paste-string'
-records its text in `pasted'.  Buffers it made are killed afterwards."
+records its text in `pasted' and `ghostel-send-key' its key in `keys'.
+A terminal is running a command while `busy' is non-nil.  Buffers it
+made are killed afterwards."
   (declare (indent 0) (debug t))
   ;; `features' is not special, so it is set and restored, not let-bound.
   `(let ((saved-features features)
          (ghostel-buffer-name "*ghostel*")
          (ghostel-environment '("KEEP=1"))
          (started nil)
-         (pasted nil))
+         (pasted nil)
+         (keys nil)
+         (busy nil))
      (cl-letf (((symbol-function 'ghostel)
                 (lambda (&optional _arg)
                   (push (list ghostel-buffer-name ghostel-environment) started)
                   (get-buffer-create ghostel-buffer-name)))
                ((symbol-function 'ghostel-paste-string)
-                (lambda (text) (push (list (buffer-name) text) pasted))))
+                (lambda (text) (push (list (buffer-name) text) pasted)))
+               ((symbol-function 'ghostel-send-key)
+                (lambda (key &optional _mods) (push key keys)))
+               ((symbol-function 'ghostel-alt-screen-p) #'ignore)
+               ((symbol-function 'ghostel-command-running-p)
+                (lambda () busy)))
        (unwind-protect
            (progn
              (push 'ghostel features)
@@ -1778,6 +1787,57 @@ records its text in `pasted'.  Buffers it made are killed afterwards."
         (should (equal (car started) `(,name ("KEEP=1"))))
         (should (equal pasted `((,name "export FOO=bar\necho $FOO"))))))))
 
+(ert-deftest devops--run-in-ghostel-new-terminal-test ()
+  "A new terminal gets the env vars in its environment and runs the body."
+  (devops-test--with-local-target dir
+    (devops-test--with-fake-ghostel
+      (devops--run-in-ghostel dir '(("FOO" . "bar")) "echo $FOO")
+      (let ((name (devops--ghostel-buffer-name dir)))
+        (should (equal started `((,name ("FOO=bar" "KEEP=1")))))
+        (should (equal pasted `((,name "echo $FOO"))))
+        (should (equal keys '("return")))))))
+
+(ert-deftest devops--run-in-ghostel-open-terminal-test ()
+  "A terminal at a prompt gets the exports and body, then return."
+  (devops-test--with-local-target dir
+    (devops-test--with-fake-ghostel
+      (let ((name (devops--ghostel-buffer-name dir)))
+        (get-buffer-create name)
+        (push (list name nil) started)
+        (devops--run-in-ghostel dir '(("FOO" . "bar")) "echo $FOO")
+        (should (equal pasted `((,name "export FOO=bar\necho $FOO"))))
+        (should (equal keys '("return")))))))
+
+(ert-deftest devops--run-in-ghostel-busy-test ()
+  "Nothing is typed into a terminal while a command runs in it."
+  (devops-test--with-local-target dir
+    (devops-test--with-fake-ghostel
+      (get-buffer-create (devops--ghostel-buffer-name dir))
+      (push (list (devops--ghostel-buffer-name dir) nil) started)
+      (setq busy t)
+      (should-error (devops--run-in-ghostel dir nil "echo hi")
+                    :type 'user-error)
+      (should-not pasted)
+      (should-not keys))))
+
+(ert-deftest devops--block-terminal-dir-test ()
+  "A block's own :dir wins, then the target unless opted out, then here."
+  (devops-test--with-org
+      "#+TARGET: web /ssh:web1:/srv/\n\n* H\t:web:\n"
+    (should (equal (devops--block-terminal-dir '((:dir . "/opt/")))
+                   "/opt/"))
+    (should (equal (devops--block-terminal-dir nil) "/ssh:web1:/srv/"))
+    (should (equal (devops--block-terminal-dir '((:target . "nil")))
+                   default-directory))))
+
+(ert-deftest devops-run-in-terminal-not-shell-test ()
+  "Only a shell block with a body can be run in the terminal."
+  (devops-test--with-org
+      "* H\n\n#+begin_src emacs-lisp\n  (+ 1 2)\n#+end_src\n"
+    (goto-char (point-min))
+    (re-search-forward "begin_src")
+    (should-error (devops-run-in-terminal) :type 'user-error)))
+
 ;;; Drift detection (devops-drift.el)
 
 (defmacro devops-test--with-drift-check (target org-fmt &rest body)

devops.el

@@ -57,6 +57,8 @@
 ;; - `devops-tangle'             tangle the heading's blocks to its target
 ;; - `devops-visit-file'         open tangled source block in the target
 ;; - `devops-open-terminal-dwim' open a terminal at the target
+;; - `devops-run-in-terminal'    run the block in a ghostel terminal
+;;                               at the target
 ;; - `devops-drift'              (if loaded) report diff between blocks
 ;;                               and tangled files
 ;;
@@ -883,6 +885,9 @@ is an alist of (NAME . VALUE) exported in that shell."
 (defvar ghostel-environment)
 (declare-function ghostel "ghostel" (&optional arg))
 (declare-function ghostel-paste-string "ghostel" (string))
+(declare-function ghostel-send-key "ghostel" (key-name &optional mods))
+(declare-function ghostel-alt-screen-p "ghostel" ())
+(declare-function ghostel-command-running-p "ghostel" ())
 
 (defun devops--ghostel-buffer-name (dir)
   "Return the name of the ghostel terminal for DIR, one per target."
@@ -905,26 +910,51 @@ BODY, which may be nil."
                        (and body (list body)))))
     (and lines (string-join lines "\n"))))
 
-(defun devops--open-ghostel (dir env-vars body)
-  "Pop to the ghostel terminal for DIR, with ENV-VARS exported.
-A new terminal starts with ENV-VARS in its environment.  A terminal
-already open gets ENV-VARS and BODY pasted at its prompt, not run.
-A new one does not, since its shell would run each pasted line as it
-started; BODY is in the kill ring for it."
+(defun devops--ghostel-terminal (dir env-vars)
+  "Pop to the ghostel terminal for DIR, starting it when needed.
+Return (BUFFER . OPEN), OPEN non-nil when the terminal was already
+open.  A new terminal starts with ENV-VARS, an alist of (NAME . VALUE),
+in its environment; one already open is left as it is."
   (unless (require 'ghostel nil t)
     (user-error "Package ghostel is not installed"))
   (let* ((default-directory (file-name-as-directory (expand-file-name dir)))
          (ghostel-buffer-name (devops--ghostel-buffer-name default-directory))
-         (open (get-buffer ghostel-buffer-name))
+         (open (and (get-buffer ghostel-buffer-name) t))
          (ghostel-environment (append (unless open
                                         (devops--ghostel-environment env-vars))
-                                      ghostel-environment))
-         (buf (ghostel)))
+                                      ghostel-environment)))
+    (cons (ghostel) open)))
+
+(defun devops--open-ghostel (dir env-vars body)
+  "Pop to the ghostel terminal for DIR, with ENV-VARS exported.
+A new terminal starts with ENV-VARS in its environment.  A terminal
+already open gets ENV-VARS and BODY pasted at its prompt, not run.
+A new one does not, since its shell would run each pasted line as it
+started; BODY is in the kill ring for it."
+  (pcase-let ((`(,buf . ,open) (devops--ghostel-terminal dir env-vars)))
     (when-let* ((open)
                 (text (devops--terminal-input env-vars body)))
       (with-current-buffer buf
         (ghostel-paste-string text)))))
 
+(defun devops--ghostel-busy-p ()
+  "Non-nil when the current ghostel terminal is not at a shell prompt."
+  (or (ghostel-alt-screen-p)
+      (ghostel-command-running-p)))
+
+(defun devops--run-in-ghostel (dir env-vars body)
+  "Run BODY in the ghostel terminal for DIR, with ENV-VARS exported.
+A terminal already open gets ENV-VARS as `export' lines, and is refused
+while a command runs in it.  A new one gets them in its environment,
+and BODY as typeahead its shell reads once it starts."
+  (pcase-let ((`(,buf . ,open) (devops--ghostel-terminal dir env-vars)))
+    (with-current-buffer buf
+      (when (and open (devops--ghostel-busy-p))
+        (user-error "Terminal %s is busy" (buffer-name)))
+      (ghostel-paste-string
+       (devops--terminal-input (and open env-vars) body))
+      (ghostel-send-key "return"))))
+
 (defun devops--open-terminal-at-dir (dir &optional env-vars body)
   "Open `devops-terminal-program' in DIR with ENV-VARS exported.
 BODY, a src block's body or nil, is for the program to offer at the
@@ -979,6 +1009,32 @@ terminal already open at the target."
       (message "Source block copied to kill ring."))
     (devops--open-terminal-at-dir dir env-vars body)))
 
+(defun devops--block-terminal-dir (params)
+  "Return the terminal directory for a src block with PARAMS.
+Its own `:dir', else the heading's target unless the block opted out
+with `:target nil', else `default-directory'."
+  (or (cdr (assq :dir params))
+      (unless (devops--target-opted-out-p nil params)
+        (devops--heading-target-dir))
+      default-directory))
+
+;;;###autoload
+(defun devops-run-in-terminal ()
+  "Run the shell src block at point in a ghostel terminal at its target.
+The terminal is the one `devops-open-terminal-dwim' opens there, so
+the block runs where you can watch it and answer its prompts.  The
+block's :var arguments are exported first."
+  (interactive)
+  (let* ((info (and (derived-mode-p 'org-mode)
+                    (org-babel-get-src-block-info 'no-eval)))
+         (body (and (member (nth 0 info) '("sh" "bash" "shell"))
+                    (devops--src-block-body))))
+    (unless body
+      (user-error "Not in a shell src block with a body"))
+    (devops--run-in-ghostel (devops--block-terminal-dir (nth 2 info))
+                            (devops-src-block-env-vars)
+                            body)))
+
 (defun devops-unload-function ()
   "Turn `devops-mode' off, removing its advice before unloading.
 Return nil, so the rest of the unloading proceeds as usual."