Merge branch 'term'

2 files changed, 119 insertions, 26 deletions

diff --git a/NEWS b/NEWS
index fe95a23..3c33003 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,15 @@
 NEWS -- history of user-visible changes             -*- mode: org; -*-
 
+* master (unreleased)
+
+** New features
+
+- ~snakemake-popup~ commands learned to call Snakemake through a
+  terminal rather than through ~compile~.  This allows a persistent
+  environment to be maintained between Snakemake calls, which is
+  useful for running Snakemake in isolated environments created by
+  tools like Guix.
+
 * v1.1.0
 
 ** New features
diff --git a/snakemake.el b/snakemake.el
index ab56ae5..99473fc 100644
--- a/snakemake.el
+++ b/snakemake.el
@@ -25,9 +25,9 @@
 ;; `snakemake-popup', which you should consider giving a global key
 ;; binding.
 ;;
-;; The popup currently includes four actions, all which lead to
-;; `compile' being called with "snakemake ...".  What's different
-;; between the actions is how targets are selected.
+;; The popup currently includes four actions, all which lead to a
+;; Snakemake call.  What's different between the actions is how
+;; targets are selected.
 ;;
 ;; snakemake-build-targets-at-point
 ;;
@@ -39,10 +39,9 @@
 ;;     names from Dired, Org links, and general text under point that
 ;;     looks like a file name.
 ;;
-;; snakemake-compile
+;; snakemake-build
 ;;
-;;     This action leads to an interactive `compile' call that allows
-;;     you to edit the command before it is run.
+;;     This action allows you to edit the command before running it.
 ;;
 ;;     It tries to guess what the target name should be, but it
 ;;     doesn't verify if this target is actually a build target.  This
@@ -75,6 +74,10 @@
 ;; which to look for a Snakefile if there isn't one in the current
 ;; directory.
 ;;
+;; By default, commands are executed through `compile'.  However, a
+;; terminal can be created with `snakemake-term-start', in which case
+;; commands are sent there instead.
+;;
 ;; In addition to the popup commands, there are commands for showing
 ;; and saving the dependency graph of a target.  The command
 ;; `snakemake-graph' displays the graph in a buffer.  From this
@@ -88,6 +91,7 @@
 
 (require 'cl-lib)
 (require 'compile)
+(require 'term)
 (require 'magit-popup)
 
 (require 'snakemake-mode)
@@ -105,6 +109,11 @@
   :type 'string
   :package-version '(snakemake-mode . "0.4.0"))
 
+(defcustom snakemake-shell-file-name shell-file-name
+  "Program used by `ansi-term' to start a terminal."
+  :type 'string
+  :package-version '(snakemake-mode . "1.2.0"))
+
 (defcustom snakemake-file-target-program
   (executable-find "snakemake-file-targets")
   "Program that returns newline-delimited list of output files."
@@ -541,7 +550,14 @@ Snakemake-graph mode is a minor mode that provides a key,
   :keymap snakemake-graph-mode-map)
 
 
-;;; Compilation commands
+;;; Commands for calling Snakemake
+
+(defun snakemake--make-command (targets args)
+  (mapconcat #'identity
+             `(,snakemake-program ,@args "--" ,@targets)
+             " "))
+
+;;;; Compilation interface
 
 (add-to-list 'compilation-error-regexp-alist 'snakemake)
 (add-to-list
@@ -549,25 +565,79 @@ Snakemake-graph mode is a minor mode that provides a key,
  '(snakemake . ("^SyntaxError in line \\([0-9]+\\) of \\(.*[^A-z]Snakefile\\):$"
                 2 1)))
 
-(defun snakemake--define-compile-command (targets args)
-  (mapconcat #'identity
-             `(,snakemake-program ,@args "--" ,@targets)
-             " "))
-
 (defun snakemake-compile-targets (targets args)
   "Run non-interactive `compile' with 'snakemake [ARGS] -- TARGETS'."
   (let ((default-directory (snakemake-snakefile-directory))
-        (cmd (snakemake--define-compile-command targets args)))
+        (cmd (snakemake--make-command targets args)))
     (compile cmd)
     (push cmd compile-history)))
 
+;;;; Terminal interface
+
+(defun snakemake-term--name ()
+  (concat "snakemake-terminal: " (abbreviate-file-name default-directory)))
+
+(defun snakemake-term-process ()
+  "Return the terminal process of the current directory."
+  (get-process (concat "*" (snakemake-term--name) "*")))
+
+(defun snakemake-term-start ()
+  "Start a terminal session for the current Snakefile directory.
+
+The main advantage of using a terminal is that it allows for a
+persistent environment between Snakemake calls, which is useful
+for running Snakemake in isolated environments created by tools
+like Guix.
+
+To do so, `snakemake-shell-file-name' should be set to a script
+that starts a shell with the desired environment.  For example,
+to set up an enviroment with Guix, `snakemake-shell-file-name'
+could point to a script that runs
+
+    guix environment -l manifest.scm --ad-hoc snakemake --pure"
+  (interactive)
+  (let ((default-directory (snakemake-snakefile-directory)))
+    (unless (snakemake-term-process)
+      (ansi-term snakemake-shell-file-name (snakemake-term--name)))))
+
+(defun snakemake-term-send (string)
+  "Send STRING to the terminal for the current directory."
+  (let* ((proc (or (snakemake-term-process)
+                   (user-error "No active terminal.  Start with %s"
+                               (substitute-command-keys
+                                "`\\[snakemake-term-start]'"))))
+         (buf (process-buffer proc)))
+    (unless (get-buffer-window buf)
+      (display-buffer buf))
+    (term-send-string proc (concat string "\n"))
+    (with-current-buffer buf
+      (goto-char (process-mark proc)))))
+
+(defun snakemake-term-build-targets (targets args)
+  "Send 'snakemake [ARGS] -- TARGETS' to the terminal."
+  (let ((default-directory (snakemake-snakefile-directory)))
+    (snakemake-term-send (snakemake--make-command targets args))))
+
+;;;; General interface
+
+(defun snakemake-build-targets (targets args)
+  "Run 'snakemake [ARGS] -- TARGETS'.
+If a terminal is associated with the current Snakefile directory,
+send the command there.  Otherwise, run the command with
+`compile'."
+  (funcall (if (snakemake-term-process)
+               #'snakemake-term-build-targets
+             #'snakemake-compile-targets)
+           targets
+           args))
+
 ;;;###autoload
 (defun snakemake-build-targets-at-point (&optional args)
   "Build target(s) at point without any prompts.
 
 $ snakemake [ARGS] -- <targets>"
   (interactive (list (snakemake-arguments)))
-  (snakemake-compile-targets
+  (snakemake-build-targets
    (or (snakemake-file-targets-at-point 'check)
        (snakemake-rule-at-point 'target)
        (user-error "No target found at point"))
@@ -579,7 +649,7 @@ $ snakemake [ARGS] -- <targets>"
 
 $ snakemake [ARGS] -- <file>"
   (interactive (list (snakemake-arguments)))
-  (snakemake-compile-targets
+  (snakemake-build-targets
    (list (snakemake-read-file-target))
    args))
 
@@ -589,24 +659,37 @@ $ snakemake [ARGS] -- <file>"
 
 $ snakemake [ARGS] -- <rule>"
   (interactive (list (snakemake-arguments)))
-  (snakemake-compile-targets
+  (snakemake-build-targets
    (list (snakemake-read-rule 'targets))
    args))
 
 ;;;###autoload
-(defun snakemake-compile (&optional args)
-  "Read `compile' command for building targets.
+(defun snakemake-build (&optional args)
+  "Read and run a Snakemake command for building targets.
+
+If a terminal is associated with the current Snakefile directory,
+send the command there.  Otherwise, run the command with
+`compile'.
+
+To start a terminal for the current Snakefile directory, run
+`\\[snakemake-term-start]'.
 
 $ snakemake [ARGS] -- <targets>"
   (interactive (list (snakemake-arguments)))
-  (let ((compile-command (snakemake--define-compile-command
-                          (or (snakemake-file-targets-at-point)
-                              (snakemake-rule-at-point)
-                              (list ""))
-                          args))
-        (compilation-read-command t)
+  (let ((cmd (snakemake--make-command
+              (or (snakemake-file-targets-at-point)
+                  (snakemake-rule-at-point)
+                  (list ""))
+              args))
         (default-directory (snakemake-snakefile-directory)))
-    (call-interactively #'compile)))
+    (if (snakemake-term-process)
+        (snakemake-term-send
+         (read-from-minibuffer "Command to send to terminal: " cmd))
+      (let ((compile-command cmd)
+            (compilation-read-command t))
+        (call-interactively #'compile)))))
+
+(define-obsolete-function-alias 'snakemake-compile 'snakemake-build "1.2.0")
 
 ;;;###autoload (autoload 'snakemake-popup "snakemake" nil t)
 (magit-define-popup snakemake-popup
@@ -622,7 +705,7 @@ $ snakemake [ARGS] -- <targets>"
   '((?a "Allowed rules" "--allowed-rules " snakemake-read-rules)
     (?j "Number of jobs" "-j"))
   :actions
-  '((?c "Compile" snakemake-compile) nil nil
+  '((?c "Edit and run command" snakemake-build) nil nil
     (?p "Build target at point" snakemake-build-targets-at-point)
     (?f "Build file" snakemake-build-file-target)
     (?r "Build rule" snakemake-build-rule-target))