elisp/geiser-repl.el

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