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