1 ;;; geiser-repl.el --- Geiser's REPL
3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
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>.
12 (require 'geiser-company
)
13 (require 'geiser-autodoc
)
14 (require 'geiser-edit
)
15 (require 'geiser-completion
)
16 (require 'geiser-impl
)
17 (require 'geiser-eval
)
18 (require 'geiser-connection
)
19 (require 'geiser-menu
)
20 (require 'geiser-custom
)
21 (require 'geiser-base
)
30 (defgroup geiser-repl nil
31 "Interacting with the Geiser REPL."
34 (geiser-custom--defcustom geiser-repl-use-other-window t
35 "Whether to Use a window other than the current buffer's when
36 switching to the Geiser REPL buffer."
40 (geiser-custom--defcustom geiser-repl-window-allow-split t
41 "Whether to allow window splitting when switching to the Geiser
46 (geiser-custom--defcustom geiser-repl-history-filename
(expand-file-name "~/.geiser_history")
47 "File where REPL input history is saved, so that it persists between sessions.
48 This is actually the base name: the concrete Scheme
49 implementation name gets appended to it."
53 (geiser-custom--defcustom geiser-repl-history-size comint-input-ring-size
54 "Maximum size of the saved REPL input history."
58 (geiser-custom--defcustom geiser-repl-history-no-dups-p t
59 "Whether to skip duplicates when recording history."
63 (geiser-custom--defcustom geiser-repl-autodoc-p t
64 "Whether to enable `geiser-autodoc-mode' in the REPL by default."
68 (geiser-custom--defcustom geiser-repl-company-p t
69 "Whether to use company-mode for completion, if available."
73 (geiser-custom--defcustom geiser-repl-read-only-prompt-p t
74 "Whether the REPL's prompt should be read-only."
78 (geiser-custom--defcustom geiser-repl-auto-indent-p t
79 "Whether newlines for incomplete sexps are autoindented."
83 (geiser-custom--defcustom geiser-repl-forget-old-errors-p t
84 "Whether to forget old errors upon entering a new expression.
86 When on (the default), every time a new expression is entered in
87 the REPL old error messages are flushed, and using \\[next-error]
88 afterwards will jump only to error locations produced by the new
93 (geiser-custom--defcustom geiser-repl-query-on-exit-p nil
94 "Whether to prompt for confirmation on \\[geiser-repl-exit]."
98 (geiser-custom--defcustom geiser-repl-default-host
"localhost"
99 "Default host when connecting to remote REPLs."
103 (geiser-custom--defcustom geiser-repl-default-port
37146
104 "Default port for connecting to remote REPLs."
109 ;;; Geiser REPL buffers and processes:
111 (defvar geiser-repl--repls nil
)
112 (defvar geiser-repl--closed-repls nil
)
114 (make-variable-buffer-local
115 (defvar geiser-repl--repl nil
))
117 (defsubst geiser-repl--set-this-buffer-repl
(r)
118 (setq geiser-repl--repl r
))
120 (defun geiser-repl--live-p ()
121 (and geiser-repl--repl
122 (get-buffer-process geiser-repl--repl
)))
124 (defun geiser-repl--repl/impl
(impl &optional repls
)
126 (dolist (repl (or repls geiser-repl--repls
))
127 (when (buffer-live-p repl
)
128 (with-current-buffer repl
129 (when (eq geiser-impl--implementation impl
)
130 (throw 'repl repl
)))))))
132 (defun geiser-repl--set-up-repl (impl)
133 (or (and (not impl
) geiser-repl--repl
)
134 (setq geiser-repl--repl
136 geiser-impl--implementation
137 (geiser-impl--guess))))
138 (when impl
(geiser-repl--repl/impl impl
))))))
140 (defun geiser-repl--active-impls ()
142 (dolist (repl geiser-repl--repls act
)
143 (with-current-buffer repl
144 (add-to-list 'act geiser-impl--implementation
)))))
146 (defsubst geiser-repl--repl-name
(impl)
147 (format "%s REPL" (geiser-impl--impl-str impl
)))
149 (defun geiser-repl--to-repl-buffer (impl)
150 (unless (and (eq major-mode
'geiser-repl-mode
)
151 (not (get-buffer-process (current-buffer))))
152 (let* ((old (geiser-repl--repl/impl impl geiser-repl--closed-repls
))
153 (old (and (buffer-live-p old
)
154 (not (get-buffer-process old
))
158 (generate-new-buffer (format "* %s *"
159 (geiser-repl--repl-name impl
)))))))
161 (geiser-impl--set-buffer-implementation impl
))
163 (geiser-impl--define-caller geiser-repl--binary binary
()
164 "A variable or function returning the path to the scheme binary
165 for this implementation.")
167 (geiser-impl--define-caller geiser-repl--arglist arglist
()
168 "A function taking no arguments and returning a list of
169 arguments to be used when invoking the scheme binary.")
171 (geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp
()
172 "A variable (or thunk returning a value) giving the regular
173 expression for this implementation's scheme prompt.")
175 (geiser-impl--define-caller
176 geiser-repl--debugger-prompt-regexp debugger-prompt-regexp
()
177 "A variable (or thunk returning a value) giving the regular
178 expression for this implementation's debugging prompt.")
180 (geiser-impl--define-caller
181 geiser-repl--debugger-preamble-regexp debugger-preamble-regexp
()
182 "A variable (or thunk returning a value) used to determine whether
183 the REPL has entered debugging mode.")
185 (geiser-impl--define-caller geiser-repl--startup startup
()
186 "Function taking no parameters that is called after the REPL
187 has been initialised. All Geiser functionality is available to
190 (geiser-impl--define-caller geiser-repl--enter-cmd enter-command
(module)
191 "Function taking a module designator and returning a REPL enter
192 module command as a string")
194 (geiser-impl--define-caller geiser-repl--import-cmd import-command
(module)
195 "Function taking a module designator and returning a REPL import
196 module command as a string")
198 (geiser-impl--define-caller geiser-repl--exit-cmd exit-command
()
199 "Function returning the REPL exit command as a string")
201 (make-variable-buffer-local
202 (defvar geiser-repl--address nil
))
204 (defsubst geiser-repl--host
() (car geiser-repl--address
))
205 (defsubst geiser-repl--port
() (cdr geiser-repl--address
))
206 (defsubst geiser-repl--remote-p
() geiser-repl--address
)
208 (defun geiser-repl--get-address ()
209 (let ((defhost (or (geiser-repl--host) geiser-repl-default-host
))
210 (defport (or (geiser-repl--port) geiser-repl-default-port
)))
211 (cons (read-string (format "Host (default %s): " defhost
) nil nil defhost
)
212 (read-number "Port: " defport
))))
214 (defun geiser-repl--save-remote-data (remote address
)
215 (setq geiser-repl--address
(and remote address
))
217 (setq header-line-format
(format "Host: %s Port: %s"
219 (geiser-repl--port)))))
221 (defun geiser-repl--start-repl (impl &optional remote
)
222 (message "Starting Geiser REPL for %s ..." impl
)
223 (geiser-repl--to-repl-buffer impl
)
224 (let ((program (if remote
(geiser-repl--get-address)
225 (geiser-repl--binary impl
)))
226 (args (geiser-repl--arglist impl
))
227 (prompt-rx (geiser-repl--prompt-regexp impl
))
228 (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl
))
229 (deb-preamble-rx (geiser-repl--debugger-preamble-regexp impl
))
230 (cname (geiser-repl--repl-name impl
)))
231 (unless (and program prompt-rx
)
232 (error "Sorry, I don't know how to start a REPL for %s" impl
))
233 (set (make-local-variable 'comint-prompt-regexp
) prompt-rx
)
234 (geiser-repl--save-remote-data remote program
)
236 (apply 'make-comint-in-buffer
237 `(,cname
,(current-buffer) ,program nil
,@args
))
238 (error (insert "Unable to start REPL:\n\n"
239 (error-message-string err
) "\n")
240 (error "Couldn't start Geiser")))
241 (geiser-repl--wait-for-prompt 10000)
242 (geiser-repl--history-setup)
243 (geiser-con--setup-connection (current-buffer)
247 (add-to-list 'geiser-repl--repls
(current-buffer))
248 (geiser-repl--set-this-buffer-repl (current-buffer))
249 (geiser-repl--startup impl
)))
251 (defun geiser-repl--process ()
252 (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation
)))
253 (or (and (buffer-live-p buffer
) (get-buffer-process buffer
))
254 (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
256 (setq geiser-eval--default-proc-function
'geiser-repl--process
)
258 (defun geiser-repl--wait-for-prompt (timeout)
259 (let ((p (point)) (seen) (buffer (current-buffer)))
260 (while (and (not seen
)
262 (get-buffer-process buffer
))
264 (setq timeout
(- timeout
100))
266 (setq seen
(re-search-forward comint-prompt-regexp nil t
)))
267 (goto-char (point-max))
268 (unless seen
(error "No prompt found!"))))
271 ;;; Interface: starting and interacting with geiser REPL:
273 (defun geiser-repl--read-impl (prompt &optional active
)
274 (geiser-impl--read-impl prompt
(and active
(geiser-repl--active-impls))))
276 (defsubst geiser-repl--only-impl-p
()
277 (and (null (cdr geiser-active-implementations
))
278 (car geiser-active-implementations
)))
280 (defun run-geiser (impl)
281 "Start a new Geiser REPL."
283 (list (or (geiser-repl--only-impl-p)
284 (and (eq major-mode
'geiser-repl-mode
)
285 geiser-impl--implementation
)
286 (geiser-repl--read-impl
287 "Start Geiser for scheme implementation: "))))
288 (geiser-repl--start-repl impl
))
290 (defun geiser-connect (impl)
291 "Start a new Geiser REPL connected to a remote Scheme process."
293 (list (or (geiser-repl--only-impl-p)
294 (and (eq major-mode
'geiser-repl-mode
)
295 geiser-impl--implementation
)
296 (geiser-repl--read-impl
297 "Scheme implementation: "))))
298 (geiser-repl--start-repl impl t
))
300 (make-variable-buffer-local
301 (defvar geiser-repl--last-scm-buffer nil
))
303 (defun switch-to-geiser (&optional ask impl buffer
)
304 "Switch to running Geiser REPL.
305 With prefix argument, ask for which one if more than one is running.
306 If no REPL is running, execute `run-geiser' to start a fresh one."
308 (let* ((impl (or impl geiser-impl--implementation
))
309 (repl (cond ((and (not ask
) (not impl
)
310 (or geiser-repl--repl
(car geiser-repl--repls
))))
311 ((and (not ask
) impl
(geiser-repl--repl/impl impl
)))))
312 (pop-up-windows geiser-repl-window-allow-split
))
313 (cond ((and (eq (current-buffer) repl
)
314 (not (eq repl buffer
))
315 (buffer-live-p geiser-repl--last-scm-buffer
))
316 (pop-to-buffer geiser-repl--last-scm-buffer
))
317 (repl (pop-to-buffer repl
))
318 ((geiser-repl--remote-p) (geiser-connect impl
))
319 (t (run-geiser impl
)))
320 (when (and buffer
(eq major-mode
'geiser-repl-mode
))
321 (setq geiser-repl--last-scm-buffer buffer
))))
323 (defalias 'geiser
'switch-to-geiser
)
325 (defun geiser-repl--send (cmd)
326 (when (and cmd
(eq major-mode
'geiser-repl-mode
))
327 (goto-char (point-max))
330 (let ((comint-input-filter (lambda (x) nil
)))
331 (comint-send-input nil t
))))
333 (defun switch-to-geiser-module (&optional module buffer
)
334 "Switch to running Geiser REPL and try to enter a given module."
336 (let* ((module (or module
337 (geiser-completion--read-module "Switch to module: ")))
339 (geiser-repl--enter-cmd geiser-impl--implementation
341 (unless (eq major-mode
'geiser-repl-mode
)
342 (switch-to-geiser nil nil
(or buffer
(current-buffer))))
343 (geiser-repl--send cmd
)))
345 (defun geiser-repl-import-module (&optional module
)
346 "Import a given module in the current namespace of the REPL."
348 (let* ((module (or module
349 (geiser-completion--read-module "Import module: ")))
351 (geiser-repl--import-cmd geiser-impl--implementation
353 (switch-to-geiser nil nil
(current-buffer))
354 (geiser-repl--send cmd
)))
356 (defun geiser-repl-exit (&optional arg
)
357 "Exit the current REPL.
358 With a prefix argument, force exit by killing the scheme process."
360 (when (or (not geiser-repl-query-on-exit-p
)
361 (y-or-n-p "Really quit this REPL? "))
362 (let ((cmd (and (not arg
)
363 (geiser-repl--exit-cmd geiser-impl--implementation
))))
365 (when (stringp cmd
) (geiser-repl--send cmd
))
366 (comint-kill-subjob)))))
368 (defun geiser-repl-nuke ()
369 "Try this command if the REPL becomes unresponsive."
371 (goto-char (point-max))
372 (comint-kill-region comint-last-input-start
(point))
373 (comint-redirect-cleanup)
374 (geiser-con--setup-connection (current-buffer)
376 geiser-con--debugging-prompt-regexp
377 geiser-con--debugging-preamble-regexp
))
380 ;;; REPL history and clean-up:
382 (defsubst geiser-repl--history-file
()
383 (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation
))
385 (defun geiser-repl--on-quit ()
386 (comint-write-input-ring)
387 (let ((cb (current-buffer))
388 (impl geiser-impl--implementation
)
389 (comint-prompt-read-only nil
))
390 (setq geiser-repl--repls
(remove cb geiser-repl--repls
))
391 (dolist (buffer (buffer-list))
392 (when (buffer-live-p buffer
)
393 (with-current-buffer buffer
394 (when (and (eq geiser-impl--implementation impl
)
395 (equal cb geiser-repl--repl
))
396 (geiser-repl--set-up-repl geiser-impl--implementation
)))))))
398 (defun geiser-repl--sentinel (proc event
)
399 (let ((pb (process-buffer proc
)))
400 (when (buffer-live-p pb
)
401 (with-current-buffer pb
402 (let ((comint-prompt-read-only nil
)
403 (comint-input-ring-file-name (geiser-repl--history-file)))
404 (geiser-repl--on-quit)
405 (push pb geiser-repl--closed-repls
)
406 (when (buffer-name (current-buffer))
407 (comint-kill-region comint-last-input-start
(point))
408 (insert "\nIt's been nice interacting with you!\n")
409 (insert "Press C-c C-z to bring me back.\n" )))))))
411 (defun geiser-repl--on-kill ()
412 (geiser-repl--on-quit)
413 (setq geiser-repl--closed-repls
414 (remove (current-buffer) geiser-repl--closed-repls
)))
416 (defun geiser-repl--input-filter (str)
417 (not (or (geiser-con--is-debugging)
418 (string-match "^\\s *$" str
)
419 (string-match "^,quit *$" str
))))
421 (defun geiser-repl--old-input ()
425 (buffer-substring (point) end
))))
427 (defun geiser-repl--history-setup ()
428 (set (make-local-variable 'comint-input-ring-file-name
)
429 (geiser-repl--history-file))
430 (set (make-local-variable 'comint-input-ring-size
) geiser-repl-history-size
)
431 (set (make-local-variable 'comint-input-filter
) 'geiser-repl--input-filter
)
432 (set (make-local-variable 'comint-get-old-input
) 'geiser-repl--old-input
)
433 (add-hook 'kill-buffer-hook
'geiser-repl--on-kill nil t
)
434 (comint-read-input-ring t
)
435 (set-process-sentinel (get-buffer-process (current-buffer))
436 'geiser-repl--sentinel
))
439 ;;; geiser-repl mode:
441 (defun geiser-repl--bol ()
443 (when (= (point) (comint-bol)) (beginning-of-line)))
445 (defun geiser-repl--beginning-of-defun ()
447 (when comint-last-prompt-overlay
448 (narrow-to-region (overlay-end comint-last-prompt-overlay
) (point)))
449 (let ((beginning-of-defun-function nil
))
450 (beginning-of-defun))))
452 (defun geiser-repl--module-function (&optional ignore
) :f
)
454 (defun geiser-repl--doc-module ()
456 (let ((geiser-eval--get-module-function
457 (geiser-impl--method 'find-module geiser-impl--implementation
)))
458 (geiser-doc-module)))
460 (defun geiser-repl--newline-and-indent ()
463 (narrow-to-region comint-last-input-start
(point-max))
467 (defun geiser-repl--last-prompt-end ()
468 (if comint-last-prompt-overlay
469 (overlay-end comint-last-prompt-overlay
)
470 (save-excursion (geiser-repl--bol) (point))))
472 (defun geiser-repl--last-prompt-start ()
473 (if comint-last-prompt-overlay
474 (overlay-start comint-last-prompt-overlay
)
475 (save-excursion (geiser-repl--bol) (point))))
477 (defun geiser-repl--nesting-level ()
479 (narrow-to-region (geiser-repl--last-prompt-end) (point-max))
480 (geiser-syntax--nesting-level)))
482 (defun geiser-repl--send-input ()
483 (let* ((proc (get-buffer-process (current-buffer)))
484 (pmark (and proc
(process-mark proc
)))
485 (intxt (and pmark
(buffer-substring pmark
(point)))))
487 (when (and geiser-repl-forget-old-errors-p
488 (not (geiser-con--is-debugging)))
489 (compilation-forget-errors))
491 (when (string-match "^\\s-*$" intxt
)
492 (comint-send-string proc
(geiser-eval--scheme-str '(:ge no-values
)))
493 (comint-send-string proc
"\n")))))
495 (defun geiser-repl--maybe-send ()
498 (cond ((< p
(geiser-repl--last-prompt-start))
499 (ignore-errors (compile-goto-error)))
500 ((progn (end-of-line) (<= (geiser-repl--nesting-level) 0))
501 (geiser-repl--send-input))
503 (if geiser-repl-auto-indent-p
504 (geiser-repl--newline-and-indent)
507 (defun geiser-repl--tab (n)
509 (if (> (point) (geiser-repl--last-prompt-end))
510 (geiser-completion--maybe-complete)
511 (compilation-next-error n
)))
513 (define-derived-mode geiser-repl-mode comint-mode
"REPL"
514 "Major mode for interacting with an inferior scheme repl process.
515 \\{geiser-repl-mode-map}"
516 (scheme-mode-variables)
517 (set (make-local-variable 'mode-line-process
) nil
)
518 (set (make-local-variable 'comint-use-prompt-regexp
) nil
)
519 (set (make-local-variable 'comint-prompt-read-only
)
520 geiser-repl-read-only-prompt-p
)
521 (set (make-local-variable 'beginning-of-defun-function
)
522 'geiser-repl--beginning-of-defun
)
523 (set (make-local-variable 'comint-input-ignoredups
)
524 geiser-repl-history-no-dups-p
)
525 (setq geiser-eval--get-module-function
'geiser-repl--module-function
)
526 (when geiser-repl-autodoc-p
527 (geiser--save-msg (geiser-autodoc-mode 1)))
528 (setq geiser-autodoc--inhibit-function
'geiser-con--is-debugging
)
529 (geiser-company--setup geiser-repl-company-p
)
530 ;; enabling compilation-shell-minor-mode without the annoying highlighter
531 (compilation-setup t
))
533 (define-key geiser-repl-mode-map
"\C-d" 'delete-char
)
534 (define-key geiser-repl-mode-map
"\C-m" 'geiser-repl--maybe-send
)
535 (define-key geiser-repl-mode-map
[return] 'geiser-repl--maybe-send)
536 (define-key geiser-repl-mode-map "\C-j" 'geiser-repl--newline-and-indent)
537 (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-repl--tab)
539 (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
540 (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
542 (geiser-menu--defmenu repl geiser-repl-mode-map
543 ("Complete symbol" ((kbd "TAB") (kbd "M-TAB"))
544 geiser-completion--complete-symbol :enable (symbol-at-point))
545 ("Complete module name" ((kbd "C-.") (kbd "M-`"))
546 geiser-completion--complete-module :enable (symbol-at-point))
547 ("Edit symbol" "\M-." geiser-edit-symbol-at-point
548 :enable (symbol-at-point))
550 ("Switch to module..." "\C-c\C-m" switch-to-geiser-module)
551 ("Import module..." "\C-c\C-i" geiser-repl-import-module)
553 ("Previous matching input" "\M-p" comint-previous-matching-input-from-input
554 "Previous input matching current")
555 ("Next matching input" "\M-n" comint-next-matching-input-from-input
556 "Next input matching current")
557 ("Previous input" "\C-c\M-p" comint-previous-input)
558 ("Next input" "\C-c\M-n" comint-next-input)
560 (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode)
561 ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d")
562 geiser-doc-symbol-at-point
563 "Documentation for symbol at point" :enable (symbol-at-point))
564 ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module
565 "Documentation for module at point" :enable (symbol-at-point))
567 ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit
568 :enable (geiser-repl--live-p))
569 ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p)))
570 ("Revive REPL" "\C-c\C-k" geiser-repl-nuke
571 "Use this command if the REPL becomes irresponsive"
572 :enable (geiser-repl--live-p))
574 (custom "REPL options" geiser-repl))
576 (define-key geiser-repl-mode-map [menu-bar completion] 'undefined)
581 (defun geiser-repl--repl-list ()
583 (dolist (repl geiser-repl--repls lst)
584 (when (buffer-live-p repl)
585 (with-current-buffer repl
586 (push geiser-impl--implementation lst))))))
588 (defun geiser-repl--restore (impls)
590 (when impl (run-geiser impl))))
592 (defun geiser-repl-unload-function ()
593 (dolist (repl geiser-repl--repls)
594 (when (buffer-live-p repl)
595 (kill-buffer repl))))
598 (provide 'geiser-repl)
599 ;;; geiser-repl.el ends here