elisp/geiser-repl.el

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