elisp/geiser-repl.el

   1 ;;; geiser-repl.el --- Geiser's REPL
   2
   3 ;; Copyright (C) 2009  Jose Antonio Ortega Ruiz
   4
   5 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   6 ;; Keywords: languages, tools
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; Major mode (comint-based) to interact with a Scheme REPL.
  24
  25 ;;; Code:
  26
  27 (require 'geiser-autodoc)
  28 (require 'geiser-edit)
  29 (require 'geiser-impl)
  30 (require 'geiser-eval)
  31 (require 'geiser-connection)
  32 (require 'geiser-custom)
  33 (require 'geiser-base)
  34
  35 (require 'comint)
  36
  37 \f
  38 ;;; Customization:
  39
  40 (defgroup geiser-repl nil
  41   "Interacting with the Geiser REPL."
  42   :group 'geiser)
  43
  44 (defcustom geiser-repl-use-other-window t
  45   "Whether to Use a window other than the current buffer's when
  46 switching to the Geiser REPL buffer."
  47   :type 'boolean
  48   :group 'geiser-repl)
  49
  50 (defcustom geiser-repl-window-allow-split t
  51   "Whether to allow window splitting when switching to the Geiser
  52 REPL buffer."
  53   :type 'boolean
  54   :group 'geiser-repl)
  55
  56 (defcustom geiser-repl-history-filename (expand-file-name "~/.geiser_history")
  57   "File where REPL input history is saved, so that it persists between sessions.
  58 This is actually the base name: the concrete Scheme
  59 implementation name gets appended to it."
  60   :type 'filename
  61   :group 'geiser-repl)
  62
  63 (defcustom geiser-repl-history-size comint-input-ring-size
  64   "Maximum size of the saved REPL input history."
  65   :type 'integer
  66   :group 'geiser-repl)
  67
  68 (defcustom geiser-repl-autodoc-p t
  69   "Whether to enable `geiser-autodoc-mode' in the REPL by default."
  70   :type 'boolean
  71   :group 'geiser-repl)
  72
  73 (defcustom geiser-repl-read-only-prompt-p t
  74   "Whether the REPL's prompt should be read-only."
  75   :type 'boolean
  76   :group 'geiser-repl)
  77
  78 \f
  79 ;;; Geiser REPL buffers and processes:
  80
  81 (defvar geiser-repl--repls nil)
  82 (defvar geiser-repl--closed-repls nil)
  83
  84 (make-variable-buffer-local
  85  (defvar geiser-repl--repl nil))
  86
  87 (defsubst geiser-repl--this-buffer-repl ()
  88   geiser-repl--repl)
  89
  90 (defsubst geiser-repl--set-this-buffer-repl (r)
  91   (setq geiser-repl--repl r))
  92
  93 (defun geiser-repl--repl/impl (impl &optional repls)
  94   (catch 'repl
  95     (dolist (repl (or repls geiser-repl--repls))
  96       (with-current-buffer repl
  97         (when (eq geiser-impl--implementation impl)
  98           (throw 'repl repl))))))
  99
 100 (defun geiser-repl--get-repl (&optional impl)
 101   (or (and (not impl) geiser-repl--repl)
 102       (setq geiser-repl--repl
 103             (let ((impl (or impl
 104                             geiser-impl--implementation
 105                             (geiser-impl--guess))))
 106               (when impl (geiser-repl--repl/impl impl))))))
 107
 108 (defun geiser-repl--active-impls ()
 109   (let ((act))
 110     (dolist (repl geiser-repl--repls act)
 111       (with-current-buffer repl
 112         (add-to-list 'act geiser-impl--implementation)))))
 113
 114 (defsubst geiser-repl--repl-name (impl)
 115   (format "%s REPL" (geiser-impl--impl-str impl)))
 116
 117 (defun geiser-repl--to-repl-buffer (impl)
 118   (unless (and (eq major-mode 'geiser-repl-mode)
 119                (not (get-buffer-process (current-buffer))))
 120     (let* ((old (geiser-repl--repl/impl impl geiser-repl--closed-repls))
 121            (old (and (buffer-live-p old) old)))
 122       (pop-to-buffer
 123        (or old
 124            (generate-new-buffer (format "* %s *"
 125                                         (geiser-repl--repl-name impl)))))))
 126   (geiser-repl-mode)
 127   (geiser-impl--set-buffer-implementation impl))
 128
 129 (defun geiser-repl--start-repl (impl)
 130   (message "Starting Geiser REPL for %s ..." impl)
 131   (geiser-repl--to-repl-buffer impl)
 132   (let ((binary (geiser-impl--binary impl))
 133         (args (geiser-impl--parameters impl))
 134         (prompt-rx (geiser-impl--prompt-regexp impl))
 135         (cname (geiser-repl--repl-name impl)))
 136     (unless (and binary prompt-rx)
 137       (error "Sorry, I don't know how to start a REPL for %s" impl))
 138     (set (make-local-variable 'comint-prompt-regexp) prompt-rx)
 139     (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,binary nil ,@args))
 140     (geiser-repl--wait-for-prompt 10000)
 141     (geiser-repl--history-setup)
 142     (geiser-con--setup-connection (current-buffer) prompt-rx)
 143     (add-to-list 'geiser-repl--repls (current-buffer))
 144     (geiser-impl--startup impl)
 145     (geiser-repl--set-this-buffer-repl (current-buffer))))
 146
 147 (defun geiser-repl--process ()
 148   (let ((buffer (geiser-repl--get-repl geiser-impl--implementation)))
 149     (or (and (buffer-live-p buffer) (get-buffer-process buffer))
 150         (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
 151
 152 (setq geiser-eval--default-proc-function 'geiser-repl--process)
 153
 154 (defun geiser-repl--wait-for-prompt (timeout)
 155   (let ((p (point)) (seen))
 156     (while (and (not seen) (> timeout 0))
 157       (sleep-for 0.1)
 158       (setq timeout (- timeout 100))
 159       (goto-char p)
 160       (setq seen (re-search-forward comint-prompt-regexp nil t)))
 161     (goto-char (point-max))
 162     (unless seen (error "No prompt found!"))))
 163
 164 \f
 165 ;;; Interface: starting and interacting with geiser REPL:
 166
 167 (defun geiser-repl--read-impl (prompt &optional active)
 168   (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))
 169
 170 (defsubst geiser-repl--only-impl-p ()
 171   (and (null (cdr geiser-impl--impls))
 172        (car geiser-impl--impls)))
 173
 174 (defun run-geiser (impl)
 175   "Start a new Geiser REPL."
 176   (interactive
 177    (list (or (geiser-repl--only-impl-p)
 178              (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation)
 179              (geiser-repl--read-impl "Start Geiser for scheme implementation: "))))
 180    (geiser-repl--start-repl impl))
 181
 182 (defun switch-to-geiser (&optional ask impl)
 183   "Switch to running Geiser REPL.
 184 With prefix argument, ask for which one if more than one is running.
 185 If no REPL is running, execute `run-geiser' to start a fresh one."
 186   (interactive "P")
 187   (let* ((impl (or impl geiser-impl--implementation))
 188          (repl (cond ((and (not ask) (not impl)
 189                            (or (geiser-repl--this-buffer-repl)
 190                                (car geiser-repl--repls))))
 191                      ((and (not ask) impl (geiser-repl--repl/impl impl)))))
 192          (pop-up-windows geiser-repl-window-allow-split))
 193     (if repl
 194         (pop-to-buffer repl)
 195       (run-geiser (or impl
 196                       (and (not ask)
 197                            (geiser-repl--only-impl-p))
 198                       (geiser-repl--read-impl "Switch to scheme REPL: "))))))
 199
 200 (defalias 'geiser 'switch-to-geiser)
 201
 202 (defun geiser-repl-nuke ()
 203   "Try this command if the REPL becomes unresponsive."
 204   (interactive)
 205   (goto-char (point-max))
 206   (comint-kill-region comint-last-input-start (point))
 207   (comint-redirect-cleanup)
 208   (geiser-con--setup-connection (current-buffer)
 209                                 comint-prompt-regexp))
 210
 211 \f
 212 ;;; REPL history and clean-up:
 213
 214 (defsubst geiser-repl--history-file ()
 215   (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))
 216
 217 (defun geiser-repl--on-quit ()
 218   (comint-write-input-ring)
 219   (let ((cb (current-buffer))
 220         (impl geiser-impl--implementation)
 221         (comint-prompt-read-only nil))
 222     (setq geiser-repl--repls (remove cb geiser-repl--repls))
 223     (dolist (buffer (buffer-list))
 224       (with-current-buffer buffer
 225         (when (and (eq geiser-impl--implementation impl)
 226                    (equal cb (geiser-repl--this-buffer-repl)))
 227           (geiser-repl--get-repl geiser-impl--implementation))))))
 228
 229 (defun geiser-repl--sentinel (proc event)
 230   (when (string= event "finished\n")
 231     (with-current-buffer (process-buffer proc)
 232       (let ((comint-prompt-read-only nil)
 233             (comint-input-ring-file-name (geiser-repl--history-file)))
 234         (geiser-repl--on-quit)
 235         (push (current-buffer) geiser-repl--closed-repls)
 236         (when (buffer-name (current-buffer))
 237           (comint-kill-region comint-last-input-start (point))
 238           (insert "\nIt's been nice interacting with you!\n")
 239           (insert "Press C-cz to bring me back.\n" ))))))
 240
 241 (defun geiser-repl--on-kill ()
 242   (geiser-repl--on-quit)
 243   (setq geiser-repl--closed-repls
 244         (remove (current-buffer) geiser-repl--closed-repls)))
 245
 246 (defun geiser-repl--input-filter (str)
 247   (and (not (string-match "^\\s *$" str))
 248        (not (string-match "^,quit *$" str))))
 249
 250 (defun geiser-repl--history-setup ()
 251   (set (make-local-variable 'comint-input-ring-file-name)
 252        (geiser-repl--history-file))
 253   (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
 254   (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
 255   (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t)
 256   (comint-read-input-ring t)
 257   (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel))
 258
 259 \f
 260 ;;; geiser-repl mode:
 261
 262 (defun geiser-repl--bol ()
 263   (interactive)
 264   (when (= (point) (comint-bol)) (beginning-of-line)))
 265
 266 (defun geiser-repl--beginning-of-defun ()
 267   (let ((p (point)))
 268     (comint-bol)
 269     (when (not (eq (char-after (point)) ?\())
 270       (skip-syntax-forward "^(" p))))
 271
 272 (defun geiser-repl--module-function (&optional ignore) :f)
 273
 274 (defun geiser-repl--doc-module ()
 275   (interactive)
 276   (let ((geiser-eval--get-module-function
 277          (geiser-impl--module-function geiser-impl--implementation)))
 278     (geiser-doc-module)))
 279
 280 (define-derived-mode geiser-repl-mode comint-mode "Geiser REPL"
 281   "Major mode for interacting with an inferior scheme repl process.
 282 \\{geiser-repl-mode-map}"
 283   (set (make-local-variable 'mode-line-process) nil)
 284   (set (make-local-variable 'comint-use-prompt-regexp) t)
 285   (set (make-local-variable 'comint-prompt-read-only)
 286        geiser-repl-read-only-prompt-p)
 287   (set (make-local-variable 'beginning-of-defun-function)
 288        'geiser-repl--beginning-of-defun)
 289   (set-syntax-table scheme-mode-syntax-table)
 290   (setq geiser-eval--get-module-function 'geiser-repl--module-function)
 291   (when geiser-repl-autodoc-p (geiser-autodoc-mode 1)))
 292
 293 (define-key geiser-repl-mode-map "\C-d" 'delete-char)
 294
 295 (define-key geiser-repl-mode-map "\C-cz" 'run-geiser)
 296 (define-key geiser-repl-mode-map "\C-c\C-z" 'run-geiser)
 297 (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
 298 (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
 299 (define-key geiser-repl-mode-map "\C-ca" 'geiser-autodoc-mode)
 300 (define-key geiser-repl-mode-map "\C-cd" 'geiser-doc-symbol-at-point)
 301 (define-key geiser-repl-mode-map "\C-cm" 'geiser-repl--doc-module)
 302 (define-key geiser-repl-mode-map "\C-ck" 'geiser-compile-file)
 303 (define-key geiser-repl-mode-map "\C-cl" 'geiser-load-file)
 304
 305 (define-key geiser-repl-mode-map "\M-p" 'comint-previous-matching-input-from-input)
 306 (define-key geiser-repl-mode-map "\M-n" 'comint-next-matching-input-from-input)
 307 (define-key geiser-repl-mode-map "\C-c\M-p" 'comint-previous-input)
 308 (define-key geiser-repl-mode-map "\C-c\M-n" 'comint-next-input)
 309
 310 (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-completion--complete-symbol)
 311 (define-key geiser-repl-mode-map (kbd "M-TAB") 'geiser-completion--complete-symbol)
 312 (define-key geiser-repl-mode-map (kbd "M-`") 'geiser-completion--complete-module)
 313 (define-key geiser-repl-mode-map (kbd "C-.") 'geiser-completion--complete-module)
 314 (define-key geiser-repl-mode-map "\M-." 'geiser-edit-symbol-at-point)
 315 (define-key geiser-repl-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack)
 316
 317 \f
 318 ;;; Unload:
 319
 320 (defun geiser-repl--repl-list ()
 321   (let (lst)
 322     (dolist (repl geiser-repl--repls lst)
 323       (when (buffer-live-p repl)
 324         (with-current-buffer repl
 325           (push geiser-impl--implementation lst))))))
 326
 327 (defun geiser-repl--restore (impls)
 328   (dolist (impl impls)
 329     (when impl (geiser nil impl))))
 330
 331 (defun geiser-repl-unload-function ()
 332   (dolist (repl geiser-repl--repls)
 333     (when (buffer-live-p repl)
 334       (kill-buffer repl))))
 335
 336 \f
 337 (provide 'geiser-repl)
 338 ;;; geiser-repl.el ends here