elisp/geiser-repl.el

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