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