From eac44dafd8a451e0f452c489b4da52e7eea84ec3 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 16 Mar 2009 01:39:28 +0100 Subject: Many a bug fix in multiple implementation support. --- elisp/geiser-doc.el | 2 +- elisp/geiser-eval.el | 7 +------ elisp/geiser-impl.el | 32 ++++++++++++++++++++++++++------ elisp/geiser-mode.el | 7 +++++++ elisp/geiser-repl.el | 36 ++++++++++++++---------------------- 5 files changed, 49 insertions(+), 35 deletions(-) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 34ed832..60800f4 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -151,7 +151,7 @@ (newline)) (newline))) -(make-local-variable +(make-variable-buffer-local (defvar geiser-doc--buffer-link nil)) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 847a198..a22428a 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -99,15 +99,10 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defvar geiser-eval--default-proc-function nil) -(defsubst geiser-eval--default-proc () +(defsubst geiser-eval--proc () (and geiser-eval--default-proc-function (funcall geiser-eval--default-proc-function))) -(defvar geiser-eval--proc nil) - -(defsubst geiser-eval--proc () - (or geiser-eval--proc (geiser-eval--default-proc))) - (defsubst geiser-eval--log (s) (geiser-log--info "RETORT: %S" s) s) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 20b648e..2cec381 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -67,7 +67,7 @@ ;;; Installing Scheme implementations: -(make-local-variable +(make-variable-buffer-local (defvar geiser-impl--implementation nil)) (defsubst geiser-impl--impl-feature (impl) @@ -159,12 +159,32 @@ ;;; Access to implementation guessing function: +(make-variable-buffer-local + (defvar geiser-scheme-implementation nil + "Set this buffer local variable to specify the Scheme +implementation to be used by Geiser.")) + (defun geiser-impl--guess () - (catch 'impl - (dolist (impl geiser-impl--impls) - (when (geiser-impl--call-if-bound impl "guess") - (throw 'impl impl))) - (geiser-impl--default-implementation))) + (or geiser-impl--implementation + geiser-scheme-implementation + (catch 'impl + (dolist (impl geiser-impl--impls) + (when (geiser-impl--call-if-bound impl "guess") + (throw 'impl impl)))) + (geiser-impl--default-implementation))) + + +;;; User commands: +(defvar geiser-impl--impl-prompt-history nil) + +(defun geiser-impl--read-impl (&optional prompt impls) + (let* ((impls (or impls geiser-impl--impls)) + (impls (mapcar (lambda (s) (format "%s" s)) impls)) + (prompt (or prompt "Scheme implementation: "))) + (intern (completing-read prompt impls nil t nil + geiser-impl--impl-prompt-history + (and (car geiser-impl--impls) + (symbol-name (car geiser-impl--impls))))))) ;;; Unload support diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index 57fb84e..3e9e3c1 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -131,6 +131,13 @@ With prefix, recursively macro-expand the resulting expression." (interactive "P") (geiser-expand-region (save-excursion (backward-sexp) (point)) (point) all)) +(defun geiser-set-scheme () + "Associates current buffer with a given Scheme implementation." + (interactive) + (let ((impl (geiser-impl--read-impl))) + (geiser-impl--set-buffer-implementation impl) + (geiser-repl--get-repl impl))) + ;;; Geiser mode: diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 62fbcdf..d4471b8 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -90,7 +90,7 @@ REPL buffer." (throw 'repl repl)))))) (defun geiser-repl--get-repl (&optional impl) - (or geiser-repl--repl + (or (and (not impl) geiser-repl--repl) (setq geiser-repl--repl (let ((impl (or impl geiser-impl--implementation @@ -111,8 +111,8 @@ REPL buffer." (not (get-buffer-process (current-buffer)))) (pop-to-buffer (generate-new-buffer (format "* %s *" (geiser-repl--repl-name impl))))) - (geiser-impl--set-buffer-implementation impl) - (geiser-repl-mode)) + (geiser-repl-mode) + (geiser-impl--set-buffer-implementation impl)) (defun geiser-repl--start-repl (impl) (message "Starting Geiser REPL for %s ..." impl) @@ -132,7 +132,7 @@ REPL buffer." (geiser-repl--set-this-buffer-repl (current-buffer)))) (defun geiser-repl--process () - (let ((buffer (geiser-repl--get-repl))) + (let ((buffer (geiser-repl--get-repl geiser-impl--implementation))) (or (and (buffer-live-p buffer) (get-buffer-process buffer)) (error "No Geiser REPL for this buffer (try M-x run-geiser)")))) @@ -151,19 +151,8 @@ REPL buffer." ;;; Interface: starting and interacting with geiser REPL: -(defvar geiser-repl--impl-prompt-history nil) - (defun geiser-repl--read-impl (prompt &optional active) - (car (read-from-string - (completing-read prompt - (mapcar 'symbol-name - (if active - (geiser-repl--active-impls) - geiser-impl--impls)) - nil nil nil - geiser-repl--impl-prompt-history - (and (car geiser-impl--impls) - (symbol-name (car geiser-impl--impls))))))) + (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) (defsubst geiser-repl--only-impl-p () (and (null (cdr geiser-impl--impls)) @@ -201,25 +190,28 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (goto-char (point-max)) (comint-kill-region comint-last-input-start (point)) (comint-redirect-cleanup) - (geiser-con--setup-connection geiser-repl--buffer geiser-repl--prompt-regex)) + (geiser-con--setup-connection (current-buffer) + comint-prompt-regexp)) ;;; REPL history and clean-up: (defun geiser-repl--on-quit () (comint-write-input-ring) - (let ((cb (current-buffer))) + (let ((cb (current-buffer)) + (impl geiser-impl--implementation)) (setq geiser-repl--repls (remove cb geiser-repl--repls)) (dolist (buffer (buffer-list)) (with-current-buffer buffer - (when (equal cb (geiser-repl--this-buffer-repl)) - (geiser-repl--set-this-buffer-repl nil) - (geiser-repl--get-repl)))))) + (when (and (eq geiser-impl--implementation impl) + (equal cb (geiser-repl--this-buffer-repl))) + (geiser-repl--get-repl geiser-impl--implementation)))))) (defun geiser-repl--sentinel (proc event) (when (string= event "finished\n") (with-current-buffer (process-buffer proc) - (let ((comint-input-ring-file-name geiser-repl-history-filename)) + (let ((comint-prompt-read-only nil) + (comint-input-ring-file-name geiser-repl-history-filename)) (geiser-repl--on-quit) (when (buffer-name (current-buffer)) (insert "\nIt's been nice interacting with you!\n") -- cgit v1.2.3