summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--elisp/Makefile.am1
-rw-r--r--elisp/geiser-inf.el89
-rw-r--r--elisp/geiser-repl.el129
3 files changed, 73 insertions, 146 deletions
diff --git a/elisp/Makefile.am b/elisp/Makefile.am
index d98751b..1f1ca76 100644
--- a/elisp/Makefile.am
+++ b/elisp/Makefile.am
@@ -15,7 +15,6 @@ dist_lisp_LISP = \
geiser-eval.el \
geiser-guile.el \
geiser-impl.el \
- geiser-inf.el \
geiser-log.el \
geiser-menu.el \
geiser-mode.el \
diff --git a/elisp/geiser-inf.el b/elisp/geiser-inf.el
deleted file mode 100644
index 329beea..0000000
--- a/elisp/geiser-inf.el
+++ /dev/null
@@ -1,89 +0,0 @@
-;;; geiser-inf.el -- inferior scheme processes
-
-;; Copyright (c) 2010 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Thu Nov 11, 2010 01:04
-
-
-(require 'geiser-impl)
-(require 'geiser-base)
-
-(require 'cmuscheme)
-
-
-;; Implementation-dependent parameters
-
-(geiser-impl--define-caller geiser-inf--binary binary ()
- "A variable or function returning the path to the scheme binary
-for this implementation.")
-
-(geiser-impl--define-caller geiser-inf--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-inf--prompt-re inferior-prompt-regexp ()
- "A variable (or thunk returning a value) giving the regular
-expression for this implementation's inferior scheme prompt. By default,
-cmuscheme's prompt regexp will be used.")
-
-(geiser-impl--define-caller geiser-inf--init-server-cmd init-server-command ()
- "A variable (or thunk returning a value) giving the REPL server
-initialization command for local processes. The command must return a
-list of the form (server PORT).")
-
-
-;; Auxiliary functions
-
-(defun geiser-inf--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 "%s" "No prompt found!"))))
-
-(defun geiser-inf--make-buffer (impl)
- (with-current-buffer (generate-new-buffer (format " * inferior %s *" impl))
- (inferior-scheme-mode)
- (current-buffer)))
-
-(defun geiser-inf--sentinel (proc evnt)
- (let ((buff (process-buffer proc)))
- (when (buffer-live-p buff) (kill-buffer buff))))
-
-
-;; Starting an inferior REPL
-
-(defun geiser-inf--run-scheme (impl)
- (let ((bin (geiser-inf--binary impl))
- (args (geiser-inf--arglist impl))
- (prompt-rx (geiser-inf--prompt-re impl)))
- (unless (and bin args)
- (error "Sorry, I don't know how to start %s" impl))
- (with-current-buffer (geiser-inf--make-buffer impl)
- (when prompt-rx comint-prompt-regexp prompt-rx)
- (condition-case err
- (apply 'make-comint-in-buffer
- `(,(buffer-name) ,(current-buffer) ,bin nil ,@args))
- (error (error "Error starting inferior %s REPL: %s"
- impl (error-message-string err))))
- (geiser-inf--wait-for-prompt 10000)
- (set-process-sentinel (get-buffer-process (current-buffer))
- 'geiser-inf--sentinel)
- (cons (current-buffer)
- (comint-redirect-results-list (geiser-inf--init-server-cmd impl)
- "(port \\([0-9]+\\))"
- 1)))))
-
-
-(provide 'geiser-inf)
-
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index e6f01d4..fd1da7f 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -13,7 +13,6 @@
(require 'geiser-autodoc)
(require 'geiser-edit)
(require 'geiser-completion)
-(require 'geiser-inf)
(require 'geiser-impl)
(require 'geiser-eval)
(require 'geiser-connection)
@@ -109,6 +108,14 @@ expression, if any."
;;; Implementation-dependent parameters
+(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 geiser scheme prompt.")
@@ -211,16 +218,12 @@ module command as a string")
(make-variable-buffer-local
(defvar geiser-repl--connection nil))
-(make-variable-buffer-local
- (defvar geiser-repl--remote-p nil))
-
-(make-variable-buffer-local
- (defvar geiser-repl--inferior-buffer nil))
+(defun geiser-repl--remote-p () geiser-repl--address)
(defsubst geiser-repl--host () (car geiser-repl--address))
(defsubst geiser-repl--port () (cdr geiser-repl--address))
-(defun geiser-repl--get-address (&optional host port)
+(defun geiser-repl--read-address (&optional host port)
(let ((defhost (or (geiser-repl--host) geiser-repl-default-host))
(defport (or (geiser-repl--port) geiser-repl-default-port)))
(cons (or host
@@ -232,35 +235,26 @@ module command as a string")
(when (or geiser-repl-autodoc-p (< n 0))
(geiser--save-msg (geiser-autodoc-mode n))))
-(defun geiser-repl--save-remote-data (address remote)
+(defun geiser-repl--save-remote-data (address)
(setq geiser-repl--address address)
- (setq geiser-repl--remote-p remote)
- (setq header-line-format (and remote
+ (setq header-line-format (and address
(format "Host: %s Port: %s"
(geiser-repl--host)
(geiser-repl--port)))))
-(defun geiser-repl--start-repl (impl host port remote)
+(defun geiser-repl--start-repl (impl address)
(message "Starting Geiser REPL for %s ..." impl)
(geiser-repl--to-repl-buffer impl)
+ (sit-for 0)
(goto-char (point-max))
(geiser-repl--autodoc-mode -1)
- (let ((address (geiser-repl--get-address host port))
- (prompt-rx (geiser-repl--prompt-regexp impl))
- (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
- (cname (geiser-repl--repl-name impl)))
+ (let* ((prompt-rx (geiser-repl--prompt-regexp impl))
+ (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
+ (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx)))
(unless prompt-rx
(error "Sorry, I don't know how to start a REPL for %s" impl))
- (geiser-repl--save-remote-data address remote)
- (condition-case err
- (progn
- (set (make-local-variable 'comint-prompt-regexp)
- (geiser-con--combined-prompt prompt-rx deb-prompt-rx))
- (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-inf--wait-for-prompt 10000)
+ (geiser-repl--save-remote-data address)
+ (geiser-repl--start-scheme impl address prompt)
(geiser-repl--history-setup)
(add-to-list 'geiser-repl--repls (current-buffer))
(geiser-repl--set-this-buffer-repl (current-buffer))
@@ -268,10 +262,49 @@ module command as a string")
(geiser-con--make-connection (get-buffer-process (current-buffer))
prompt-rx
deb-prompt-rx))
- (geiser-repl--startup impl remote)
+ (geiser-repl--startup impl address)
(geiser-repl--autodoc-mode 1)
(message "%s up and running!" (geiser-repl--repl-name impl))))
+(defun geiser-repl--start-scheme (impl address prompt)
+ (setq comint-prompt-regexp prompt)
+ (let* ((name (geiser-repl--repl-name impl))
+ (buff (current-buffer))
+ (args (if address (list address)
+ `(,(geiser-repl--binary impl)
+ nil
+ ,@(geiser-repl--arglist impl)))))
+ (condition-case err
+ (apply 'make-comint-in-buffer `(,name ,buff ,@args))
+ (error (insert "Unable to start REPL:\n"
+ (error-message-string err)
+ "\n")
+ (error "Couldn't start Geiser")))
+ (geiser-repl--wait-for-prompt 10000)))
+
+(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 "%s" "No prompt found!"))))
+
+(defun geiser-repl--is-debugging ()
+ (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection)))
+ (and dp
+ comint-last-prompt-overlay
+ (save-excursion
+ (goto-char (overlay-start comint-last-prompt-overlay))
+ (re-search-forward dp
+ (overlay-end comint-last-prompt-overlay)
+ t)))))
+
(defun geiser-repl--connection ()
(let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
(or (and (buffer-live-p buffer)
@@ -303,19 +336,13 @@ module command as a string")
(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)
+ (geiser-con--connection-deactivate geiser-repl--connection)
+ (geiser-con--connection-close geiser-repl--connection)
(setq geiser-repl--repls (remove cb geiser-repl--repls))
(dolist (buffer (buffer-list))
(when (buffer-live-p buffer)
@@ -343,7 +370,7 @@ module command as a string")
(remove (current-buffer) geiser-repl--closed-repls)))
(defun geiser-repl--input-filter (str)
- (not (or ;; (geiser-con--is-debugging)
+ (not (or (geiser-repl--is-debugging)
(string-match "^\\s *$" str)
(string-match "^,quit *$" str))))
@@ -413,10 +440,9 @@ module command as a string")
(pmark (and proc (process-mark proc)))
(intxt (and pmark (buffer-substring pmark (point)))))
(when intxt
- (when (and geiser-repl-forget-old-errors-p
-;;; (not (geiser-con--is-debugging)))
- )
- (compilation-forget-errors))
+ (and geiser-repl-forget-old-errors-p
+ (not (geiser-repl--is-debugging))
+ (compilation-forget-errors))
(geiser-repl--prepare-send)
(comint-send-input)
(when (string-match "^\\s-*$" intxt)
@@ -516,16 +542,7 @@ buffer."
"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))))
+ (geiser-repl--start-repl impl nil))
(defalias 'geiser 'run-geiser)
@@ -533,7 +550,8 @@ buffer."
"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))
+ (geiser-repl--start-repl impl
+ (geiser-repl--read-address host port)))
(make-variable-buffer-local
(defvar geiser-repl--last-scm-buffer nil))
@@ -560,7 +578,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
(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))
+ ((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))))
@@ -610,16 +628,15 @@ With a prefix argument, force exit by killing the scheme process."
(when (buffer-live-p repl)
(with-current-buffer repl
(push (cons geiser-impl--implementation
- (when geiser-repl--remote-p
- (list (geiser-repl--host) (geiser-repl--port))))
+ geiser-repl--address)
lst))))))
(defun geiser-repl--restore (impls)
(dolist (impl impls)
(when impl
- (if (cdr impl)
- (geiser-connect (car impl) (cadr impl) (caddr impl))
- (run-geiser (car impl))))))
+ (condition-case err
+ (geiser-repl--start-repl (car impl) (cdr impl))
+ (error (message (error-message-string err)))))))
(defun geiser-repl-unload-function ()
(dolist (repl geiser-repl--repls)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-01 23:25:12 +0000