elisp/geiser-repl.el

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