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