elisp/geiser-repl.el

   1 ;;; geiser-repl.el --- Geiser's REPL
   2
   3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
   4
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the Modified BSD License. You should
   7 ;; have received a copy of the license along with this program. If
   8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
   9
  10 \f
  11
  12 (require 'geiser-company)
  13 (require 'geiser-autodoc)
  14 (require 'geiser-edit)
  15 (require 'geiser-impl)
  16 (require 'geiser-eval)
  17 (require 'geiser-connection)
  18 (require 'geiser-menu)
  19 (require 'geiser-custom)
  20 (require 'geiser-base)
  21
  22 (require 'comint)
  23 (require 'compile)
  24 (require 'scheme)
  25
  26 \f
  27 ;;; Customization:
  28
  29 (defgroup geiser-repl nil
  30   "Interacting with the Geiser REPL."
  31   :group 'geiser)
  32
  33 (geiser-custom--defcustom geiser-repl-use-other-window t
  34   "Whether to Use a window other than the current buffer's when
  35 switching to the Geiser REPL buffer."
  36   :type 'boolean
  37   :group 'geiser-repl)
  38
  39 (geiser-custom--defcustom geiser-repl-window-allow-split t
  40   "Whether to allow window splitting when switching to the Geiser
  41 REPL buffer."
  42   :type 'boolean
  43   :group 'geiser-repl)
  44
  45 (geiser-custom--defcustom geiser-repl-history-filename (expand-file-name "~/.geiser_history")
  46   "File where REPL input history is saved, so that it persists between sessions.
  47 This is actually the base name: the concrete Scheme
  48 implementation name gets appended to it."
  49   :type 'filename
  50   :group 'geiser-repl)
  51
  52 (geiser-custom--defcustom geiser-repl-history-size comint-input-ring-size
  53   "Maximum size of the saved REPL input history."
  54   :type 'integer
  55   :group 'geiser-repl)
  56
  57 (geiser-custom--defcustom geiser-repl-history-no-dups-p t
  58    "Whether to skip duplicates when recording history."
  59    :type 'boolean
  60    :group 'geiser-repl)
  61
  62 (geiser-custom--defcustom geiser-repl-autodoc-p t
  63   "Whether to enable `geiser-autodoc-mode' in the REPL by default."
  64   :type 'boolean
  65   :group 'geiser-repl)
  66
  67 (geiser-custom--defcustom geiser-repl-company-p t
  68   "Whether to use company-mode for completion, if available."
  69   :group 'geiser-mode
  70   :type 'boolean)
  71
  72 (geiser-custom--defcustom geiser-repl-read-only-prompt-p t
  73   "Whether the REPL's prompt should be read-only."
  74   :type 'boolean
  75   :group 'geiser-repl)
  76
  77 (geiser-custom--defcustom geiser-repl-auto-indent-p t
  78   "Whether newlines for incomplete sexps are autoindented."
  79   :type 'boolean
  80   :group 'geiser-repl)
  81
  82 (geiser-custom--defcustom geiser-repl-forget-old-errors-p t
  83   "Whether to forget old errors upon entering a new expression.
  84
  85 When on (the default), every time a new expression is entered in
  86 the REPL old error messages are flushed, and using \\[next-error]
  87 afterwards will jump only to error locations produced by the new
  88 expression, if any."
  89   :type 'boolean
  90   :group 'geiser-repl)
  91
  92 \f
  93 ;;; Geiser REPL buffers and processes:
  94
  95 (defvar geiser-repl--repls nil)
  96 (defvar geiser-repl--closed-repls nil)
  97
  98 (make-variable-buffer-local
  99  (defvar geiser-repl--repl nil))
 100
 101 (defsubst geiser-repl--set-this-buffer-repl (r)
 102   (setq geiser-repl--repl r))
 103
 104 (defun geiser-repl--live-p ()
 105   (and geiser-repl--repl
 106        (get-buffer-process geiser-repl--repl)))
 107
 108 (defun geiser-repl--repl/impl (impl &optional repls)
 109   (catch 'repl
 110     (dolist (repl (or repls geiser-repl--repls))
 111       (with-current-buffer repl
 112         (when (eq geiser-impl--implementation impl)
 113           (throw 'repl repl))))))
 114
 115 (defun geiser-repl--set-up-repl (impl)
 116   (or (and (not impl) geiser-repl--repl)
 117       (setq geiser-repl--repl
 118             (let ((impl (or impl
 119                             geiser-impl--implementation
 120                             (geiser-impl--guess))))
 121               (when impl (geiser-repl--repl/impl impl))))))
 122
 123 (defun geiser-repl--active-impls ()
 124   (let ((act))
 125     (dolist (repl geiser-repl--repls act)
 126       (with-current-buffer repl
 127         (add-to-list 'act geiser-impl--implementation)))))
 128
 129 (defsubst geiser-repl--repl-name (impl)
 130   (format "%s REPL" (geiser-impl--impl-str impl)))
 131
 132 (defun geiser-repl--to-repl-buffer (impl)
 133   (unless (and (eq major-mode 'geiser-repl-mode)
 134                (not (get-buffer-process (current-buffer))))
 135     (let* ((old (geiser-repl--repl/impl impl geiser-repl--closed-repls))
 136            (old (and (buffer-live-p old)
 137                      (not (get-buffer-process old))
 138                      old)))
 139       (pop-to-buffer
 140        (or old
 141            (generate-new-buffer (format "* %s *"
 142                                         (geiser-repl--repl-name impl)))))))
 143   (geiser-repl-mode)
 144   (geiser-impl--set-buffer-implementation impl))
 145
 146 (geiser-impl--define-caller geiser-repl--binary binary ()
 147   "A variable or function returning the path to the scheme binary
 148 for this implementation.")
 149
 150 (geiser-impl--define-caller geiser-repl--arglist arglist ()
 151   "A function taking no arguments and returning a list of
 152 arguments to be used when invoking the scheme binary.")
 153
 154 (geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp ()
 155   "A variable (or thunk returning a value) giving the regular
 156 expression for this implementation's scheme prompt.")
 157
 158 (geiser-impl--define-caller
 159     geiser-repl--debugger-prompt-regexp debugger-prompt-regexp ()
 160   "A variable (or thunk returning a value) giving the regular
 161 expression for this implementation's debugging prompt.")
 162
 163 (geiser-impl--define-caller
 164     geiser-repl--debugger-preamble-regexp debugger-preamble-regexp ()
 165   "A variable (or thunk returning a value) used to determine whether
 166 the REPL has entered debugging mode.")
 167
 168 (geiser-impl--define-caller geiser-repl--startup startup ()
 169   "Function taking no parameters that is called after the REPL
 170 has been initialised. All Geiser functionality is available to
 171 you at that point.")
 172
 173 (defun geiser-repl--start-repl (impl)
 174   (message "Starting Geiser REPL for %s ..." impl)
 175   (geiser-repl--to-repl-buffer impl)
 176   (let ((binary (geiser-repl--binary impl))
 177         (args (geiser-repl--arglist impl))
 178         (prompt-rx (geiser-repl--prompt-regexp impl))
 179         (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
 180         (deb-preamble-rx (geiser-repl--debugger-preamble-regexp impl))
 181         (cname (geiser-repl--repl-name impl)))
 182     (unless (and binary prompt-rx)
 183       (error "Sorry, I don't know how to start a REPL for %s" impl))
 184     (set (make-local-variable 'comint-prompt-regexp) prompt-rx)
 185     (apply 'make-comint-in-buffer
 186            `(,cname ,(current-buffer) ,binary nil ,@args))
 187     (geiser-repl--wait-for-prompt 10000)
 188     (geiser-repl--history-setup)
 189     (geiser-con--setup-connection (current-buffer)
 190                                   prompt-rx
 191                                   deb-prompt-rx
 192                                   deb-preamble-rx)
 193     (add-to-list 'geiser-repl--repls (current-buffer))
 194     (geiser-repl--set-this-buffer-repl (current-buffer))
 195     (geiser-repl--startup impl)))
 196
 197 (defun geiser-repl--process ()
 198   (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
 199     (or (and (buffer-live-p buffer) (get-buffer-process buffer))
 200         (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
 201
 202 (setq geiser-eval--default-proc-function 'geiser-repl--process)
 203
 204 (defun geiser-repl--wait-for-prompt (timeout)
 205   (let ((p (point)) (seen) (buffer (current-buffer)))
 206     (while (and (not seen)
 207                 (> timeout 0)
 208                 (get-buffer-process buffer))
 209       (sleep-for 0.1)
 210       (setq timeout (- timeout 100))
 211       (goto-char p)
 212       (setq seen (re-search-forward comint-prompt-regexp nil t)))
 213     (goto-char (point-max))
 214     (unless seen (error "No prompt found!"))))
 215
 216 \f
 217 ;;; Interface: starting and interacting with geiser REPL:
 218
 219 (defun geiser-repl--read-impl (prompt &optional active)
 220   (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))
 221
 222 (defsubst geiser-repl--only-impl-p ()
 223   (and (null (cdr geiser-active-implementations))
 224        (car geiser-active-implementations)))
 225
 226 (defun run-geiser (impl)
 227   "Start a new Geiser REPL."
 228   (interactive
 229    (list (or (geiser-repl--only-impl-p)
 230              (and (eq major-mode 'geiser-repl-mode)
 231                   geiser-impl--implementation)
 232              (geiser-repl--read-impl
 233               "Start Geiser for scheme implementation: "))))
 234    (geiser-repl--start-repl impl))
 235
 236 (make-variable-buffer-local
 237  (defvar geiser-repl--last-scm-buffer nil))
 238
 239 (defun switch-to-geiser (&optional ask impl buffer)
 240   "Switch to running Geiser REPL.
 241 With prefix argument, ask for which one if more than one is running.
 242 If no REPL is running, execute `run-geiser' to start a fresh one."
 243   (interactive "P")
 244   (let* ((impl (or impl geiser-impl--implementation))
 245          (repl (cond ((and (not ask) (not impl)
 246                            (or geiser-repl--repl (car geiser-repl--repls))))
 247                      ((and (not ask) impl (geiser-repl--repl/impl impl)))))
 248          (pop-up-windows geiser-repl-window-allow-split))
 249     (cond ((and (eq (current-buffer) repl)
 250                 (not (eq repl buffer))
 251                 (buffer-live-p geiser-repl--last-scm-buffer))
 252            (pop-to-buffer geiser-repl--last-scm-buffer))
 253           (repl (pop-to-buffer repl))
 254           (t (run-geiser (or impl
 255                              (and (not ask)
 256                                   (geiser-repl--only-impl-p))
 257                              (geiser-repl--read-impl
 258                               "Switch to scheme REPL: ")))))
 259     (when (and buffer (eq major-mode 'geiser-repl-mode))
 260       (setq geiser-repl--last-scm-buffer buffer))))
 261
 262 (defalias 'geiser 'switch-to-geiser)
 263
 264 (defun geiser-repl--send (cmd)
 265   (when (and cmd (eq major-mode 'geiser-repl-mode))
 266     (goto-char (point-max))
 267     (comint-kill-input)
 268     (insert cmd)
 269     (let ((comint-input-filter (lambda (x) nil)))
 270       (comint-send-input nil t))))
 271
 272 (geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module)
 273   "Function taking a module designator and returning a REPL enter
 274 module command as a string")
 275
 276 (defun switch-to-geiser-module (&optional module buffer)
 277   "Switch to running Geiser REPL and try to enter a given module."
 278   (interactive)
 279   (let* ((module (or module
 280                      (geiser-completion--read-module "Switch to module: ")))
 281          (cmd (and module
 282                    (geiser-repl--enter-cmd geiser-impl--implementation
 283                                            module))))
 284     (unless (eq major-mode 'geiser-repl-mode)
 285       (switch-to-geiser nil nil (or buffer (current-buffer))))
 286     (geiser-repl--send cmd)))
 287
 288 (geiser-impl--define-caller geiser-repl--import-cmd import-command (module)
 289   "Function taking a module designator and returning a REPL import
 290 module command as a string")
 291
 292 (defun geiser-repl-import-module (&optional module)
 293   "Import a given module in the current namespace of the REPL."
 294   (interactive)
 295   (let* ((module (or module
 296                      (geiser-completion--read-module "Import module: ")))
 297          (cmd (and module
 298                    (geiser-repl--import-cmd geiser-impl--implementation
 299                                             module))))
 300     (switch-to-geiser nil nil (current-buffer))
 301     (geiser-repl--send cmd)))
 302
 303 (defun geiser-repl-nuke ()
 304   "Try this command if the REPL becomes unresponsive."
 305   (interactive)
 306   (goto-char (point-max))
 307   (comint-kill-region comint-last-input-start (point))
 308   (comint-redirect-cleanup)
 309   (geiser-con--setup-connection (current-buffer)
 310                                 comint-prompt-regexp
 311                                 geiser-con--debugging-prompt-regexp
 312                                 geiser-con--debugging-preamble-regexp))
 313
 314 \f
 315 ;;; REPL history and clean-up:
 316
 317 (defsubst geiser-repl--history-file ()
 318   (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))
 319
 320 (defun geiser-repl--on-quit ()
 321   (comint-write-input-ring)
 322   (let ((cb (current-buffer))
 323         (impl geiser-impl--implementation)
 324         (comint-prompt-read-only nil))
 325     (setq geiser-repl--repls (remove cb geiser-repl--repls))
 326     (dolist (buffer (buffer-list))
 327       (when (buffer-live-p buffer)
 328         (with-current-buffer buffer
 329           (when (and (eq geiser-impl--implementation impl)
 330                      (equal cb geiser-repl--repl))
 331             (geiser-repl--set-up-repl geiser-impl--implementation)))))))
 332
 333 (defun geiser-repl--sentinel (proc event)
 334   (let ((pb (process-buffer proc)))
 335     (when (buffer-live-p pb)
 336       (with-current-buffer pb
 337         (let ((comint-prompt-read-only nil)
 338               (comint-input-ring-file-name (geiser-repl--history-file)))
 339           (geiser-repl--on-quit)
 340           (push pb geiser-repl--closed-repls)
 341           (when (buffer-name (current-buffer))
 342             (comint-kill-region comint-last-input-start (point))
 343             (insert "\nIt's been nice interacting with you!\n")
 344             (insert "Press C-c C-z to bring me back.\n" )))))))
 345
 346 (defun geiser-repl--on-kill ()
 347   (geiser-repl--on-quit)
 348   (setq geiser-repl--closed-repls
 349         (remove (current-buffer) geiser-repl--closed-repls)))
 350
 351 (defun geiser-repl--input-filter (str)
 352   (not (or (geiser-con--is-debugging)
 353            (string-match "^\\s *$" str)
 354            (string-match "^,quit *$" str))))
 355
 356 (defun geiser-repl--old-input ()
 357   (save-excursion
 358     (let ((end (point)))
 359       (backward-sexp)
 360       (buffer-substring (point) end))))
 361
 362 (defun geiser-repl--history-setup ()
 363   (set (make-local-variable 'comint-input-ring-file-name)
 364        (geiser-repl--history-file))
 365   (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
 366   (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
 367   (set (make-local-variable 'comint-get-old-input) 'geiser-repl--old-input)
 368   (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t)
 369   (comint-read-input-ring t)
 370   (set-process-sentinel (get-buffer-process (current-buffer))
 371                         'geiser-repl--sentinel))
 372
 373 \f
 374 ;;; geiser-repl mode:
 375
 376 (defun geiser-repl--bol ()
 377   (interactive)
 378   (when (= (point) (comint-bol)) (beginning-of-line)))
 379
 380 (defun geiser-repl--beginning-of-defun ()
 381   (save-restriction
 382     (when comint-last-prompt-overlay
 383       (narrow-to-region (overlay-end comint-last-prompt-overlay) (point)))
 384     (let ((beginning-of-defun-function nil))
 385       (beginning-of-defun))))
 386
 387 (defun geiser-repl--module-function (&optional ignore) :f)
 388
 389 (defun geiser-repl--doc-module ()
 390   (interactive)
 391   (let ((geiser-eval--get-module-function
 392          (geiser-impl--method 'find-module geiser-impl--implementation)))
 393     (geiser-doc-module)))
 394
 395 (defun geiser-repl--newline-and-indent ()
 396   (interactive)
 397   (save-restriction
 398     (narrow-to-region comint-last-input-start (point-max))
 399     (insert "\n")
 400     (lisp-indent-line)))
 401
 402 (defun geiser-repl--nesting-level ()
 403   (let ((begin (if comint-last-prompt-overlay
 404                    (overlay-end comint-last-prompt-overlay)
 405                  (save-excursion (geiser-repl--bol) (point)))))
 406     (save-restriction
 407       (narrow-to-region begin (point-max))
 408       (geiser-syntax--nesting-level))))
 409
 410 (defun geiser-repl--send-input ()
 411   (let* ((proc (get-buffer-process (current-buffer)))
 412          (pmark (and proc (process-mark proc)))
 413          (intxt (and pmark (buffer-substring pmark (point)))))
 414     (when intxt
 415       (when (and geiser-repl-forget-old-errors-p
 416                  (not (geiser-con--is-debugging)))
 417         (compilation-forget-errors))
 418       (comint-send-input)
 419       (when (string-match "^\\s-*$" intxt)
 420         (comint-send-string proc
 421                             (geiser-eval--scheme-str '((:ge no-values))))
 422         (comint-send-string proc "\n")))))
 423
 424 (defun geiser-repl--maybe-send ()
 425   (interactive)
 426   (let ((p (point)))
 427     (end-of-line)
 428     (if (<= (geiser-repl--nesting-level) 0)
 429         (geiser-repl--send-input)
 430       (goto-char p)
 431       (if geiser-repl-auto-indent-p
 432           (geiser-repl--newline-and-indent)
 433         (insert "\n")))))
 434
 435 (define-derived-mode geiser-repl-mode comint-mode "REPL"
 436   "Major mode for interacting with an inferior scheme repl process.
 437 \\{geiser-repl-mode-map}"
 438   (scheme-mode-variables)
 439   (set (make-local-variable 'mode-line-process) nil)
 440   (set (make-local-variable 'comint-use-prompt-regexp) nil)
 441   (set (make-local-variable 'comint-prompt-read-only)
 442        geiser-repl-read-only-prompt-p)
 443   (set (make-local-variable 'beginning-of-defun-function)
 444        'geiser-repl--beginning-of-defun)
 445   (set (make-local-variable 'comint-input-ignoredups)
 446        geiser-repl-history-no-dups-p)
 447   (setq geiser-eval--get-module-function 'geiser-repl--module-function)
 448   (when geiser-repl-autodoc-p (geiser-autodoc-mode 1))
 449   (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging)
 450   (geiser-company--setup geiser-repl-company-p)
 451   (setq geiser-smart-tab-mode-string "")
 452   ;; enabling compilation-shell-minor-mode without the annoying highlighter
 453   (compilation-setup t))
 454
 455 (define-key geiser-repl-mode-map "\C-d" 'delete-char)
 456 (define-key geiser-repl-mode-map "\C-m" 'geiser-repl--maybe-send)
 457 (define-key geiser-repl-mode-map [return] 'geiser-repl--maybe-send)
 458 (define-key geiser-repl-mode-map "\C-j" 'geiser-repl--newline-and-indent)
 459
 460 (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
 461 (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
 462
 463 (geiser-menu--defmenu repl geiser-repl-mode-map
 464   ("Complete symbol" ((kbd "TAB") (kbd "M-TAB"))
 465    geiser-completion--complete-symbol :enable (symbol-at-point))
 466   ("Complete module name" ((kbd "C-.") (kbd "M-`"))
 467    geiser-completion--complete-module :enable (symbol-at-point))
 468   ("Edit symbol" "\M-." geiser-edit-symbol-at-point
 469    :enable (symbol-at-point))
 470   --
 471   ("Switch to module..." "\C-c\C-m" switch-to-geiser-module)
 472   ("Import module..." "\C-c\C-i" geiser-repl-import-module)
 473   --
 474   ("Previous matching input" "\M-p" comint-previous-matching-input-from-input
 475    "Previous input matching current")
 476   ("Next matching input" "\M-n" comint-next-matching-input-from-input
 477    "Next input matching current")
 478   ("Previous input" "\C-c\M-p" comint-previous-input)
 479   ("Next input" "\C-c\M-n" comint-next-input)
 480   --
 481   (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode)
 482   ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d")
 483    geiser-doc-symbol-at-point
 484    "Documentation for symbol at point" :enable (symbol-at-point))
 485   ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module
 486    "Documentation for module at point" :enable (symbol-at-point))
 487   --
 488   ("Kill Scheme interpreter" "\C-c\C-q" comint-kill-subjob
 489    :enable (geiser-repl--live-p))
 490   ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p)))
 491   ("Revive REPL" "\C-c\C-k" geiser-repl-nuke
 492    "Use this command if the REPL becomes irresponsive"
 493    :enable (geiser-repl--live-p))
 494   --
 495   (custom "REPL options" geiser-repl))
 496
 497 (define-key geiser-repl-mode-map [menu-bar completion] 'undefined)
 498
 499 \f
 500 ;;; Unload:
 501
 502 (defun geiser-repl--repl-list ()
 503   (let (lst)
 504     (dolist (repl geiser-repl--repls lst)
 505       (when (buffer-live-p repl)
 506         (with-current-buffer repl
 507           (push geiser-impl--implementation lst))))))
 508
 509 (defun geiser-repl--restore (impls)
 510   (dolist (impl impls)
 511     (when impl (run-geiser impl))))
 512
 513 (defun geiser-repl-unload-function ()
 514   (dolist (repl geiser-repl--repls)
 515     (when (buffer-live-p repl)
 516       (kill-buffer repl))))
 517
 518 \f
 519 (provide 'geiser-repl)
 520 ;;; geiser-repl.el ends here