ability to evaluate code via elm-repl-push{-decl} without switching to the REPL buffer

elm-interactive.el

@@ -59,6 +59,18 @@
 (defvar elm-interactive-prompt-regexp "^[>|] "
   "Prompt for `run-elm-interactive'.")
 
+(defcustom elm-interactive-after-push-hook '(elm--print-result)
+  "Functions to run after a declaration is pushed to the REPL."
+  :type 'hook
+  :group 'elm)
+
+(defcustom elm-interactive-flip-arg-switch-behaviour nil
+  "When this variable is non-nil, elm-repl-push commands
+(`elm-repl-push', `elm-repl-push-decl') will flip the meaning
+of their ARG-SWITCH, which see."
+   :type 'boolean
+   :group 'elm)
+
 (defcustom elm-reactor-command "elm-reactor"
   "The Elm Reactor command."
   :type '(string)
@@ -240,6 +252,16 @@ Stolen from haskell-mode."
       (setq elm-interactive--seen-prompt nil)
       (comint-send-string proc command))))
 
+(defun elm-interactive--extract-last-output ()
+  "Extract and return the last output from the REPL buffer."
+  (let ((proc (elm-interactive--get-process-buffer)))
+    (with-current-buffer (process-buffer proc)
+      (elm-interactive--wait-for-prompt proc 10)
+      (let* ((result-raw (buffer-substring (point-at-bol)
+                                           (save-excursion (re-search-forward comint-prompt-regexp)
+                                                           (re-search-backward comint-prompt-regexp)))))
+        (s-trim (replace-regexp-in-string "^\|+" "" result-raw))))))
+
 (defun elm-interactive-kill-current-session ()
   "Stop the current REPL session and delete its buffer."
   (interactive)
@@ -265,28 +287,34 @@ Stolen from haskell-mode."
   (turn-on-elm-font-lock))
 
 ;;;###autoload
-(defun run-elm-interactive ()
-  "Run an inferior instance of `elm-repl' inside Emacs."
-  (interactive)
+(defun run-elm-interactive (no-switch)
+  "Run an inferior instance of `elm-repl' inside Emacs.
+
+If universal argument NO-SWITCH is non-nil, then do not switch to the REPL buffer."
+  (interactive "P")
   (elm-interactive-kill-current-session)
   (let* ((default-directory (elm--find-dependency-file-path))
          (buffer (comint-check-proc elm-interactive--process-name))
          (origin (point-marker)))
 
     (setq elm-interactive--current-project default-directory)
 
-    (pop-to-buffer
-     (if (or buffer (not (derived-mode-p 'elm-interactive-mode))
-             (comint-check-proc (current-buffer)))
-         (get-buffer-create (or buffer elm-interactive--buffer-name))
-       (current-buffer)))
+    (with-current-buffer
+        (if (or buffer (not (derived-mode-p 'elm-interactive-mode))
+                (comint-check-proc (current-buffer)))
+            (get-buffer-create (or buffer elm-interactive--buffer-name))
+          (current-buffer))
+
+      (unless buffer
+        (apply #'make-comint-in-buffer elm-interactive--process-name buffer
+               elm-interactive-command nil elm-interactive-arguments)
+        (elm-interactive-mode))
 
-    (unless buffer
-      (apply #'make-comint-in-buffer elm-interactive--process-name buffer
-             elm-interactive-command nil elm-interactive-arguments)
-      (elm-interactive-mode))
+      (setq-local elm-repl--origin origin)
+      (setq buffer (current-buffer)) )
 
-    (setq-local elm-repl--origin origin)))
+    (unless no-switch
+      (pop-to-buffer buffer) ) ))
 
 (defun elm-repl-return-to-origin ()
   "Jump back to the location from which we last jumped to the repl."
@@ -311,25 +339,60 @@ of the file specified."
     (elm-interactive--send-command import-statement)))
 
 ;;;###autoload
-(defun elm-repl-push (beg end)
-  "Push the region from BEG to END to an interactive REPL."
-  (interactive "r")
-  (let* ((to-push (buffer-substring-no-properties beg end))
-         (lines (split-string (s-trim-right to-push) "\n")))
-    (run-elm-interactive)
+(defun elm-repl-push (beg end arg-switch)
+  "Push the region from BEG to END to an interactive REPL.
+
+If universal argument ARG-SWITCH is not given (default), switch to the REPL
+buffer after the push; otherwise stay in the current buffer.
+\nIf `elm-interactive-flip-arg-switch-behaviour' is non-nil, reverse this behaviour
+(This makes staying in the current buffer after a push the default).
+\nAfter the push, any functions in `elm-interactive-after-push-hook' will be run
+with the last output extracted from the REPL buffer."
+  (interactive "r\nP")
+
+  (let ((lines (elm--get-region beg end)))
+
+    (run-elm-interactive
+     (xor arg-switch
+          elm-interactive-flip-arg-switch-behaviour))
+
     (dolist (line lines)
       (elm-interactive--send-command (concat line " \\\n")))
-    (elm-interactive--send-command "\n")))
+    (elm-interactive--send-command "\n")
+
+    (if elm-interactive-after-push-hook
+        (run-hook-with-args 'elm-interactive-after-push-hook
+                            (elm-interactive--extract-last-output)
+                            beg
+                            end))) )
 
 ;;;###autoload
-(defun elm-repl-push-decl ()
-  "Push the current top level declaration to the REPL."
-  (interactive)
-  (let ((lines (elm--get-decl)))
-    (run-elm-interactive)
+(defun elm-repl-push-decl (arg-switch)
+  "Push the current top level declaration to the REPL.
+
+If universal argument ARG-SWITCH is not given (default), switch to the REPL
+buffer after the push; otherwise stay in the current buffer.
+\nIf `elm-interactive-flip-arg-switch-behaviour' is non-nil, reverse this behaviour
+(This makes staying in the current buffer after a push the default).
+\nAfter the push, any functions in `elm-interactive-after-push-hook' will be run
+with the last output extracted from the REPL buffer."
+  (interactive "P")
+
+  (cl-multiple-value-bind (lines decl-beg decl-end) (elm--get-decl)
+
+    (run-elm-interactive
+     (xor arg-switch
+          elm-interactive-flip-arg-switch-behaviour))
+
     (dolist (line lines)
       (elm-interactive--send-command (concat line " \\\n")))
-    (elm-interactive--send-command "\n")))
+    (elm-interactive--send-command "\n")
+
+    (if elm-interactive-after-push-hook
+        (run-hook-with-args 'elm-interactive-after-push-hook
+                            (elm-interactive--extract-last-output)
+                            decl-beg
+                            decl-end))))
 
 
 ;;; Reactor:

elm-util.el

@@ -36,6 +36,11 @@
   :type 'string
   :group 'elm-util)
 
+(defcustom elm--get-decl/flash-duration 0.40
+  "Time in seconds the declaration found by `elm--get-decl' will be highlighted."
+  :type 'number
+  :group 'elm-util)
+
 (defconst elm-package-json
   "elm-package.json"
   "The name of the package JSON configuration file.")
@@ -49,24 +54,38 @@
     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
 
 (defun elm--get-decl ()
-  "Return the current declaration.
+  "Return the current declaration as a list of lines, together with the beginning and end of its region.
 
 Relies on `haskell-mode' stuff."
   (unless (fboundp #'haskell-ds-backward-decl)
     (error "This functionality requires haskell-mode"))
 
   (save-excursion
     (goto-char (1+ (point)))
-    (let* ((start (or (haskell-ds-backward-decl) (point-min)))
-           (end (or (haskell-ds-forward-decl) (point-max)))
-           (raw-decl (s-trim-right (buffer-substring start end)))
+    (let* ((decl-beg (or (haskell-ds-backward-decl) (point-min)))
+           (decl-end (or (haskell-ds-forward-decl) (point-max)))
+           (raw-decl (s-trim-right (buffer-substring decl-beg decl-end)))
            (lines (split-string raw-decl "\n"))
            (first-line (car lines)))
 
-      (inferior-haskell-flash-decl start end)
-      (if (string-match-p "^[a-z].*:" first-line)
-          (cdr lines)
-        lines))))
+      (inferior-haskell-flash-decl decl-beg decl-end elm--get-decl/flash-duration)
+
+      (cl-values
+       (if (string-match-p "^[a-z].*:" first-line)
+           (cdr lines)
+         lines)
+       decl-beg
+       decl-end))))
+
+(defun elm--get-region (beg end)
+  "Return the region between BEG and END as a list of lines."
+  (let* ((to-push (buffer-substring-no-properties beg end))
+         (lines (split-string (s-trim-right to-push) "\n")))
+    lines))
+
+(defun elm--print-result (result &rest r)
+  "Display the first line of RESULT in the echo area."
+  (princ (car (split-string result "\n")) ))
 
 (defun elm--build-import-statement ()
   "Generate a statement that will import the current module."
@@ -126,5 +145,10 @@ cases."
       ("fish" "; and ")
       (_ " && "))))
 
+
+(defmacro xor (a b)
+  `(if ,a (not ,b) ,b))
+
+
 (provide 'elm-util)
 ;;; elm-util.el ends here