summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
Diffstat (limited to 'elisp')
-rw-r--r--elisp/Makefile.am1
-rw-r--r--elisp/geiser-connection.el274
-rw-r--r--elisp/geiser-eval.el10
-rw-r--r--elisp/geiser-guile.el1
-rw-r--r--elisp/geiser-inf.el89
-rw-r--r--elisp/geiser-log.el1
-rw-r--r--elisp/geiser-racket.el4
-rw-r--r--elisp/geiser-reload.el1
-rw-r--r--elisp/geiser-repl.el379
9 files changed, 386 insertions, 374 deletions
diff --git a/elisp/Makefile.am b/elisp/Makefile.am
index 1f1ca76..d98751b 100644
--- a/elisp/Makefile.am
+++ b/elisp/Makefile.am
@@ -15,6 +15,7 @@ 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-connection.el b/elisp/geiser-connection.el
index dc669aa..d1e7d59 100644
--- a/elisp/geiser-connection.el
+++ b/elisp/geiser-connection.el
@@ -19,8 +19,7 @@
(require 'geiser-base)
(require 'geiser-impl)
-(require 'comint)
-(require 'advice)
+(require 'tq)
;;; Buffer connections:
@@ -71,234 +70,155 @@
;;; Connection datatype:
-(defsubst geiser-con--make-connection (buffer)
+(defun geiser-con--make-connection (proc prompt debug-prompt)
(list :geiser-connection
- (cons :requests (list))
- (cons :current nil)
+ (cons :tq (tq-create proc))
+ (cons :eot (format "\\(%s%s\\)"
+ prompt
+ (if debug-prompt
+ (format "\\|%s" debug-prompt)
+ "")))
+ (cons :prompt prompt)
+ (cons :debug-prompt debug-prompt)
(cons :count 0)
- (cons :completed (make-hash-table :weakness 'value))
- (cons :buffer buffer)
- (cons :reply (geiser-con--make-reply-buffer buffer))))
-
-(defvar geiser-con--eot-regexp nil)
-(geiser-impl--register-local-variable
- 'geiser-con--eot-regexp 'eot-regexp nil
- "A regular expression used to detect end of transmissions.
-By default, Geiser uses the prompt regexp.")
-
-(defun geiser-con--make-reply-buffer (buffer)
- (let ((name (concat " geiser-con-reply: " (buffer-name buffer)))
- (eot (with-current-buffer buffer geiser-con--eot-regexp)))
- (with-current-buffer (get-buffer-create name)
- (setq geiser-con--eot-regexp eot)
- (current-buffer))))
+ (cons :completed (make-hash-table :weakness 'value))))
+
+(defun geiser-con--connection-swap-proc (con proc)
+ (let* ((this-proc (geiser-con--connection-process con))
+ (this-filter (process-filter this-proc))
+ (this-buffer (process-buffer this-proc))
+ (filter (process-filter proc))
+ (buffer (process-buffer proc))
+ (tq (geiser-con--connection-tq con)))
+ (set-process-filter this-proc filter)
+ (set-process-buffer this-proc buffer)
+ (set-process-filter proc this-filter)
+ (set-process-buffer proc this-buffer)
+ (setcdr tq (cons proc (tq-buffer tq)))
+ this-proc))
(defsubst geiser-con--connection-p (c)
(and (listp c) (eq (car c) :geiser-connection)))
-(defsubst geiser-con--connection-buffer (c)
- (cdr (assoc :buffer c)))
-
(defsubst geiser-con--connection-process (c)
- (get-buffer-process (geiser-con--connection-buffer c)))
+ (tq-process (cdr (assoc :tq c))))
+
+(defsubst geiser-con--connection-tq (c)
+ (cdr (assoc :tq c)))
-(defsubst geiser-con--connection-requests (c)
- (cdr (assoc :requests c)))
+(defsubst geiser-con--connection-eot (c)
+ (cdr (assoc :eot c)))
-(defsubst geiser-con--connection-current-request (c)
- (cdr (assoc :current c)))
+(defsubst geiser-con--connection-prompt (c)
+ (cdr (assoc :prompt c)))
-(defsubst geiser-con--connection-reply-buffer (c)
- (cdr (assoc :reply c)))
+(defsubst geiser-con--connection-debug-prompt (c)
+ (cdr (assoc :debug-prompt c)))
(defsubst geiser-con--connection-completed (c r)
(geiser-con--request-deactivate r)
(puthash (geiser-con--request-id r) r (cdr (assoc :completed c))))
-(defun geiser-con--connection-clean-current-request (c)
- (let* ((cell (assoc :current c))
- (req (cdr cell)))
- (when req
- (geiser-con--connection-completed c req)
- (setcdr cell nil))))
-
-(defun geiser-con--connection-add-request (c r)
- (let ((reqs (assoc :requests c)))
- (setcdr reqs (append (cdr reqs) (list r)))))
-
(defsubst geiser-con--connection-completed-p (c id)
(gethash id (cdr (assoc :completed c))))
-(defun geiser-con--connection-pop-request (c)
- (let* ((reqs (assoc :requests c))
- (current (assoc :current c))
- (old-current (cdr current))
- (new-current (cadr reqs))
- (new-reqs (cddr reqs)))
- (when old-current (geiser-con--connection-completed c old-current))
- (setcdr reqs new-reqs)
- (if (and new-current
- (geiser-con--request-deactivated-p new-current))
- (geiser-con--connection-pop-request c)
- (setcdr current new-current))))
-
(defun geiser-con--connection-inc-count (c)
(let* ((cnt (assoc :count c))
(new (1+ (cdr cnt))))
(setcdr cnt new)
new))
-
-;;; Connection setup:
-(make-variable-buffer-local
- (defvar geiser-con--debugging-prompt-regexp nil))
-
-(make-variable-buffer-local
- (defvar geiser-con--debugging-inhibits-eval t))
-
-(make-variable-buffer-local
- (defvar geiser-con--debugging-preamble-regexp nil))
-
-(defun geiser-con--is-debugging (&optional con)
- (with-current-buffer (or (and con (geiser-con--connection-buffer con))
- (current-buffer))
- (and geiser-con--debugging-prompt-regexp
- geiser-con--debugging-inhibits-eval
- comint-last-prompt-overlay
- (string-match-p geiser-con--debugging-prompt-regexp
- (buffer-substring (overlay-start
- comint-last-prompt-overlay)
- (overlay-end
- comint-last-prompt-overlay))))))
-
-(defsubst geiser-con--has-entered-debugger (con)
- (with-current-buffer (geiser-con--connection-buffer con)
- (and geiser-con--debugging-prompt-regexp
- (re-search-backward geiser-con--debugging-prompt-regexp nil t)
- (or (null geiser-con--debugging-preamble-regexp)
- (save-excursion
- (re-search-backward geiser-con--debugging-preamble-regexp
- nil t))))))
-
-(defun geiser-con--connection-teardown ()
- (when geiser-con--connection
- (kill-buffer
- (geiser-con--connection-reply-buffer geiser-con--connection))))
-
-(defun geiser-con--setup-connection (buffer
- prompt-regexp
- &optional debug-prompt-regexp
- debug-preamble-regexp)
- (with-current-buffer buffer
- (geiser-con--connection-teardown)
- (setq geiser-con--debugging-prompt-regexp debug-prompt-regexp)
- (setq geiser-con--debugging-preamble-regexp debug-preamble-regexp)
- (setq geiser-con--connection (geiser-con--make-connection buffer))
- (set (make-local-variable 'comint-redirect-insert-matching-regexp) t)
- (setq comint-prompt-regexp
- (if debug-prompt-regexp
- (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp)
- prompt-regexp))
- (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t)))
+(defun geiser-con--has-entered-debugger (con answer)
+ (let ((dp (geiser-con--connection-debug-prompt con)))
+ (and (stringp dp) (string-match dp answer))))
+
+(defun geiser-con--connection-close (con)
+ (let ((tq (geiser-con--connection-tq con)))
+ (and tq (tq-close tq))))
+
+(defvar geiser-con--connection-sentinel nil)
+(defun geiser-con--connection-sentinel (p s)
+ (setq geiser-con--connection-sentinel
+ (concat geiser-con--connection-sentinel s)))
+
+(defun geiser-con--open-connection (host port prompt debug-prompt)
+ (setq geiser-con--connection-sentinel "")
+ (let ((proc (make-network-process :name "geiser-con"
+ :host host
+ :service port
+ :filter 'geiser-con--connection-sentinel
+ :noquery t)))
+ (with-timeout (10
+ (error (format "Timeout connecting to %s:%s" host port)))
+ (while (not (string-match prompt geiser-con--connection-sentinel))
+ (accept-process-output proc 1)))
+ (geiser-con--make-connection proc prompt debug-prompt)))
;;; Requests handling:
-(defun geiser-con--comint-buffer-form (con)
- (with-current-buffer (geiser-con--connection-reply-buffer con)
- (goto-char (point-max))
- (if (geiser-con--has-entered-debugger con)
+(defun geiser-con--req-form (req answer)
+ (let ((con (geiser-con--request-connection req)))
+ (if (geiser-con--has-entered-debugger con answer)
`((error (key . geiser-debugger))
- (output . ,(buffer-substring (point-min) (point))))
- (condition-case nil
- (progn
- (goto-char (point-min))
- (re-search-forward "((\\(result\\|error\\)\\>")
- (goto-char (match-beginning 0))
- (let ((form (read (current-buffer))))
- (if (listp form) form (error ""))))
+ (output . ,answer))
+ (condition-case err
+ (car (read-from-string answer))
(error `((error (key . geiser-con-error))
- (output . ,(buffer-string))))))))
-
-(defun geiser-con--process-next (con)
- (when (not (geiser-con--connection-current-request con))
- (let* ((buffer (geiser-con--connection-buffer con))
- (req (geiser-con--connection-pop-request con))
- (str (and req (geiser-con--request-string req)))
- (rbuffer (geiser-con--connection-reply-buffer con)))
- (when (and buffer (buffer-live-p buffer) req str)
- (with-current-buffer rbuffer
- (delete-region (point-min) (point-max)))
- (set-buffer buffer)
- (if (geiser-con--is-debugging)
- (geiser-con--connection-completed con req)
- (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str)
- (comint-redirect-send-command (format "%s" str) rbuffer nil t))))))
-
-(defun geiser-con--process-completed-request (req)
- (let* ((cont (geiser-con--request-continuation req))
- (id (geiser-con--request-id req))
- (rstr (geiser-con--request-string req))
- (buffer (geiser-con--request-buffer req))
- (con (geiser-con--request-connection req))
- (form (geiser-con--comint-buffer-form con)))
+ (output . ,(format "%s\n(%s)"
+ answer
+ (error-message-string err)))))))))
+
+(defun geiser-con--process-completed-request (req answer)
+ (let ((cont (geiser-con--request-continuation req))
+ (id (geiser-con--request-id req))
+ (rstr (geiser-con--request-string req))
+ (form (geiser-con--req-form req answer))
+ (buffer (or (geiser-con--request-buffer req) (current-buffer)))
+ (con (geiser-con--request-connection req)))
(if (not cont)
(geiser-log--warn "<%s> Droping result for request %S: %s"
id rstr form)
(condition-case cerr
- (with-current-buffer (or buffer (current-buffer))
+ (with-current-buffer buffer
(funcall cont form)
- (geiser-con--request-deactivate req)
(geiser-log--info "<%s>: processed" id))
(error (geiser-log--error
"<%s>: continuation failed %S \n\t%s" id rstr cerr))))
- (geiser-con--connection-clean-current-request con)))
-
-(defun geiser-con--comint-redirect-hook ()
- (if (not geiser-con--connection)
- (geiser-log--error "No connection in buffer")
- (let ((req (geiser-con--connection-current-request
- geiser-con--connection)))
- (if (not req)
- (geiser-log--error "No current request")
- (geiser-con--process-completed-request req)))))
-
-(defadvice comint-redirect-setup
- (after geiser-con--advice
- (output-buffer comint-buffer finished-regexp &optional echo))
- (with-current-buffer comint-buffer
- (when geiser-con--eot-regexp
- (setq comint-redirect-finished-regexp geiser-con--eot-regexp))
- (when geiser-con--connection (setq mode-line-process nil))))
-(ad-activate 'comint-redirect-setup)
+ (geiser-con--connection-completed con req)))
+
+(defun geiser-con--connection-add-request (c r)
+ (tq-enqueue (geiser-con--connection-tq c)
+ (geiser-con--request-string r)
+ (geiser-con--connection-eot c)
+ r
+ 'geiser-con--process-completed-request
+ t))
;;; Message sending interface:
-(defconst geiser-con--error-message "Geiser connection not active")
+(defun geiser-con--send-string (con str cont &optional sbuf)
+ (let ((req (geiser-con--make-request con str cont sbuf)))
+ (geiser-con--connection-add-request con req)
+ req))
(defvar geiser-connection-timeout 30000
"Time limit, in msecs, blocking on synchronous evaluation requests")
-(defun geiser-con--send-string/wait (b/p str cont &optional timeout sbuf)
+(defun geiser-con--send-string/wait (con str cont &optional timeout sbuf)
(save-current-buffer
- (let* ((con (geiser-con--get-connection b/p))
- (proc (and con (geiser-con--connection-process con))))
- (unless proc (error geiser-con--error-message))
- (when (geiser-con--is-debugging con) (error "REPL is in debug mode"))
- (let* ((req (geiser-con--make-request con str cont sbuf))
+ (let ((proc (and con (geiser-con--connection-process con))))
+ (unless proc (error "Geiser connection not active"))
+ (let* ((req (geiser-con--send-string con str cont sbuf))
(id (geiser-con--request-id req))
- (timeout (/ (or timeout geiser-connection-timeout) 1000.0))
- (waitsecs 0.1))
- (geiser-con--connection-add-request con req)
+ (timeout (/ (or timeout geiser-connection-timeout) 1000.0)))
(with-timeout (timeout (geiser-con--request-deactivate req))
(condition-case nil
(while (and (geiser-con--connection-process con)
(not (geiser-con--connection-completed-p con id)))
- (geiser-con--process-next con)
- (accept-process-output proc waitsecs nil t))
+ (accept-process-output proc (/ timeout 10)))
(error (geiser-con--request-deactivate req))))))))
(provide 'geiser-connection)
-;;; geiser-connection.el ends here
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 3534312..72093cc 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -119,11 +119,11 @@ module-exports, autodoc, callers, callees and generic-methods.")
;;; Code sending:
-(defvar geiser-eval--default-proc-function nil)
+(defvar geiser-eval--default-connection-function nil)
-(defsubst geiser-eval--proc ()
- (and geiser-eval--default-proc-function
- (funcall geiser-eval--default-proc-function)))
+(defsubst geiser-eval--connection ()
+ (and geiser-eval--default-connection-function
+ (funcall geiser-eval--default-connection-function)))
(defsubst geiser-eval--log (s)
(geiser-log--info "RETORT: %S" s)
@@ -138,7 +138,7 @@ module-exports, autodoc, callers, callees and generic-methods.")
(defun geiser-eval--send/wait (code &optional timeout buffer)
(setq geiser-eval--sync-retort nil)
- (geiser-con--send-string/wait (geiser-eval--proc)
+ (geiser-con--send-string/wait (geiser-eval--connection)
(geiser-eval--code-str code)
'geiser-eval--set-sync-retort
timeout
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index f410674..3979688 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -252,7 +252,6 @@ it spawn a server thread."
(set (make-local-variable 'compilation-error-regexp-alist)
`((,geiser-guile--path-rx geiser-guile--resolve-file-x)
("^ +\\([0-9]+\\):\\([0-9]+\\)" nil 1 2)))
- (setq geiser-con--debugging-inhibits-eval nil)
(compilation-setup t)
(font-lock-add-keywords nil
`((,geiser-guile--path-rx 1
diff --git a/elisp/geiser-inf.el b/elisp/geiser-inf.el
new file mode 100644
index 0000000..833850a
--- /dev/null
+++ b/elisp/geiser-inf.el
@@ -0,0 +1,89 @@
+;;; 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-cmd ()
+ "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-log.el b/elisp/geiser-log.el
index d078b19..49b067d 100644
--- a/elisp/geiser-log.el
+++ b/elisp/geiser-log.el
@@ -44,7 +44,6 @@
"Simple mode for Geiser log messages buffer."
(kill-all-local-variables)
(buffer-disable-undo)
- (set (make-local-variable 'comint-redirect-subvert-readonly) t)
(add-hook 'after-change-functions
'(lambda (b e len)
(let ((inhibit-read-only t))
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index 8c66e67..4152a22 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -84,6 +84,8 @@ This function uses `geiser-racket-init-file' if it exists."
(defconst geiser-racket--prompt-regexp "^=?\\(mzscheme\\|racket\\)@[^ ]*?> ")
+(defconst geiser-racket--init-server-cmd ",start-geiser")
+
;;; Evaluation support:
@@ -241,8 +243,8 @@ using start-geiser, a procedure in the geiser/server module."
(unsupported-procedures '(callers callees generic-methods))
(binary geiser-racket--binary)
(arglist geiser-racket--parameters)
+ (init-server-cmd geiser-racket--init-server-cmd)
(startup)
- (eot-regexp "\0")
(prompt-regexp geiser-racket--prompt-regexp)
(marshall-procedure geiser-racket--geiser-procedure)
(find-module geiser-racket--get-module)
diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el
index a5c0125..ca3eb1c 100644
--- a/elisp/geiser-reload.el
+++ b/elisp/geiser-reload.el
@@ -38,6 +38,7 @@
geiser-connection
geiser-syntax
geiser-menu
+ geiser-inf
geiser-impl
geiser-custom
geiser-log
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 06:37:37 +0000