summaryrefslogtreecommitdiff
path: root/elisp/geiser-repl.el
diff options
context:
space:
mode:
Diffstat (limited to 'elisp/geiser-repl.el')
-rw-r--r--elisp/geiser-repl.el379
1 files changed, 190 insertions, 189 deletions
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index a05346c..9136db5 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -13,6 +13,7 @@
(require 'geiser-autodoc)
(require 'geiser-edit)
(require 'geiser-completion)
+(require 'geiser-inf)
(require 'geiser-impl)
(require 'geiser-eval)
(require 'geiser-connection)
@@ -106,6 +107,34 @@ expression, if any."
:group 'geiser-repl)
+;;; Implementation-dependent parameters
+
+(geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp ()
+ "A variable (or thunk returning a value) giving the regular
+expression for this implementation's geiser scheme prompt.")
+
+(geiser-impl--define-caller
+ geiser-repl--debugger-prompt-regexp debugger-prompt-regexp ()
+ "A variable (or thunk returning a value) giving the regular
+expression for this implementation's debugging prompt.")
+
+(geiser-impl--define-caller geiser-repl--startup startup ()
+ "Function taking no parameters that is called after the REPL
+has been initialised. All Geiser functionality is available to
+you at that point.")
+
+(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module)
+ "Function taking a module designator and returning a REPL enter
+module command as a string")
+
+(geiser-impl--define-caller geiser-repl--import-cmd import-command (module)
+ "Function taking a module designator and returning a REPL import
+module command as a string")
+
+(geiser-impl--define-caller geiser-repl--exit-cmd exit-command ()
+ "Function returning the REPL exit command as a string")
+
+
;;; Geiser REPL buffers and processes:
(defvar geiser-repl--repls nil)
@@ -161,50 +190,35 @@ expression, if any."
(geiser-repl-mode)
(geiser-impl--set-buffer-implementation impl)))))
-(geiser-impl--define-caller geiser-repl--binary binary ()
- "A variable or function returning the path to the scheme binary
-for this implementation.")
-
-(geiser-impl--define-caller geiser-repl--arglist arglist ()
- "A function taking no arguments and returning a list of
-arguments to be used when invoking the scheme binary.")
-
-(geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp ()
- "A variable (or thunk returning a value) giving the regular
-expression for this implementation's scheme prompt.")
+(defun geiser-repl--read-impl (prompt &optional active)
+ (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))
-(geiser-impl--define-caller
- geiser-repl--debugger-prompt-regexp debugger-prompt-regexp ()
- "A variable (or thunk returning a value) giving the regular
-expression for this implementation's debugging prompt.")
+(defsubst geiser-repl--only-impl-p ()
+ (and (null (cdr geiser-active-implementations))
+ (car geiser-active-implementations)))
-(geiser-impl--define-caller
- geiser-repl--debugger-preamble-regexp debugger-preamble-regexp ()
- "A variable (or thunk returning a value) used to determine whether
-the REPL has entered debugging mode.")
+(defun geiser-repl--get-impl (prompt)
+ (or (geiser-repl--only-impl-p)
+ (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation)
+ (geiser-repl--read-impl prompt)))
-(geiser-impl--define-caller geiser-repl--startup startup ()
- "Function taking no parameters that is called after the REPL
-has been initialised. All Geiser functionality is available to
-you at that point.")
+
+;;; REPL connections
-(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module)
- "Function taking a module designator and returning a REPL enter
-module command as a string")
+(make-variable-buffer-local
+ (defvar geiser-repl--address nil))
-(geiser-impl--define-caller geiser-repl--import-cmd import-command (module)
- "Function taking a module designator and returning a REPL import
-module command as a string")
+(make-variable-buffer-local
+ (defvar geiser-repl--connection nil))
-(geiser-impl--define-caller geiser-repl--exit-cmd exit-command ()
- "Function returning the REPL exit command as a string")
+(make-variable-buffer-local
+ (defvar geiser-repl--remote-p nil))
(make-variable-buffer-local
- (defvar geiser-repl--address nil))
+ (defvar geiser-repl--inferior-buffer nil))
(defsubst geiser-repl--host () (car geiser-repl--address))
(defsubst geiser-repl--port () (cdr geiser-repl--address))
-(defsubst geiser-repl--remote-p () geiser-repl--address)
(defun geiser-repl--get-address (&optional host port)
(let ((defhost (or (geiser-repl--host) geiser-repl-default-host))
@@ -214,124 +228,53 @@ module command as a string")
nil nil defhost))
(or port (read-number "Port: " defport)))))
-(defun geiser-repl--save-remote-data (remote address)
- (setq geiser-repl--address (and remote address))
+(defun geiser-repl--save-remote-data (address remote)
+ (setq geiser-repl--address address)
+ (setq geiser-repl--remote-p remote)
(setq header-line-format (and remote
(format "Host: %s Port: %s"
(geiser-repl--host)
(geiser-repl--port)))))
-(defun geiser-repl--start-repl (impl &optional remote host port)
+(defun geiser-repl--start-repl (impl host port remote)
(message "Starting Geiser REPL for %s ..." impl)
(geiser-repl--to-repl-buffer impl)
- (let ((program (if remote (geiser-repl--get-address host port)
- (geiser-repl--binary impl)))
- (args (geiser-repl--arglist impl))
+ (goto-char (point-max))
+ (let ((address (geiser-repl--get-address host port))
(prompt-rx (geiser-repl--prompt-regexp impl))
(deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
- (deb-preamble-rx (geiser-repl--debugger-preamble-regexp impl))
(cname (geiser-repl--repl-name impl)))
- (unless (and program prompt-rx)
+ (unless prompt-rx
(error "Sorry, I don't know how to start a REPL for %s" impl))
- (set (make-local-variable 'comint-prompt-regexp) prompt-rx)
- (geiser-repl--save-remote-data remote program)
+ (geiser-repl--save-remote-data address remote)
(condition-case err
- (apply 'make-comint-in-buffer
- `(,cname ,(current-buffer) ,program nil ,@args))
+ (progn
+ (setq geiser-repl--connection
+ (geiser-con--open-connection (car address)
+ (cdr address)
+ prompt-rx
+ deb-prompt-rx))
+ (set (make-local-variable 'comint-prompt-regexp)
+ (geiser-con--connection-eot geiser-repl--connection))
+ (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,address)))
(error (insert "Unable to start REPL:\n\n"
(error-message-string err) "\n")
(error "Couldn't start Geiser")))
- (geiser-repl--wait-for-prompt 10000)
+ (geiser-inf--wait-for-prompt 10000)
(geiser-repl--history-setup)
- (geiser-con--setup-connection (current-buffer)
- prompt-rx
- deb-prompt-rx
- deb-preamble-rx)
(add-to-list 'geiser-repl--repls (current-buffer))
(geiser-repl--set-this-buffer-repl (current-buffer))
(geiser-repl--startup impl)
- (message "Geiser REPL up and running!")))
+ (message "%s up and running!" (geiser-repl--repl-name impl))))
-(defun geiser-repl--process ()
+(defun geiser-repl--connection ()
(let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
- (or (and (buffer-live-p buffer) (get-buffer-process buffer))
+ (or (and (buffer-live-p buffer)
+ (get-buffer-process buffer)
+ (with-current-buffer buffer geiser-repl--connection))
(error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
-(setq geiser-eval--default-proc-function 'geiser-repl--process)
-
-(defun geiser-repl--wait-for-prompt (timeout)
- (let ((p (point)) (seen) (buffer (current-buffer)))
- (while (and (not seen)
- (> timeout 0)
- (get-buffer-process buffer))
- (sleep-for 0.1)
- (setq timeout (- timeout 100))
- (goto-char p)
- (setq seen (re-search-forward comint-prompt-regexp nil t)))
- (goto-char (point-max))
- (unless seen (error "No prompt found!"))))
-
-
-;;; Interface: starting and interacting with geiser REPL:
-
-(defun geiser-repl--read-impl (prompt &optional active)
- (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))
-
-(defsubst geiser-repl--only-impl-p ()
- (and (null (cdr geiser-active-implementations))
- (car geiser-active-implementations)))
-
-(defun run-geiser (impl)
- "Start a new Geiser REPL."
- (interactive
- (list (or (geiser-repl--only-impl-p)
- (and (eq major-mode 'geiser-repl-mode)
- geiser-impl--implementation)
- (geiser-repl--read-impl
- "Start Geiser for scheme implementation: "))))
- (geiser-repl--start-repl impl))
-
-(defun geiser-connect (impl &optional host port)
- "Start a new Geiser REPL connected to a remote Scheme process."
- (interactive
- (list (or (geiser-repl--only-impl-p)
- (and (eq major-mode 'geiser-repl-mode)
- geiser-impl--implementation)
- (geiser-repl--read-impl
- "Scheme implementation: "))))
- (geiser-repl--start-repl impl t host port))
-
-(make-variable-buffer-local
- (defvar geiser-repl--last-scm-buffer nil))
-
-(defun switch-to-geiser (&optional ask impl buffer)
- "Switch to running Geiser REPL.
-With prefix argument, ask for which one if more than one is running.
-If no REPL is running, execute `run-geiser' to start a fresh one."
- (interactive "P")
- (let* ((impl (or impl geiser-impl--implementation))
- (in-repl (eq major-mode 'geiser-repl-mode))
- (in-live-repl (and in-repl (get-buffer-process (current-buffer))))
- (repl (cond ((and (not ask)
- (not impl)
- (not in-repl)
- (or geiser-repl--repl (car geiser-repl--repls))))
- ((and (not ask)
- (not in-repl)
- impl
- (geiser-repl--repl/impl impl)))))
- (pop-up-windows geiser-repl-window-allow-split))
- (cond ((or in-live-repl
- (and (eq (current-buffer) repl) (not (eq repl buffer))))
- (when (buffer-live-p geiser-repl--last-scm-buffer)
- (pop-to-buffer geiser-repl--last-scm-buffer)))
- (repl (pop-to-buffer repl))
- ((geiser-repl--remote-p) (geiser-connect impl))
- (t (run-geiser impl)))
- (when (and buffer (eq major-mode 'geiser-repl-mode))
- (setq geiser-repl--last-scm-buffer buffer))))
-
-(defalias 'geiser 'switch-to-geiser)
+(setq geiser-eval--default-connection-function 'geiser-repl--connection)
(defun geiser-repl--send (cmd)
(when (and cmd (eq major-mode 'geiser-repl-mode))
@@ -341,64 +284,25 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
(let ((comint-input-filter (lambda (x) nil)))
(comint-send-input nil t))))
-(defun switch-to-geiser-module (&optional module buffer)
- "Switch to running Geiser REPL and try to enter a given module."
- (interactive)
- (let* ((module (or module
- (geiser-completion--read-module
- "Switch to module (default top-level): ")))
- (cmd (and module
- (geiser-repl--enter-cmd geiser-impl--implementation
- module))))
- (unless (eq major-mode 'geiser-repl-mode)
- (switch-to-geiser nil nil (or buffer (current-buffer))))
- (geiser-repl--send cmd)))
-
-(defun geiser-repl-import-module (&optional module)
- "Import a given module in the current namespace of the REPL."
- (interactive)
- (let* ((module (or module
- (geiser-completion--read-module "Import module: ")))
- (cmd (and module
- (geiser-repl--import-cmd geiser-impl--implementation
- module))))
- (switch-to-geiser nil nil (current-buffer))
- (geiser-repl--send cmd)))
-
-(defun geiser-repl-exit (&optional arg)
- "Exit the current REPL.
-With a prefix argument, force exit by killing the scheme process."
- (interactive "P")
- (when (or (not geiser-repl-query-on-exit-p)
- (y-or-n-p "Really quit this REPL? "))
- (let ((cmd (and (not arg)
- (geiser-repl--exit-cmd geiser-impl--implementation))))
- (if cmd
- (when (stringp cmd) (geiser-repl--send cmd))
- (comint-kill-subjob)))))
-
-(defun geiser-repl-nuke ()
- "Try this command if the REPL becomes unresponsive."
- (interactive)
- (goto-char (point-max))
- (comint-kill-region comint-last-input-start (point))
- (comint-redirect-cleanup)
- (geiser-con--setup-connection (current-buffer)
- comint-prompt-regexp
- geiser-con--debugging-prompt-regexp
- geiser-con--debugging-preamble-regexp))
-
;;; REPL history and clean-up:
(defsubst geiser-repl--history-file ()
(format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))
+(defun geiser-repl--quit-inf ()
+ (when (buffer-live-p geiser-repl--inferior-buffer)
+ (with-current-buffer geiser-repl--inferior-buffer
+ (let ((geiser-repl-query-on-exit-p nil))
+ (geiser-repl-exit)))))
+
(defun geiser-repl--on-quit ()
(comint-write-input-ring)
(let ((cb (current-buffer))
(impl geiser-impl--implementation)
(comint-prompt-read-only nil))
+ (ignore-errors (geiser-con--connection-close geiser-repl--connection))
+ (geiser-repl--quit-inf)
(setq geiser-repl--repls (remove cb geiser-repl--repls))
(dolist (buffer (buffer-list))
(when (buffer-live-p buffer)
@@ -415,10 +319,10 @@ With a prefix argument, force exit by killing the scheme process."
(comint-input-ring-file-name (geiser-repl--history-file)))
(geiser-repl--on-quit)
(push pb geiser-repl--closed-repls)
- (when (buffer-name (current-buffer))
- (comint-kill-region comint-last-input-start (point))
- (insert "\nIt's been nice interacting with you!\n")
- (insert "Press C-c C-z to bring me back.\n" )))))))
+ (goto-char (point-max))
+ (comint-kill-region comint-last-input-start (point))
+ (insert "\nIt's been nice interacting with you!\n")
+ (insert "Press C-c C-z to bring me back.\n" ))))))
(defun geiser-repl--on-kill ()
(geiser-repl--on-quit)
@@ -426,7 +330,7 @@ With a prefix argument, force exit by killing the scheme process."
(remove (current-buffer) geiser-repl--closed-repls)))
(defun geiser-repl--input-filter (str)
- (not (or (geiser-con--is-debugging)
+ (not (or ;; (geiser-con--is-debugging)
(string-match "^\\s *$" str)
(string-match "^,quit *$" str))))
@@ -497,7 +401,8 @@ With a prefix argument, force exit by killing the scheme process."
(intxt (and pmark (buffer-substring pmark (point)))))
(when intxt
(when (and geiser-repl-forget-old-errors-p
- (not (geiser-con--is-debugging)))
+;;; (not (geiser-con--is-debugging)))
+ )
(compilation-forget-errors))
(comint-send-input)
(when (string-match "^\\s-*$" intxt)
@@ -545,7 +450,6 @@ buffer."
(setq geiser-eval--get-module-function 'geiser-repl--module-function)
(when geiser-repl-autodoc-p
(geiser--save-msg (geiser-autodoc-mode 1)))
- (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging)
(geiser-company--setup geiser-repl-company-p)
;; enabling compilation-shell-minor-mode without the annoying highlighter
(compilation-setup t))
@@ -588,15 +492,104 @@ buffer."
("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit
:enable (geiser-repl--live-p))
("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p)))
- ("Revive REPL" "\C-c\C-k" geiser-repl-nuke
- "Use this command if the REPL becomes irresponsive"
- :enable (geiser-repl--live-p))
--
(custom "REPL options" geiser-repl))
(define-key geiser-repl-mode-map [menu-bar completion] 'undefined)
+;;; User commands
+
+(defun run-geiser (impl)
+ "Start a new Geiser REPL."
+ (interactive
+ (list (geiser-repl--get-impl "Start Geiser for scheme implementation: ")))
+ (message "Starting Scheme process...")
+ (let* ((b/p (geiser-inf--run-scheme impl))
+ (inf-buff (car b/p))
+ (port (cadr b/p)))
+ (unless port
+ (when (bufferp inf-buff) (pop-to-buffer inf-buff))
+ (error "%s" "Couldn't connect to inferior scheme process"))
+ (geiser-repl--start-repl impl "localhost" port nil)
+ (setq geiser-repl--inferior-buffer inf-buff)
+ (with-current-buffer inf-buff (setq geiser-impl--implementation impl))))
+
+(defalias 'geiser 'run-geiser)
+
+(defun geiser-connect (impl &optional host port)
+ "Start a new Geiser REPL connected to a remote Scheme process."
+ (interactive
+ (list (geiser-repl--get-impl "Connect to Scheme implementation: ")))
+ (geiser-repl--start-repl impl host port t))
+
+(make-variable-buffer-local
+ (defvar geiser-repl--last-scm-buffer nil))
+
+(defun switch-to-geiser (&optional ask impl buffer)
+ "Switch to running Geiser REPL.
+With prefix argument, ask for which one if more than one is running.
+If no REPL is running, execute `run-geiser' to start a fresh one."
+ (interactive "P")
+ (let* ((impl (or impl geiser-impl--implementation))
+ (in-repl (eq major-mode 'geiser-repl-mode))
+ (in-live-repl (and in-repl (get-buffer-process (current-buffer))))
+ (repl (cond ((and (not ask)
+ (not impl)
+ (not in-repl)
+ (or geiser-repl--repl (car geiser-repl--repls))))
+ ((and (not ask)
+ (not in-repl)
+ impl
+ (geiser-repl--repl/impl impl)))))
+ (pop-up-windows geiser-repl-window-allow-split))
+ (cond ((or in-live-repl
+ (and (eq (current-buffer) repl) (not (eq repl buffer))))
+ (when (buffer-live-p geiser-repl--last-scm-buffer)
+ (pop-to-buffer geiser-repl--last-scm-buffer)))
+ (repl (pop-to-buffer repl))
+ (geiser-repl--remote-p (geiser-connect impl))
+ (t (run-geiser impl)))
+ (when (and buffer (eq major-mode 'geiser-repl-mode))
+ (setq geiser-repl--last-scm-buffer buffer))))
+
+(defun switch-to-geiser-module (&optional module buffer)
+ "Switch to running Geiser REPL and try to enter a given module."
+ (interactive)
+ (let* ((module (or module
+ (geiser-completion--read-module
+ "Switch to module (default top-level): ")))
+ (cmd (and module
+ (geiser-repl--enter-cmd geiser-impl--implementation
+ module))))
+ (unless (eq major-mode 'geiser-repl-mode)
+ (switch-to-geiser nil nil (or buffer (current-buffer))))
+ (geiser-repl--send cmd)))
+
+(defun geiser-repl-import-module (&optional module)
+ "Import a given module in the current namespace of the REPL."
+ (interactive)
+ (let* ((module (or module
+ (geiser-completion--read-module "Import module: ")))
+ (cmd (and module
+ (geiser-repl--import-cmd geiser-impl--implementation
+ module))))
+ (switch-to-geiser nil nil (current-buffer))
+ (geiser-repl--send cmd)))
+
+(defun geiser-repl-exit (&optional arg)
+ "Exit the current REPL.
+With a prefix argument, force exit by killing the scheme process."
+ (interactive "P")
+ (when (or (not geiser-repl-query-on-exit-p)
+ (y-or-n-p "Really quit this REPL? "))
+ (let ((cmd (and (not arg)
+ (geiser-repl--exit-cmd geiser-impl--implementation))))
+ (if cmd
+ (when (stringp cmd) (geiser-repl--send cmd))
+ (comint-kill-subjob)))))
+
+
;;; Unload:
(defun geiser-repl--repl-list ()
@@ -604,17 +597,25 @@ buffer."
(dolist (repl geiser-repl--repls lst)
(when (buffer-live-p repl)
(with-current-buffer repl
- (push geiser-impl--implementation lst))))))
+ (push (cons geiser-impl--implementation
+ (when geiser-repl--remote-p
+ (list geiser-repl--host geiser-repl--port)))
+ lst))))))
(defun geiser-repl--restore (impls)
(dolist (impl impls)
- (when impl (run-geiser impl))))
+ (when impl
+ (if (cdr impl)
+ (geiser-connect (car impl) (cadr impl) (caddr impl))
+ (run-geiser (car impl))))))
(defun geiser-repl-unload-function ()
(dolist (repl geiser-repl--repls)
(when (buffer-live-p repl)
- (kill-buffer repl))))
+ (with-current-buffer repl
+ (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit))
+ (sit-for 0.05)
+ (kill-buffer)))))
(provide 'geiser-repl)
-;;; geiser-repl.el ends here