From 2a405226f2ab484d880dea9f01f64d3d06f1d150 Mon Sep 17 00:00:00 2001
From: Bozhidar Batsov <bozhidar@batsov.dev>
Date: Mon, 18 Jul 2022 21:40:52 +0300
Subject: [PATCH] Add commands to switch to and from a utop buffer

Those are extremely common in Emacs modes and allow people to
quickly jump to a REPL and back to the last source buffer they
were editing, while using the same keybinding.

I've modeled the implementation here after that of inf-clojure (a similar
mode written by me). I've also implemented a mode menu for
utop-minor-mode, so it's easier for the users to discover its
functionality.
---
 README.md       | 15 +++++++-------
 src/top/utop.el | 54 ++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 59 insertions(+), 10 deletions(-)

diff --git a/README.md b/README.md
index 76bbac8..5fed2b9 100644
--- a/README.md
+++ b/README.md
@@ -218,13 +218,14 @@ You can start utop inside Emacs with: `M-x utop`.
 
 `utop.el` also ships with a minor mode that has the following key-bindings:
 
-| key-binding | function          | Description                  |
-|-------------|-------------------|------------------------------|
-| C-c C-s     | utop              | Start a utop buffer          |
-| C-x C-e     | utop-eval-phrase  | Evaluate the current phrase  |
-| C-x C-r     | utop-eval-region  | Evaluate the selected region |
-| C-c C-b     | utop-eval-buffer  | Evaluate the current buffer  |
-| C-c C-k     | utop-kill         | Kill a running utop process  |
+| key-binding | function            | Description                  |
+|-------------|---------------------|------------------------------|
+| C-c C-s     | utop                | Start a utop buffer          |
+| C-x C-e     | utop-eval-phrase    | Evaluate the current phrase  |
+| C-x C-r     | utop-eval-region    | Evaluate the selected region |
+| C-c C-b     | utop-eval-buffer    | Evaluate the current buffer  |
+| C-c C-k     | utop-kill           | Kill a running utop process  |
+| C-c C-z     | utop-switch-to-repl | Switch to utop process       |
 
 You can enable the minor mode using `M-x utop-minor-mode`, or you can
 have it enabled by default with the following configuration:
diff --git a/src/top/utop.el b/src/top/utop.el
index 6d8dfdf..f7c5dd4 100644
--- a/src/top/utop.el
+++ b/src/top/utop.el
@@ -25,6 +25,7 @@
 
 (require 'easymenu)
 (require 'pcase)
+(require 'seq)
 (require 'tabulated-list)
 (require 'tuareg)
 
@@ -885,6 +886,32 @@ If ADD-TO-HISTORY is t then the input will be added to history."
         (goto-char utop-prompt-max)
       (move-beginning-of-line 1))))
 
+;; +-----------------------------------------------------------------+
+;; | Switch to REPL                                                  |
+;; +-----------------------------------------------------------------+
+
+(defun utop-switch-to-repl (eob-p)
+  "Switch to the inferior utop process buffer.
+With prefix argument EOB-P, positions cursor at end of buffer."
+  (interactive "P")
+  (if (get-buffer-process utop-buffer-name)
+      (pop-to-buffer utop-buffer-name)
+    (call-interactively #'utop))
+  (when eob-p
+    (push-mark)
+    (goto-char (point-max))))
+
+(defun utop-switch-to-recent-buffer ()
+  "Switch to the most recently used `utop-minor-mode' buffer."
+  (interactive)
+  (let ((recent-utop-minor-mode-buffer (seq-find (lambda (buf)
+                                                          (with-current-buffer buf (bound-and-true-p utop-minor-mode)))
+                                                        (buffer-list))))
+    (if recent-utop-minor-mode-buffer
+        (pop-to-buffer recent-utop-minor-mode-buffer)
+      (message "utop: No recent OCaml buffer found."))))
+
+
 ;; +-----------------------------------------------------------------+
 ;; | Process control                                                 |
 ;; +-----------------------------------------------------------------+
@@ -1100,6 +1127,25 @@ See https://github.com/ocaml-community/utop for configuration information."))
             (define-key map (kbd "C-x C-r") #'utop-eval-region)
             (define-key map (kbd "C-c C-b") #'utop-eval-buffer)
             (define-key map (kbd "C-c C-k") #'utop-kill)
+            (define-key map (kbd "C-c C-z") #'utop-switch-to-repl)
+            (easy-menu-define
+              utop-minor-mode-menu map
+              "utop menu."
+              '("utop"
+                ["Start utop" utop t]
+                ["Switch to utop" utop-switch-to-repl t]
+                ["Interrupt utop" utop-interrupt :active (utop-is-running)]
+                ["Kill utop" utop-kill :active (utop-is-running)]
+                ["Exit utop gracefully" utop-exit :active (utop-is-running)]
+                "---"
+                ["Evaluate phrase" utop-eval-phrase :active (and (utop-is-running) (eq utop-state 'edit))]
+                ["Evaluate region" utop-eval-region :active (and (utop-is-running) (eq utop-state 'edit))]
+                ["Evaluate buffer" utop-eval-buffer :active (and (utop-is-running) (eq utop-state 'edit))]
+                "---"
+                ["Customize utop" (customize-group 'utop) t]
+                "---"
+                ["About" utop-about t]
+                ["Help" utop-help t]))
             map)
   ;; Load local file variables
   (add-hook 'hack-local-variables-hook 'utop-hack-local-variables))
@@ -1128,11 +1174,13 @@ See https://github.com/ocaml-community/utop for configuration information."))
   utop-menu utop-mode-map
   "utop menu."
   '("utop"
-    ["Start OCaml" utop t]
-    ["Interrupt OCaml" utop-interrupt :active (utop-is-running)]
-    ["Kill OCaml" utop-kill :active (utop-is-running)]
+    ["Start utop" utop t]
+    ["Interrupt utop" utop-interrupt :active (utop-is-running)]
+    ["Kill utop" utop-kill :active (utop-is-running)]
     ["Exit utop gracefully" utop-exit :active (utop-is-running)]
+    "---"
     ["Evaluate Phrase" utop-eval-input-auto-end :active (and (utop-is-running) (eq utop-state 'edit))]
+    ["Switch to OCaml source buffer" utop-switch-to-recent-buffer t]
     "---"
     ["Customize utop" (customize-group 'utop) t]
     "---"