From dfc900c0e2f59edfb06bbdabfc4bcde172d6ced9 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 11 Nov 2010 03:01:33 +0100 Subject: Partial work (connections working) --- elisp/Makefile.am | 1 + elisp/geiser-connection.el | 274 +++++++++++++----------------------- elisp/geiser-eval.el | 10 +- elisp/geiser-inf.el | 83 +++++++++++ elisp/geiser-log.el | 1 - elisp/geiser-racket.el | 1 - elisp/geiser-reload.el | 1 + elisp/geiser-repl.el | 338 +++++++++++++++++++++------------------------ 8 files changed, 342 insertions(+), 367 deletions(-) create mode 100644 elisp/geiser-inf.el (limited to 'elisp') 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-inf.el b/elisp/geiser-inf.el new file mode 100644 index 0000000..4b7020e --- /dev/null +++ b/elisp/geiser-inf.el @@ -0,0 +1,83 @@ +;;; 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 . + +;; 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-regexp prompt-regexp () + "A variable (or thunk returning a value) giving the regular +expression for this implementation's scheme prompt.") + +(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))) + + +;; 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-regexp impl))) + (unless (and bin args prompt-rx) + (error "Sorry, I don't know how to start %s" impl)) + (with-current-buffer (geiser-inf--make-buffer impl) + (setq comint-prompt-regexp prompt-rx) + (condition-case err + (apply 'make-comint-in-buffer + `(,(buffer-name) ,(current-buffer) ,bin nil ,@args)) + (error (error "Unable to start REPL: %s" (error-message-string err)))) + (geiser-inf--wait-for-prompt 10000) + (cons (current-buffer) + (comint-redirect-results-list (geiser-inf--server-init-cmd impl) + "(server-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..c680907 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -242,7 +242,6 @@ using start-geiser, a procedure in the geiser/server module." (binary geiser-racket--binary) (arglist geiser-racket--parameters) (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..fcf7278 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) @@ -105,6 +106,30 @@ expression, if any." :type 'integer :group 'geiser-repl) + +;;; Implementation-dependent parameters + +(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: @@ -161,50 +186,27 @@ 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.") - -(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--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--read-impl (prompt &optional active) + (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) -(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.") +(defsubst geiser-repl--only-impl-p () + (and (null (cdr geiser-active-implementations)) + (car geiser-active-implementations))) -(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") + +;;; REPL connections -(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--address 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--connection nil)) (make-variable-buffer-local - (defvar geiser-repl--address nil)) + (defvar geiser-remote-p 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 +216,52 @@ 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-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)) - (prompt-rx (geiser-repl--prompt-regexp impl)) + (let ((address (geiser-repl--get-address host port)) + (prompt-rx (geiser-inf--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!"))) -(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,53 +271,6 @@ 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: @@ -399,6 +282,7 @@ With a prefix argument, force exit by killing the scheme process." (let ((cb (current-buffer)) (impl geiser-impl--implementation) (comint-prompt-read-only nil)) + (ignore-errors (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) @@ -426,7 +310,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 +381,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 +430,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,14 +472,102 @@ 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 (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 nil nil nil)) + +(defalias 'geiser 'run-geiser) + +(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 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: -- cgit v1.2.3