emacs-config/lib/prog/jao-vterm-repl.el

;;; jao-vterm-repl.el --- vterm-based repls          -*- lexical-binding: t; -*-

;; Copyright (C) 2020, 2021  jao

;; Author: jao <mail@jao.io>
;; Keywords: terminals

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Helpers to launch reply things such as erlang shells inside a vterm.
;; For instance, to declare an erl repl for rebar projects, one would call:
;;
;;    (jao-vterm-repl-register "rebar.config" "rebar3 shell" "^[0-9]+> ")

;;; Code:

(require 'jao-compilation)

(declare-function 'vterm-copy-mode "vterm")
(declare-function 'vterm-send-string "vterm")
(declare-function 'vterm-send-return "vterm")

(defun jao-vterm-repl--buffer-name (&optional dir)
  (format "*vterm -- repl - %s*" (or dir (jao-compilation-root))))

(defvar jao-vterm-repl-repls nil)
(defvar jao-vterm-repl-prompts nil)
(defvar-local jao-vterm-repl--name nil)
(defvar-local jao-vterm-repl--last-buffer nil)
(defvar-local jao-vterm-repl--prompt-rx "^[0-9]+> ")

(setq vterm-buffer-name-string nil)

(defun jao-vterm-repl--exec (cmd &optional name)
  (vterm name)
  (when name
    (vterm-send-string "unset PROMPT_COMMAND\n\n"))
  (vterm-send-string cmd)
  (vterm-send-return)
  (when name (rename-buffer name t)))

;;;###autoload
(defun jao-vterm-repl-previous-prompt ()
  (interactive)
  (when (derived-mode-p 'vterm-mode)
    (vterm-copy-mode 1)
    (forward-line 0)
    (when (re-search-backward jao-vterm-repl--prompt-rx nil t)
      (goto-char (match-end 0)))))

;;;###autoload
(defun jao-vterm-repl-next-prompt ()
  (interactive)
  (when (derived-mode-p 'vterm-mode)
    (vterm-copy-mode 1)
    (or (re-search-forward jao-vterm-repl--prompt-rx nil t)
        (vterm-copy-mode -1))
    (unless (save-excursion
              (re-search-forward jao-vterm-repl--prompt-rx nil t))
      (vterm-copy-mode -1))))

;;;###autoload
(define-minor-mode jao-vterm-repl-mode "repl-aware vterm" nil nil
  '(("\C-c\C-p" . jao-vterm-repl-previous-prompt)
    ("\C-c\C-n" . jao-vterm-repl-next-prompt)
    ("\C-c\C-z" . jao-vterm-repl-pop-to-src)))

;;;###autoload
(defun jao-vterm-repl ()
  (let* ((dir (jao-compilation-root))
         (vname (jao-vterm-repl--buffer-name dir))
         (root-name (jao-compilation-root-file))
         (buffer (seq-find `(lambda (b)
                              (string=
                               (buffer-local-value 'jao-vterm-repl--name
                                                   b)
                               ,vname))
                           (buffer-list))))
    (or buffer
        (let ((default-directory dir)
              (prompt (cdr (assoc root-name jao-vterm-repl-prompts)))
              (cmd (or (cdr (assoc root-name jao-vterm-repl-repls))
                       (read-string "REPL command: ")))
              (bname (format "* vrepl - %s/%s *"
                             (file-name-base (string-remove-suffix "/" dir))
                             root-name)))
          (jao-vterm-repl--exec cmd bname)
          (jao-vterm-repl-mode)
          (setq-local jao-vterm-repl--name vname)
          (when prompt (setq-local jao-vterm-repl--prompt-rx prompt))
          (current-buffer)))))

;;;###autoload
(defun jao-vterm-repl-register (build-file repl-cmd prompt-rx)
  (jao-compilation-add-dominating build-file)
  (add-to-list 'jao-vterm-repl-repls (cons build-file repl-cmd))
  (add-to-list 'jao-vterm-repl-prompts (cons build-file prompt-rx)))

;;;###autoload
(defun jao-vterm-repl-pop-to-repl ()
  (interactive)
  (let ((bn (current-buffer)))
    (pop-to-buffer (jao-vterm-repl))
    (setq-local jao-vterm-repl--last-buffer bn)))

;;;###autoload
(defun jao-vterm-repl-pop-to-src ()
  (interactive)
  (when (buffer-live-p jao-vterm-repl--last-buffer)
    (pop-to-buffer jao-vterm-repl--last-buffer)))

;;;###autoload
(defun jao-vterm-repl-send (cmd)
  (with-current-buffer (jao-vterm-repl) (vterm-send-string cmd)))

(provide 'jao-vterm-repl)
;;; jao-vterm-repl.el ends here