elisp/geiser-repl.el

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