elisp/geiser-repl.el

   1 ;;; geiser-repl.el --- Geiser's REPL
   2
   3 ;; Copyright (C) 2009, 2010, 2011, 2012 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-compile)
  14 (require 'geiser-doc)
  15 (require 'geiser-autodoc)
  16 (require 'geiser-edit)
  17 (require 'geiser-completion)
  18 (require 'geiser-impl)
  19 (require 'geiser-eval)
  20 (require 'geiser-connection)
  21 (require 'geiser-menu)
  22 (require 'geiser-image)
  23 (require 'geiser-custom)
  24 (require 'geiser-base)
  25
  26 (require 'comint)
  27 (require 'compile)
  28 (require 'scheme)
  29
  30 \f
  31 ;;; Customization:
  32
  33 (defgroup geiser-repl nil
  34   "Interacting with the Geiser REPL."
  35   :group 'geiser)
  36
  37 (geiser-custom--defcustom geiser-repl-use-other-window t
  38   "Whether to Use a window other than the current buffer's when
  39 switching to the Geiser REPL buffer."
  40   :type 'boolean
  41   :group 'geiser-repl)
  42
  43 (geiser-custom--defcustom geiser-repl-window-allow-split t
  44   "Whether to allow window splitting when switching to the Geiser
  45 REPL buffer."
  46   :type 'boolean
  47   :group 'geiser-repl)
  48
  49 (geiser-custom--defcustom geiser-repl-history-filename (expand-file-name "~/.geiser_history")
  50   "File where REPL input history is saved, so that it persists between sessions.
  51 This is actually the base name: the concrete Scheme
  52 implementation name gets appended to it."
  53   :type 'filename
  54   :group 'geiser-repl)
  55
  56 (geiser-custom--defcustom geiser-repl-history-size comint-input-ring-size
  57   "Maximum size of the saved REPL input history."
  58   :type 'integer
  59   :group 'geiser-repl)
  60
  61 (geiser-custom--defcustom geiser-repl-history-no-dups-p t
  62    "Whether to skip duplicates when recording history."
  63    :type 'boolean
  64    :group 'geiser-repl)
  65
  66 (geiser-custom--defcustom geiser-repl-autodoc-p t
  67   "Whether to enable `geiser-autodoc-mode' in the REPL by default."
  68   :type 'boolean
  69   :group 'geiser-repl)
  70
  71 (geiser-custom--defcustom geiser-repl-company-p t
  72   "Whether to use company-mode for completion, if available."
  73   :group 'geiser-mode
  74   :type 'boolean)
  75
  76 (geiser-custom--defcustom geiser-repl-read-only-prompt-p t
  77   "Whether the REPL's prompt should be read-only."
  78   :type 'boolean
  79   :group 'geiser-repl)
  80
  81 (geiser-custom--defcustom geiser-repl-auto-indent-p t
  82   "Whether newlines for incomplete sexps are autoindented."
  83   :type 'boolean
  84   :group 'geiser-repl)
  85
  86 (geiser-custom--defcustom geiser-repl-forget-old-errors-p t
  87   "Whether to forget old errors upon entering a new expression.
  88
  89 When on (the default), every time a new expression is entered in
  90 the REPL old error messages are flushed, and using \\[next-error]
  91 afterwards will jump only to error locations produced by the new
  92 expression, if any."
  93   :type 'boolean
  94   :group 'geiser-repl)
  95
  96 (geiser-custom--defcustom geiser-repl-query-on-exit-p nil
  97   "Whether to prompt for confirmation on \\[geiser-repl-exit]."
  98   :type 'boolean
  99   :group 'geiser-repl)
 100
 101 (geiser-custom--defcustom geiser-repl-default-host "localhost"
 102   "Default host when connecting to remote REPLs."
 103   :type 'string
 104   :group 'geiser-repl)
 105
 106 (geiser-custom--defcustom geiser-repl-default-port 37146
 107   "Default port for connecting to remote REPLs."
 108   :type 'integer
 109   :group 'geiser-repl)
 110
 111 (geiser-custom--defcustom geiser-repl-startup-time 10000
 112   "Time, in milliseconds, to wait for Racket to startup.
 113 If you have a slow system, try to increase this time."
 114   :type 'integer
 115   :group 'geiser-repl)
 116
 117 (geiser-custom--defcustom geiser-repl-inline-images t
 118    "Whether to display inline images in the REPL."
 119    :type 'boolean
 120    :group 'geiser-repl)
 121
 122 (geiser-custom--defface repl-input
 123   'comint-highlight-input geiser-repl "evaluated input highlighting")
 124
 125 (geiser-custom--defface repl-prompt
 126   'comint-highlight-prompt geiser-repl "REPL prompt")
 127
 128
 129 \f
 130 ;;; Implementation-dependent parameters
 131
 132 (geiser-impl--define-caller geiser-repl--binary binary ()
 133   "A variable or function returning the path to the scheme binary
 134 for this implementation.")
 135
 136 (geiser-impl--define-caller geiser-repl--arglist arglist ()
 137   "A function taking no arguments and returning a list of
 138 arguments to be used when invoking the scheme binary.")
 139
 140 (geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp ()
 141   "A variable (or thunk returning a value) giving the regular
 142 expression for this implementation's geiser scheme prompt.")
 143
 144 (geiser-impl--define-caller
 145     geiser-repl--debugger-prompt-regexp debugger-prompt-regexp ()
 146   "A variable (or thunk returning a value) giving the regular
 147 expression for this implementation's debugging prompt.")
 148
 149 (geiser-impl--define-caller geiser-repl--startup repl-startup (remote)
 150   "Function taking no parameters that is called after the REPL
 151 has been initialised. All Geiser functionality is available to
 152 you at that point.")
 153
 154 (geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module)
 155   "Function taking a module designator and returning a REPL enter
 156 module command as a string")
 157
 158 (geiser-impl--define-caller geiser-repl--import-cmd import-command (module)
 159   "Function taking a module designator and returning a REPL import
 160 module command as a string")
 161
 162 (geiser-impl--define-caller geiser-repl--exit-cmd exit-command ()
 163   "Function returning the REPL exit command as a string")
 164
 165 \f
 166 ;;; Geiser REPL buffers and processes:
 167
 168 (defvar geiser-repl--repls nil)
 169 (defvar geiser-repl--closed-repls nil)
 170
 171 (make-variable-buffer-local
 172  (defvar geiser-repl--repl nil))
 173
 174 (defsubst geiser-repl--set-this-buffer-repl (r)
 175   (setq geiser-repl--repl r))
 176
 177 (defun geiser-repl--live-p ()
 178   (and geiser-repl--repl
 179        (get-buffer-process geiser-repl--repl)))
 180
 181 (defun geiser-repl--repl/impl (impl &optional repls)
 182   (catch 'repl
 183     (dolist (repl (or repls geiser-repl--repls))
 184       (when (buffer-live-p repl)
 185         (with-current-buffer repl
 186           (when (eq geiser-impl--implementation impl)
 187             (throw 'repl repl)))))))
 188
 189 (defun geiser-repl--set-up-repl (impl)
 190   (or (and (not impl) geiser-repl--repl)
 191       (setq geiser-repl--repl
 192             (let ((impl (or impl
 193                             geiser-impl--implementation
 194                             (geiser-impl--guess))))
 195               (when impl (geiser-repl--repl/impl impl))))))
 196
 197 (defun geiser-repl--active-impls ()
 198   (let ((act))
 199     (dolist (repl geiser-repl--repls act)
 200       (with-current-buffer repl
 201         (add-to-list 'act geiser-impl--implementation)))))
 202
 203 (defsubst geiser-repl--repl-name (impl)
 204   (format "%s REPL" (geiser-impl--impl-str impl)))
 205
 206 (defsubst geiser-repl--buffer-name (impl)
 207   (format "* %s *" (geiser-repl--repl-name impl)))
 208
 209 (defun geiser-repl--switch-to-buffer (buffer)
 210   (unless (eq buffer (current-buffer))
 211     (let ((pop-up-windows geiser-repl-window-allow-split))
 212       (if geiser-repl-use-other-window
 213           (switch-to-buffer-other-window buffer)
 214         (switch-to-buffer buffer)))))
 215
 216 (defun geiser-repl--to-repl-buffer (impl)
 217   (unless (and (eq major-mode 'geiser-repl-mode)
 218                (eq geiser-impl--implementation impl)
 219                (not (get-buffer-process (current-buffer))))
 220     (let* ((old (geiser-repl--repl/impl impl geiser-repl--closed-repls))
 221            (old (and (buffer-live-p old)
 222                      (not (get-buffer-process old))
 223                      old)))
 224       (geiser-repl--switch-to-buffer
 225        (or old (generate-new-buffer (geiser-repl--buffer-name impl))))
 226       (unless old
 227         (geiser-repl-mode)
 228         (geiser-impl--set-buffer-implementation impl)))))
 229
 230 (defun geiser-repl--read-impl (prompt &optional active)
 231   (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))
 232
 233 (defsubst geiser-repl--only-impl-p ()
 234   (and (null (cdr geiser-active-implementations))
 235        (car geiser-active-implementations)))
 236
 237 (defun geiser-repl--get-impl (prompt)
 238   (or (geiser-repl--only-impl-p)
 239       (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation)
 240       (geiser-repl--read-impl prompt)))
 241
 242 \f
 243 ;;; REPL connections
 244
 245 (make-variable-buffer-local
 246  (defvar geiser-repl--address nil))
 247
 248 (make-variable-buffer-local
 249  (defvar geiser-repl--connection nil))
 250
 251 (defun geiser-repl--remote-p () geiser-repl--address)
 252
 253 (defsubst geiser-repl--host () (car geiser-repl--address))
 254 (defsubst geiser-repl--port () (cdr geiser-repl--address))
 255
 256 (defun geiser-repl--read-address (&optional host port)
 257   (let ((defhost (or (geiser-repl--host) geiser-repl-default-host))
 258         (defport (or (geiser-repl--port) geiser-repl-default-port)))
 259     (cons (or host
 260               (read-string (format "Host (default %s): " defhost)
 261                            nil nil defhost))
 262           (or port (read-number "Port: " defport)))))
 263
 264 (defun geiser-repl--autodoc-mode (n)
 265   (when (or geiser-repl-autodoc-p (< n 0))
 266     (geiser--save-msg (geiser-autodoc-mode n))))
 267
 268 (defun geiser-repl--save-remote-data (address)
 269   (setq geiser-repl--address address)
 270   (setq header-line-format (and address
 271                                 (format "Host: %s   Port: %s"
 272                                         (geiser-repl--host)
 273                                         (geiser-repl--port)))))
 274
 275 (defun geiser-repl--output-filter (txt)
 276   (geiser-con--connection-update-debugging geiser-repl--connection txt)
 277   (geiser-image--replace-images geiser-repl-inline-images)
 278   (when (string-match-p (geiser-con--connection-prompt geiser-repl--connection)
 279                         txt)
 280     (geiser-autodoc--disinhibit-autodoc)))
 281
 282 (defun geiser-repl--start-repl (impl address)
 283   (message "Starting Geiser REPL for %s ..." impl)
 284   (geiser-repl--to-repl-buffer impl)
 285   (sit-for 0)
 286   (goto-char (point-max))
 287   (geiser-repl--autodoc-mode -1)
 288   (let* ((prompt-rx (geiser-repl--prompt-regexp impl))
 289          (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
 290          (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx)))
 291     (unless prompt-rx
 292       (error "Sorry, I don't know how to start a REPL for %s" impl))
 293     (geiser-repl--save-remote-data address)
 294     (geiser-repl--start-scheme impl address prompt)
 295     (geiser-repl--quit-setup)
 296     (geiser-repl--history-setup)
 297     (add-to-list 'geiser-repl--repls (current-buffer))
 298     (geiser-repl--set-this-buffer-repl (current-buffer))
 299     (setq geiser-repl--connection
 300           (geiser-con--make-connection (get-buffer-process (current-buffer))
 301                                        prompt-rx
 302                                        deb-prompt-rx))
 303     (geiser-repl--startup impl address)
 304     (geiser-repl--autodoc-mode 1)
 305     (geiser-company--setup geiser-repl-company-p)
 306     (add-hook 'comint-output-filter-functions
 307               'geiser-repl--output-filter
 308               nil
 309               t)
 310     (message "%s up and running!" (geiser-repl--repl-name impl))))
 311
 312 (defun geiser-repl--start-scheme (impl address prompt)
 313   (setq comint-prompt-regexp prompt)
 314   (let* ((name (geiser-repl--repl-name impl))
 315          (buff (current-buffer))
 316          (args (if address (list address)
 317                  `(,(geiser-repl--binary impl)
 318                    nil
 319                    ,@(geiser-repl--arglist impl)))))
 320     (condition-case err
 321         (apply 'make-comint-in-buffer `(,name ,buff ,@args))
 322       (error (insert "Unable to start REPL:\n"
 323                      (error-message-string err)
 324                      "\n")
 325              (error "Couldn't start Geiser")))
 326     (geiser-repl--wait-for-prompt geiser-repl-startup-time)))
 327
 328 (defun geiser-repl--wait-for-prompt (timeout)
 329   (let ((p (point)) (seen) (buffer (current-buffer)))
 330     (while (and (not seen)
 331                 (> timeout 0)
 332                 (get-buffer-process buffer))
 333       (sleep-for 0.1)
 334       (setq timeout (- timeout 100))
 335       (goto-char p)
 336       (setq seen (re-search-forward comint-prompt-regexp nil t)))
 337     (goto-char (point-max))
 338     (unless seen (error "%s" "No prompt found!"))))
 339
 340 (defun geiser-repl--is-debugging ()
 341   (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection)))
 342     (and dp
 343          comint-last-prompt-overlay
 344          (save-excursion
 345            (goto-char (overlay-start comint-last-prompt-overlay))
 346            (re-search-forward dp
 347                               (overlay-end comint-last-prompt-overlay)
 348                               t)))))
 349
 350 (defun geiser-repl--connection ()
 351   (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
 352     (or (and (buffer-live-p buffer)
 353              (get-buffer-process buffer)
 354              (with-current-buffer buffer geiser-repl--connection))
 355         (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
 356
 357 (setq geiser-eval--default-connection-function 'geiser-repl--connection)
 358
 359 (defun geiser-repl--prepare-send ()
 360   (geiser-autodoc--inhibit-autodoc)
 361   (geiser-con--connection-deactivate geiser-repl--connection))
 362
 363 (defun geiser-repl--send (cmd)
 364   (when (and cmd (eq major-mode 'geiser-repl-mode))
 365     (geiser-repl--prepare-send)
 366     (goto-char (point-max))
 367     (comint-kill-input)
 368     (insert cmd)
 369     (let ((comint-input-filter (lambda (x) nil)))
 370       (comint-send-input nil t))))
 371
 372 \f
 373 ;;; REPL history
 374
 375 (defconst geiser-repl--history-separator "\n\0\n")
 376
 377 (defsubst geiser-repl--history-file ()
 378   (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))
 379
 380 (defun geiser-repl--read-input-ring ()
 381   (let ((comint-input-ring-file-name (geiser-repl--history-file))
 382         (comint-input-ring-separator geiser-repl--history-separator))
 383     (comint-read-input-ring t)))
 384
 385 (defun geiser-repl--write-input-ring ()
 386   (let ((comint-input-ring-file-name (geiser-repl--history-file))
 387         (comint-input-ring-separator geiser-repl--history-separator))
 388     (comint-write-input-ring)))
 389
 390 (defun geiser-repl--history-setup ()
 391   (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
 392   (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
 393   (geiser-repl--read-input-ring))
 394
 395 \f
 396 ;;; Cleaning up on quit
 397
 398 (defun geiser-repl--on-quit ()
 399   (geiser-repl--write-input-ring)
 400   (let ((cb (current-buffer))
 401         (impl geiser-impl--implementation)
 402         (comint-prompt-read-only nil))
 403     (geiser-con--connection-deactivate geiser-repl--connection t)
 404     (geiser-con--connection-close geiser-repl--connection)
 405     (setq geiser-repl--repls (remove cb geiser-repl--repls))
 406     (dolist (buffer (buffer-list))
 407       (when (buffer-live-p buffer)
 408         (with-current-buffer buffer
 409           (when (and (eq geiser-impl--implementation impl)
 410                      (equal cb geiser-repl--repl))
 411             (geiser-repl--set-up-repl geiser-impl--implementation)))))))
 412
 413 (defun geiser-repl--sentinel (proc event)
 414   (let ((pb (process-buffer proc)))
 415     (when (buffer-live-p pb)
 416       (with-current-buffer pb
 417         (let ((comint-prompt-read-only nil)
 418               (comint-input-ring-file-name (geiser-repl--history-file))
 419               (comint-input-ring-separator geiser-repl--history-separator))
 420           (geiser-repl--on-quit)
 421           (push pb geiser-repl--closed-repls)
 422           (goto-char (point-max))
 423           (comint-kill-region comint-last-input-start (point))
 424           (insert "\nIt's been nice interacting with you!\n")
 425           (insert "Press C-c C-z to bring me back.\n" ))))))
 426
 427 (defun geiser-repl--on-kill ()
 428   (geiser-repl--on-quit)
 429   (setq geiser-repl--closed-repls
 430         (remove (current-buffer) geiser-repl--closed-repls)))
 431
 432 (defun geiser-repl--input-filter (str)
 433   (not (or (geiser-repl--is-debugging)
 434            (string-match "^\\s *$" str)
 435            (string-match "^,quit *$" str))))
 436
 437 (defun geiser-repl--old-input ()
 438   (save-excursion
 439     (let ((end (point)))
 440       (backward-sexp)
 441       (buffer-substring (point) end))))
 442
 443 (defun geiser-repl--quit-setup ()
 444   (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t)
 445   (set-process-sentinel (get-buffer-process (current-buffer))
 446                         'geiser-repl--sentinel))
 447
 448 \f
 449 ;;; geiser-repl mode:
 450
 451 (defun geiser-repl--bol ()
 452   (interactive)
 453   (when (= (point) (comint-bol)) (beginning-of-line)))
 454
 455 (defun geiser-repl--beginning-of-defun ()
 456   (save-restriction
 457     (when comint-last-prompt-overlay
 458       (narrow-to-region (overlay-end comint-last-prompt-overlay) (point)))
 459     (let ((beginning-of-defun-function nil))
 460       (beginning-of-defun))))
 461
 462 (defun geiser-repl--module-function (&optional module)
 463   (if (and module geiser-eval--get-impl-module)
 464       (funcall geiser-eval--get-impl-module module)
 465       :f))
 466
 467 (defun geiser-repl--doc-module ()
 468   (interactive)
 469   (let ((geiser-eval--get-module-function
 470          (geiser-impl--method 'find-module geiser-impl--implementation)))
 471     (geiser-doc-module)))
 472
 473 (defun geiser-repl--newline-and-indent ()
 474   (interactive)
 475   (save-restriction
 476     (narrow-to-region comint-last-input-start (point-max))
 477     (insert "\n")
 478     (lisp-indent-line)))
 479
 480 (defun geiser-repl--last-prompt-end ()
 481   (if comint-last-prompt-overlay
 482       (overlay-end comint-last-prompt-overlay)
 483     (save-excursion (geiser-repl--bol) (point))))
 484
 485 (defun geiser-repl--last-prompt-start ()
 486   (if comint-last-prompt-overlay
 487       (overlay-start comint-last-prompt-overlay)
 488     (save-excursion (geiser-repl--bol) (point))))
 489
 490 (defun geiser-repl--nesting-level ()
 491   (save-restriction
 492     (narrow-to-region (geiser-repl--last-prompt-end) (point-max))
 493     (geiser-syntax--nesting-level)))
 494
 495 (defun geiser-repl--send-input ()
 496   (let* ((proc (get-buffer-process (current-buffer)))
 497          (pmark (and proc (process-mark proc)))
 498          (intxt (and pmark (buffer-substring pmark (point)))))
 499     (when intxt
 500       (and geiser-repl-forget-old-errors-p
 501            (not (geiser-repl--is-debugging))
 502            (compilation-forget-errors))
 503       (geiser-repl--prepare-send)
 504       (comint-send-input)
 505       (when (string-match "^\\s-*$" intxt)
 506         (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values)))
 507         (comint-send-string proc "\n")))))
 508
 509 (defun geiser-repl--maybe-send ()
 510   (interactive)
 511   (let ((p (point)))
 512     (cond ((< p (geiser-repl--last-prompt-start))
 513            (ignore-errors (compile-goto-error)))
 514           ((progn (end-of-line) (<= (geiser-repl--nesting-level) 0))
 515            (geiser-repl--send-input))
 516           (t (goto-char p)
 517              (if geiser-repl-auto-indent-p
 518                  (geiser-repl--newline-and-indent)
 519                (insert "\n"))))))
 520
 521 (defun geiser-repl-tab-dwim (n)
 522   "If we're after the last prompt, complete symbol or indent (if
 523 there's no symbol at point). Otherwise, go to next error in the REPL
 524 buffer."
 525   (interactive "p")
 526   (if (>= (point) (geiser-repl--last-prompt-end))
 527       (or (completion-at-point) (lisp-indent-line))
 528     (compilation-next-error n)))
 529
 530 (defun geiser-repl--previous-error (n)
 531   "Go to previous error in the REPL buffer."
 532   (interactive "p")
 533   (compilation-next-error (- n)))
 534
 535
 536 (define-derived-mode geiser-repl-mode comint-mode "REPL"
 537   "Major mode for interacting with an inferior scheme repl process.
 538 \\{geiser-repl-mode-map}"
 539   (scheme-mode-variables)
 540   (set (make-local-variable 'face-remapping-alist)
 541        '((comint-highlight-prompt geiser-font-lock-repl-prompt)
 542          (comint-highlight-input geiser-font-lock-repl-input)))
 543   (set (make-local-variable 'mode-line-process) nil)
 544   (set (make-local-variable 'comint-use-prompt-regexp) t)
 545   (set (make-local-variable 'comint-prompt-read-only)
 546        geiser-repl-read-only-prompt-p)
 547   (set (make-local-variable 'beginning-of-defun-function)
 548        'geiser-repl--beginning-of-defun)
 549   (set (make-local-variable 'comint-input-ignoredups)
 550        geiser-repl-history-no-dups-p)
 551   (setq geiser-eval--get-module-function 'geiser-repl--module-function)
 552   (geiser-completion--setup t)
 553   (setq geiser-smart-tab-mode-string "")
 554   (geiser-smart-tab-mode t)
 555   ;; enabling compilation-shell-minor-mode without the annoying highlighter
 556   (compilation-setup t))
 557
 558 (define-key geiser-repl-mode-map "\C-d" 'delete-char)
 559 (define-key geiser-repl-mode-map "\C-m" 'geiser-repl--maybe-send)
 560 (define-key geiser-repl-mode-map [return] 'geiser-repl--maybe-send)
 561 (define-key geiser-repl-mode-map "\C-j" 'geiser-repl--newline-and-indent)
 562 (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-repl-tab-dwim)
 563 (define-key geiser-repl-mode-map [backtab] 'geiser-repl--previous-error)
 564
 565 (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
 566 (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
 567
 568 (geiser-menu--defmenu repl geiser-repl-mode-map
 569   ("Complete symbol" ((kbd "M-TAB"))
 570    completion-at-point :enable (geiser--symbol-at-point))
 571   ("Complete module name" ((kbd "C-.") (kbd "M-`"))
 572    geiser-completion--complete-module :enable (geiser--symbol-at-point))
 573   ("Edit symbol" "\M-." geiser-edit-symbol-at-point
 574    :enable (geiser--symbol-at-point))
 575   --
 576   ("Switch to module..." "\C-c\C-m" switch-to-geiser-module)
 577   ("Import module..." "\C-c\C-i" geiser-repl-import-module)
 578   ("Add to load path..." "\C-c\C-r" geiser-add-to-load-path)
 579   --
 580   ("Previous matching input" "\M-p" comint-previous-matching-input-from-input
 581    "Previous input matching current")
 582   ("Next matching input" "\M-n" comint-next-matching-input-from-input
 583    "Next input matching current")
 584   ("Previous input" "\C-c\M-p" comint-previous-input)
 585   ("Next input" "\C-c\M-n" comint-next-input)
 586   --
 587   (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode)
 588   ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d")
 589    geiser-doc-symbol-at-point
 590    "Documentation for symbol at point" :enable (geiser--symbol-at-point))
 591   ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module
 592    "Documentation for module at point" :enable (geiser--symbol-at-point))
 593   --
 594   ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit
 595    :enable (geiser-repl--live-p))
 596   ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p)))
 597   --
 598   (custom "REPL options" geiser-repl))
 599
 600 (define-key geiser-repl-mode-map [menu-bar completion] 'undefined)
 601
 602 \f
 603 ;;; User commands
 604
 605 (defun run-geiser (impl)
 606   "Start a new Geiser REPL."
 607   (interactive
 608    (list (geiser-repl--get-impl "Start Geiser for scheme implementation: ")))
 609   (let ((buffer (current-buffer)))
 610     (geiser-repl--start-repl impl nil)
 611     (geiser-repl--maybe-remember-scm-buffer buffer)))
 612
 613 (defalias 'geiser 'run-geiser)
 614
 615 (defun geiser-connect (impl &optional host port)
 616   "Start a new Geiser REPL connected to a remote Scheme process."
 617   (interactive
 618    (list (geiser-repl--get-impl "Connect to Scheme implementation: ")))
 619   (let ((buffer (current-buffer)))
 620     (geiser-repl--start-repl impl
 621                              (geiser-repl--read-address host port))
 622     (geiser-repl--maybe-remember-scm-buffer buffer)))
 623
 624 (make-variable-buffer-local
 625  (defvar geiser-repl--last-scm-buffer nil))
 626
 627 (defun geiser-repl--maybe-remember-scm-buffer (buffer)
 628   (when (and buffer
 629              (eq 'scheme-mode (with-current-buffer buffer major-mode))
 630              (eq major-mode 'geiser-repl-mode))
 631     (setq geiser-repl--last-scm-buffer buffer)))
 632
 633 (defun switch-to-geiser (&optional ask impl buffer)
 634   "Switch to running Geiser REPL.
 635 With prefix argument, ask for which one if more than one is running.
 636 If no REPL is running, execute `run-geiser' to start a fresh one."
 637   (interactive "P")
 638   (let* ((impl (or impl geiser-impl--implementation))
 639          (in-repl (eq major-mode 'geiser-repl-mode))
 640          (in-live-repl (and in-repl (get-buffer-process (current-buffer))))
 641          (repl (cond ((and (not ask)
 642                            (not impl)
 643                            (not in-repl)
 644                            (or geiser-repl--repl (car geiser-repl--repls))))
 645                      ((and (not ask)
 646                            (not in-repl)
 647                            impl
 648                            (geiser-repl--repl/impl impl))))))
 649     (cond ((or in-live-repl
 650                (and (eq (current-buffer) repl) (not (eq repl buffer))))
 651            (when (buffer-live-p geiser-repl--last-scm-buffer)
 652              (geiser-repl--switch-to-buffer geiser-repl--last-scm-buffer)))
 653           (repl (geiser-repl--switch-to-buffer repl))
 654           ((geiser-repl--remote-p) (geiser-connect impl))
 655           (t (run-geiser impl)))
 656     (geiser-repl--maybe-remember-scm-buffer buffer)))
 657
 658 (defun switch-to-geiser-module (&optional module buffer)
 659   "Switch to running Geiser REPL and try to enter a given module."
 660   (interactive)
 661   (let* ((module (or module
 662                      (geiser-completion--read-module
 663                       "Switch to module (default top-level): ")))
 664          (cmd (and module
 665                    (geiser-repl--enter-cmd geiser-impl--implementation
 666                                            module))))
 667     (unless (eq major-mode 'geiser-repl-mode)
 668       (switch-to-geiser nil nil (or buffer (current-buffer))))
 669     (geiser-repl--send cmd)))
 670
 671 (defun geiser-repl-import-module (&optional module)
 672   "Import a given module in the current namespace of the REPL."
 673   (interactive)
 674   (let* ((module (or module
 675                      (geiser-completion--read-module "Import module: ")))
 676          (cmd (and module
 677                    (geiser-repl--import-cmd geiser-impl--implementation
 678                                             module))))
 679     (switch-to-geiser nil nil (current-buffer))
 680     (geiser-repl--send cmd)))
 681
 682 (defun geiser-repl-exit (&optional arg)
 683   "Exit the current REPL.
 684 With a prefix argument, force exit by killing the scheme process."
 685   (interactive "P")
 686   (when (or (not geiser-repl-query-on-exit-p)
 687             (y-or-n-p "Really quit this REPL? "))
 688     (geiser-con--connection-deactivate geiser-repl--connection t)
 689     (let ((cmd (and (not arg)
 690                     (geiser-repl--exit-cmd geiser-impl--implementation))))
 691       (if cmd
 692           (when (stringp cmd) (geiser-repl--send cmd))
 693         (comint-kill-subjob)))))
 694
 695 \f
 696 ;;; Unload:
 697
 698 (defun geiser-repl--repl-list ()
 699   (let (lst)
 700     (dolist (repl geiser-repl--repls lst)
 701       (when (buffer-live-p repl)
 702         (with-current-buffer repl
 703           (push (cons geiser-impl--implementation
 704                       geiser-repl--address)
 705                 lst))))))
 706
 707 (defun geiser-repl--restore (impls)
 708   (dolist (impl impls)
 709     (when impl
 710       (condition-case err
 711           (geiser-repl--start-repl (car impl) (cdr impl))
 712         (error (message (error-message-string err)))))))
 713
 714 (defun geiser-repl-unload-function ()
 715   (dolist (repl geiser-repl--repls)
 716     (when (buffer-live-p repl)
 717       (with-current-buffer repl
 718         (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit))
 719         (sit-for 0.05)
 720         (kill-buffer)))))
 721
 722 \f
 723 (provide 'geiser-repl)