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
 307              (geiser-repl--bol)
 308              (min (+ 1 (point)) (point-max))))))
 309
 310 (defun geiser-repl--last-prompt-start ()
 311   (cond ((and (boundp 'comint-last-prompt) (markerp (car comint-last-prompt)))
 312          (marker-position (car comint-last-prompt)))
 313         ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay)
 314          (overlay-start comint-last-prompt-overlay))
 315         (t (save-excursion (geiser-repl--bol) (point)))))
 316
 317 \f
 318 ;;; REPL connections
 319
 320 (make-variable-buffer-local
 321  (defvar geiser-repl--address nil))
 322
 323 (make-variable-buffer-local
 324  (defvar geiser-repl--connection nil))
 325
 326 (defun geiser-repl--local-p ()
 327   "Return non-nil, if current REPL is local (connected to socket)."
 328   (stringp geiser-repl--address))
 329
 330 (defun geiser-repl--remote-p ()
 331   "Return non-nil, if current REPL is remote (connected to host:port)."
 332   (consp geiser-repl--address))
 333
 334 (defsubst geiser-repl--host () (car geiser-repl--address))
 335 (defsubst geiser-repl--port () (cdr geiser-repl--address))
 336
 337 (defun geiser-repl--read-address (&optional host port)
 338   (let ((defhost (or (geiser-repl--host) geiser-repl-default-host))
 339         (defport (or (geiser-repl--port) geiser-repl-default-port)))
 340     (cons (or host
 341               (read-string (format "Host (default %s): " defhost)
 342                            nil nil defhost))
 343           (or port (read-number "Port: " defport)))))
 344
 345 (defun geiser-repl--autodoc-mode (n)
 346   (when (or geiser-repl-autodoc-p (< n 0))
 347     (geiser--save-msg (geiser-autodoc-mode n))))
 348
 349 (defun geiser-repl--save-remote-data (address)
 350   (setq geiser-repl--address address)
 351   (setq header-line-format
 352         (cond ((consp address)
 353                (format "Host: %s   Port: %s"
 354                        (geiser-repl--host)
 355                        (geiser-repl--port)))
 356               ((stringp address)
 357                (format "Socket: %s" address))
 358               (t nil))))
 359
 360 (defun geiser-repl--output-filter (txt)
 361   (geiser-con--connection-update-debugging geiser-repl--connection txt)
 362   (geiser-image--replace-images geiser-repl-inline-images-p
 363                                 geiser-repl-auto-display-images-p)
 364   (when (string-match-p (geiser-con--connection-prompt geiser-repl--connection)
 365                         txt)
 366     (geiser-autodoc--disinhibit-autodoc)))
 367
 368 (defun geiser-repl--check-version (impl)
 369   (when (not geiser-repl-skip-version-check-p)
 370     (let ((v (geiser-repl--version impl (geiser-repl--binary impl)))
 371           (r (geiser-repl--min-version impl)))
 372       (when (and v r (geiser--version< v r))
 373         (error "Geiser requires %s version %s but detected %s" impl r v)))))
 374
 375 (defun geiser-repl--start-repl (impl address)
 376   (message "Starting Geiser REPL for %s ..." impl)
 377   (when (not address) (geiser-repl--check-version impl))
 378   (geiser-repl--to-repl-buffer impl)
 379   (sit-for 0)
 380   (goto-char (point-max))
 381   (geiser-repl--autodoc-mode -1)
 382   (let* ((prompt-rx (geiser-repl--prompt-regexp impl))
 383          (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
 384          (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx)))
 385     (unless prompt-rx
 386       (error "Sorry, I don't know how to start a REPL for %s" impl))
 387     (geiser-repl--save-remote-data address)
 388     (geiser-repl--start-scheme impl address prompt)
 389     (geiser-repl--quit-setup)
 390     (geiser-repl--history-setup)
 391     (add-to-list 'geiser-repl--repls (current-buffer))
 392     (geiser-repl--set-this-buffer-repl (current-buffer))
 393     (setq geiser-repl--connection
 394           (geiser-con--make-connection (get-buffer-process (current-buffer))
 395                                        prompt-rx
 396                                        deb-prompt-rx))
 397     (geiser-repl--startup impl address)
 398     (geiser-repl--autodoc-mode 1)
 399     (geiser-company--setup geiser-repl-company-p)
 400     (add-hook 'comint-output-filter-functions
 401               'geiser-repl--output-filter
 402               nil
 403               t)
 404     (set-process-query-on-exit-flag (get-buffer-process (current-buffer))
 405                                     geiser-repl-query-on-kill-p)
 406     (message "%s up and running!" (geiser-repl--repl-name impl))))
 407
 408 (defun geiser-repl--start-scheme (impl address prompt)
 409   (setq comint-prompt-regexp prompt)
 410   (let* ((name (geiser-repl--repl-name impl))
 411          (buff (current-buffer))
 412          (args (cond ((consp address) (list address))
 413                      ((stringp address) '(()))
 414                      (t `(,(geiser-repl--binary impl)
 415                           nil
 416                           ,@(geiser-repl--arglist impl))))))
 417     (condition-case err
 418         (if (and address (stringp address))
 419             ;; Connect over a Unix-domain socket.
 420             (let ((proc (make-network-process :name (buffer-name buff)
 421                                               :buffer buff
 422                                               :family 'local
 423                                               :remote address)))
 424               ;; brittleness warning: this is stuff
 425               ;; make-comint-in-buffer sets up, via comint-exec, when
 426               ;; it creates its own process, something we're doing
 427               ;; here by ourselves.
 428               (set-process-filter proc 'comint-output-filter)
 429               (goto-char (point-max))
 430               (set-marker (process-mark proc) (point)))
 431           (apply 'make-comint-in-buffer `(,name ,buff ,@args)))
 432       (error (insert "Unable to start REPL:\n"
 433                      (error-message-string err)
 434                      "\n")
 435              (error "Couldn't start Geiser: %s" err)))
 436     (geiser-repl--wait-for-prompt geiser-repl-startup-time)))
 437
 438 (defun geiser-repl--wait-for-prompt (timeout)
 439   (let ((p (point)) (seen) (buffer (current-buffer)))
 440     (while (and (not seen)
 441                 (> timeout 0)
 442                 (get-buffer-process buffer))
 443       (sleep-for 0.1)
 444       (setq timeout (- timeout 100))
 445       (goto-char p)
 446       (setq seen (re-search-forward comint-prompt-regexp nil t)))
 447     (goto-char (point-max))
 448     (unless seen (error "%s" "No prompt found!"))))
 449
 450 (defun geiser-repl--is-debugging ()
 451   (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection)))
 452     (and dp
 453          (save-excursion
 454            (goto-char (geiser-repl--last-prompt-start))
 455            (re-search-forward dp (geiser-repl--last-prompt-end) t)))))
 456
 457 (defun geiser-repl--connection* ()
 458   (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
 459    (and (buffer-live-p buffer)
 460         (get-buffer-process buffer)
 461         (with-current-buffer buffer geiser-repl--connection))))
 462
 463 (defun geiser-repl--connection ()
 464   (or (geiser-repl--connection*)
 465       (error "No Geiser REPL for this buffer (try M-x run-geiser)")))
 466
 467 (setq geiser-eval--default-connection-function 'geiser-repl--connection)
 468
 469 (defun geiser-repl--prepare-send ()
 470   (geiser-image--clean-cache)
 471   (geiser-autodoc--inhibit-autodoc)
 472   (geiser-con--connection-deactivate geiser-repl--connection))
 473
 474 (defun geiser-repl--send (cmd &optional save-history)
 475   "Send CMD input string to the current REPL buffer.
 476 If SAVE-HISTORY is non-nil, save CMD in the REPL history."
 477   (when (and cmd (eq major-mode 'geiser-repl-mode))
 478     (geiser-repl--prepare-send)
 479     (goto-char (point-max))
 480     (comint-kill-input)
 481     (insert cmd)
 482     (let ((comint-input-filter (if save-history
 483                                    comint-input-filter
 484                                  'ignore)))
 485       (comint-send-input nil t))))
 486
 487 (defun geiser-repl-interrupt ()
 488   (interactive)
 489   (when (get-buffer-process (current-buffer))
 490     (interrupt-process nil comint-ptyp)))
 491
 492 \f
 493 ;;; REPL history
 494
 495 (defconst geiser-repl--history-separator "\n}{\n")
 496
 497 (defsubst geiser-repl--history-file ()
 498   (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))
 499
 500 (defun geiser-repl--read-input-ring ()
 501   (let ((comint-input-ring-file-name (geiser-repl--history-file))
 502         (comint-input-ring-separator geiser-repl--history-separator)
 503         (buffer-file-coding-system 'utf-8))
 504     (comint-read-input-ring t)))
 505
 506 (defun geiser-repl--write-input-ring ()
 507   (let ((comint-input-ring-file-name (geiser-repl--history-file))
 508         (comint-input-ring-separator geiser-repl--history-separator)
 509         (buffer-file-coding-system 'utf-8))
 510     (comint-write-input-ring)))
 511
 512 (defun geiser-repl--history-setup ()
 513   (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
 514   (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
 515   (geiser-repl--read-input-ring))
 516
 517 \f
 518 ;;; Cleaning up
 519
 520 (defun geiser-repl--on-quit ()
 521   (geiser-repl--write-input-ring)
 522   (let ((cb (current-buffer))
 523         (impl geiser-impl--implementation)
 524         (comint-prompt-read-only nil))
 525     (geiser-con--connection-deactivate geiser-repl--connection t)
 526     (geiser-con--connection-close geiser-repl--connection)
 527     (setq geiser-repl--repls (remove cb geiser-repl--repls))
 528     (dolist (buffer (buffer-list))
 529       (when (buffer-live-p buffer)
 530         (with-current-buffer buffer
 531           (when (and (eq geiser-impl--implementation impl)
 532                      (equal cb geiser-repl--repl))
 533             (geiser-repl--set-up-repl geiser-impl--implementation)))))))
 534
 535 (defun geiser-repl--sentinel (proc event)
 536   (let ((pb (process-buffer proc)))
 537     (when (buffer-live-p pb)
 538       (with-current-buffer pb
 539         (let ((comint-prompt-read-only nil)
 540               (comint-input-ring-file-name (geiser-repl--history-file))
 541               (comint-input-ring-separator geiser-repl--history-separator))
 542           (geiser-repl--on-quit)
 543           (push pb geiser-repl--closed-repls)
 544           (goto-char (point-max))
 545           (comint-kill-region comint-last-input-start (point))
 546           (insert "\nIt's been nice interacting with you!\n")
 547           (insert "Press C-c C-z to bring me back.\n" ))))))
 548
 549 (defun geiser-repl--on-kill ()
 550   (geiser-repl--on-quit)
 551   (setq geiser-repl--closed-repls
 552         (remove (current-buffer) geiser-repl--closed-repls)))
 553
 554 (defun geiser-repl--input-filter (str)
 555   (not (or (and (not geiser-repl-save-debugging-history-p)
 556                 (geiser-repl--is-debugging))
 557            (string-match "^\\s *$" str)
 558            (string-match "^,quit *$" str))))
 559
 560 (defun geiser-repl--old-input ()
 561   (save-excursion
 562     (let ((end (point)))
 563       (backward-sexp)
 564       (buffer-substring (point) end))))
 565
 566 (defun geiser-repl--quit-setup ()
 567   (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t)
 568   (set-process-sentinel (get-buffer-process (current-buffer))
 569                         'geiser-repl--sentinel))
 570
 571 \f
 572 ;;; geiser-repl mode:
 573
 574 (defun geiser-repl--bol ()
 575   (interactive)
 576   (when (= (point) (comint-bol)) (beginning-of-line)))
 577
 578 (defun geiser-repl--beginning-of-defun ()
 579   (save-restriction
 580     (narrow-to-region (geiser-repl--last-prompt-end) (point))
 581     (let ((beginning-of-defun-function nil))
 582       (beginning-of-defun))))
 583
 584 (defun geiser-repl--module-function (&optional module)
 585   (if (and module geiser-eval--get-impl-module)
 586       (funcall geiser-eval--get-impl-module module)
 587       :f))
 588
 589 (defun geiser-repl--doc-module ()
 590   (interactive)
 591   (let ((geiser-eval--get-module-function
 592          (geiser-impl--method 'find-module geiser-impl--implementation)))
 593     (geiser-doc-module)))
 594
 595 (defun geiser-repl--newline-and-indent ()
 596   (interactive)
 597   (save-restriction
 598     (narrow-to-region comint-last-input-start (point-max))
 599     (insert "\n")
 600     (lisp-indent-line)))
 601
 602 (defun geiser-repl--nesting-level ()
 603   (save-restriction
 604     (narrow-to-region (geiser-repl--last-prompt-end) (point-max))
 605     (geiser-syntax--nesting-level)))
 606
 607 (defun geiser-repl--is-input ()
 608   (not (eq (field-at-pos (point)) 'output)))
 609
 610 (defun geiser-repl--grab-input ()
 611   (let ((pos (comint-bol)))
 612     (goto-char (point-max))
 613     (insert (field-string-no-properties pos))))
 614
 615 (defun geiser-repl--send-input ()
 616   (let* ((proc (get-buffer-process (current-buffer)))
 617          (pmark (and proc (process-mark proc)))
 618          (intxt (and pmark (buffer-substring pmark (point))))
 619          (eob (point-max)))
 620     (when intxt
 621       (and geiser-repl-forget-old-errors-p
 622            (not (geiser-repl--is-debugging))
 623            (compilation-forget-errors))
 624       (geiser-repl--prepare-send)
 625       (comint-send-input)
 626       (when (string-match "^\\s-*$" intxt)
 627         (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values)))
 628         (comint-send-string proc "\n")))))
 629
 630 (defun geiser-repl--maybe-send ()
 631   (interactive)
 632   (let ((p (point)))
 633     (cond ((< p (geiser-repl--last-prompt-start))
 634            (if (geiser-repl--is-input)
 635                (geiser-repl--grab-input)
 636              (ignore-errors (compile-goto-error))))
 637           ((let ((inhibit-field-text-motion t))
 638              (end-of-line)
 639              (<= (geiser-repl--nesting-level) 0))
 640            (geiser-repl--send-input))
 641           (t (goto-char p)
 642              (if geiser-repl-auto-indent-p
 643                  (geiser-repl--newline-and-indent)
 644                (insert "\n"))))))
 645
 646 (defun geiser-repl-tab-dwim (n)
 647   "If we're after the last prompt, complete symbol or indent (if
 648 there's no symbol at point). Otherwise, go to next error in the REPL
 649 buffer."
 650   (interactive "p")
 651   (if (>= (point) (geiser-repl--last-prompt-end))
 652       (or (completion-at-point)
 653           (lisp-indent-line))
 654     (compilation-next-error n)))
 655
 656 (defun geiser-repl--previous-error (n)
 657   "Go to previous error in the REPL buffer."
 658   (interactive "p")
 659   (compilation-next-error (- n)))
 660
 661 (defun geiser-repl-clear-buffer ()
 662   "Delete the output generated by the scheme process."
 663   (interactive)
 664   (let ((inhibit-read-only t))
 665     (delete-region (point-min) (geiser-repl--last-prompt-start))
 666     (when (< (point) (geiser-repl--last-prompt-end))
 667       (goto-char (geiser-repl--last-prompt-end)))
 668     (recenter t)))
 669
 670 (define-derived-mode geiser-repl-mode comint-mode "REPL"
 671   "Major mode for interacting with an inferior scheme repl process.
 672 \\{geiser-repl-mode-map}"
 673   (scheme-mode-variables)
 674   (set (make-local-variable 'face-remapping-alist)
 675        '((comint-highlight-prompt geiser-font-lock-repl-prompt)
 676          (comint-highlight-input geiser-font-lock-repl-input)))
 677   (set (make-local-variable 'mode-line-process) nil)
 678   (set (make-local-variable 'comint-use-prompt-regexp) nil)
 679   (set (make-local-variable 'comint-prompt-read-only)
 680        geiser-repl-read-only-prompt-p)
 681   (setq comint-process-echoes nil)
 682   (set (make-local-variable 'beginning-of-defun-function)
 683        'geiser-repl--beginning-of-defun)
 684   (set (make-local-variable 'comint-input-ignoredups)
 685        geiser-repl-history-no-dups-p)
 686   (setq geiser-eval--get-module-function 'geiser-repl--module-function)
 687   (geiser-completion--setup t)
 688   (setq geiser-smart-tab-mode-string "")
 689   (geiser-smart-tab-mode t)
 690   ;; enabling compilation-shell-minor-mode without the annoying highlighter
 691   (compilation-setup t))
 692
 693 (define-key geiser-repl-mode-map "\C-d" 'delete-char)
 694 (define-key geiser-repl-mode-map "\C-m" 'geiser-repl--maybe-send)
 695 (define-key geiser-repl-mode-map [return] 'geiser-repl--maybe-send)
 696 (define-key geiser-repl-mode-map "\C-j" 'geiser-repl--newline-and-indent)
 697 (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-repl-tab-dwim)
 698 (define-key geiser-repl-mode-map [backtab] 'geiser-repl--previous-error)
 699
 700 (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
 701 (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
 702
 703 (geiser-menu--defmenu repl geiser-repl-mode-map
 704   ("Complete symbol" ((kbd "M-TAB"))
 705    completion-at-point :enable (geiser--symbol-at-point))
 706   ("Complete module name" ((kbd "C-.") (kbd "M-`"))
 707    geiser-completion--complete-module :enable (geiser--symbol-at-point))
 708   ("Edit symbol" "\M-." geiser-edit-symbol-at-point
 709    :enable (geiser--symbol-at-point))
 710   --
 711   ("Load scheme file..." "\C-c\C-l" geiser-load-file)
 712   ("Switch to module..." "\C-c\C-m" switch-to-geiser-module)
 713   ("Import module..." "\C-c\C-i" geiser-repl-import-module)
 714   ("Add to load path..." "\C-c\C-r" geiser-add-to-load-path)
 715   --
 716   ("Previous matching input" "\M-p" comint-previous-matching-input-from-input
 717    "Previous input matching current")
 718   ("Next matching input" "\M-n" comint-next-matching-input-from-input
 719    "Next input matching current")
 720   ("Previous prompt" "\C-c\C-p" geiser-repl-previous-prompt)
 721   ("Next prompt" "\C-c\C-n" geiser-repl-next-prompt)
 722   ("Previous input" "\C-c\M-p" comint-previous-input)
 723   ("Next input" "\C-c\M-n" comint-next-input)
 724   --
 725   ("Interrupt evaluation" ("\C-c\C-k" "\C-c\C-c" "\C-ck")
 726    geiser-repl-interrupt)
 727   --
 728   (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode)
 729   ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d")
 730    geiser-doc-symbol-at-point
 731    "Documentation for symbol at point" :enable (geiser--symbol-at-point))
 732   ("Lookup symbol in manul" ("\C-c\C-di" "\C-c\C-d\C-i")
 733    geiser-doc-look-up-manual
 734    "Documentation for symbol at point" :enable (geiser--symbol-at-point))
 735   ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module
 736    "Documentation for module at point" :enable (geiser--symbol-at-point))
 737   --
 738   ("Clear buffer" "\C-c\M-o" geiser-repl-clear-buffer
 739    "Clean up REPL buffer, leaving just a lonely prompt")
 740   ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit
 741    :enable (geiser-repl--live-p))
 742   ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p)))
 743   --
 744   (custom "REPL options" geiser-repl))
 745
 746 (define-key geiser-repl-mode-map [menu-bar completion] 'undefined)
 747
 748 \f
 749 ;;; User commands
 750
 751 (defun run-geiser (impl)
 752   "Start a new Geiser REPL."
 753   (interactive
 754    (list (geiser-repl--get-impl "Start Geiser for scheme implementation: ")))
 755   (let ((buffer (current-buffer)))
 756     (geiser-repl--start-repl impl nil)
 757     (geiser-repl--maybe-remember-scm-buffer buffer)))
 758
 759 (defalias 'geiser 'run-geiser)
 760
 761 (defun geiser-connect (impl &optional host port)
 762   "Start a new Geiser REPL connected to a remote Scheme process."
 763   (interactive
 764    (list (geiser-repl--get-impl "Connect to Scheme implementation: ")))
 765   (let ((buffer (current-buffer)))
 766     (geiser-repl--start-repl impl
 767                              (geiser-repl--read-address host port))
 768     (geiser-repl--maybe-remember-scm-buffer buffer)))
 769
 770 (defun geiser-connect-local (impl socket)
 771   "Start a new Geiser REPL connected to a remote Scheme process
 772 over a Unix-domain socket."
 773   (interactive
 774    (list (geiser-repl--get-impl "Connect to Scheme implementation: ")
 775          (expand-file-name (read-file-name "Socket file name: "))))
 776   (let ((buffer (current-buffer)))
 777     (geiser-repl--start-repl impl socket)
 778     (geiser-repl--maybe-remember-scm-buffer buffer)))
 779
 780 (make-variable-buffer-local
 781  (defvar geiser-repl--last-scm-buffer nil))
 782
 783 (defun geiser-repl--maybe-remember-scm-buffer (buffer)
 784   (when (and buffer
 785              (eq 'scheme-mode (with-current-buffer buffer major-mode))
 786              (eq major-mode 'geiser-repl-mode))
 787     (setq geiser-repl--last-scm-buffer buffer)))
 788
 789 (defun switch-to-geiser (&optional ask impl buffer)
 790   "Switch to running Geiser REPL.
 791
 792 If REPL is the current buffer, switch to the previously used
 793 scheme buffer.
 794
 795 With prefix argument, ask for which one if more than one is running.
 796 If no REPL is running, execute `run-geiser' to start a fresh one."
 797   (interactive "P")
 798   (let* ((impl (or impl geiser-impl--implementation))
 799          (in-repl (eq major-mode 'geiser-repl-mode))
 800          (in-live-repl (and in-repl (get-buffer-process (current-buffer))))
 801          (repl (unless ask
 802                  (if impl
 803                      (geiser-repl--repl/impl impl)
 804                    (or geiser-repl--repl (car geiser-repl--repls))))))
 805     (cond (in-live-repl
 806            (when (and (not (eq repl buffer))
 807                       (buffer-live-p geiser-repl--last-scm-buffer))
 808              (geiser-repl--switch-to-buffer geiser-repl--last-scm-buffer)))
 809           (repl (geiser-repl--switch-to-buffer repl))
 810           ((geiser-repl--remote-p)
 811            (geiser-connect impl (geiser-repl--host) (geiser-repl--port)))
 812           ((geiser-repl--local-p)
 813            (geiser-connect-local impl geiser-repl--address))
 814           (impl (run-geiser impl))
 815           (t (call-interactively 'run-geiser)))
 816     (geiser-repl--maybe-remember-scm-buffer buffer)))
 817
 818 (defun switch-to-geiser-module (&optional module buffer)
 819   "Switch to running Geiser REPL and try to enter a given module."
 820   (interactive)
 821   (let* ((module (or module
 822                      (geiser-completion--read-module
 823                       "Switch to module (default top-level): ")))
 824          (cmd (and module
 825                    (geiser-repl--enter-cmd geiser-impl--implementation
 826                                            module))))
 827     (unless (eq major-mode 'geiser-repl-mode)
 828       (switch-to-geiser nil nil (or buffer (current-buffer))))
 829     (geiser-repl--send cmd)))
 830
 831 (defun geiser-repl-import-module (&optional module)
 832   "Import a given module in the current namespace of the REPL."
 833   (interactive)
 834   (let* ((module (or module
 835                      (geiser-completion--read-module "Import module: ")))
 836          (cmd (and module
 837                    (geiser-repl--import-cmd geiser-impl--implementation
 838                                             module))))
 839     (switch-to-geiser nil nil (current-buffer))
 840     (geiser-repl--send cmd)))
 841
 842 (defun geiser-repl-exit (&optional arg)
 843   "Exit the current REPL.
 844 With a prefix argument, force exit by killing the scheme process."
 845   (interactive "P")
 846   (when (or (not geiser-repl-query-on-exit-p)
 847             (y-or-n-p "Really quit this REPL? "))
 848     (geiser-con--connection-deactivate geiser-repl--connection t)
 849     (let ((cmd (and (not arg)
 850                     (geiser-repl--exit-cmd geiser-impl--implementation))))
 851       (if cmd
 852           (when (stringp cmd) (geiser-repl--send cmd))
 853         (comint-kill-subjob)))))
 854
 855 (defun geiser-repl-next-prompt (n)
 856   (interactive "p")
 857   (when (> n 0)
 858     (end-of-line)
 859     (re-search-forward comint-prompt-regexp nil 'go n)))
 860
 861 (defun geiser-repl-previous-prompt (n)
 862   (interactive "p")
 863   (when (> n 0)
 864     (end-of-line 0)
 865     (when (re-search-backward comint-prompt-regexp nil 'go n)
 866       (goto-char (match-end 0)))))
 867
 868 \f
 869 ;;; Unload:
 870
 871 (defun geiser-repl--repl-list ()
 872   (let (lst)
 873     (dolist (repl geiser-repl--repls lst)
 874       (when (buffer-live-p repl)
 875         (with-current-buffer repl
 876           (push (cons geiser-impl--implementation
 877                       geiser-repl--address)
 878                 lst))))))
 879
 880 (defun geiser-repl--restore (impls)
 881   (dolist (impl impls)
 882     (when impl
 883       (condition-case err
 884           (geiser-repl--start-repl (car impl) (cdr impl))
 885         (error (message (error-message-string err)))))))
 886
 887 (defun geiser-repl-unload-function ()
 888   (dolist (repl geiser-repl--repls)
 889     (when (buffer-live-p repl)
 890       (with-current-buffer repl
 891         (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit))
 892         (sit-for 0.05)
 893         (kill-buffer)))))
 894
 895 \f
 896 (provide 'geiser-repl)
 897
 898 \f
 899 ;;; Initialization:
 900 ;; After providing 'geiser-repl, so that impls can use us.
 901 (mapc 'geiser-impl--load-impl geiser-active-implementations)