elisp/geiser-repl.el

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