diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/Makefile.am | 1 | ||||
| -rw-r--r-- | elisp/geiser-inf.el | 89 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 129 |
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) |