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