summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-11 04:06:57 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-11 04:06:57 +0100
commit24e2adca8be0e5b4f08a3434c29591cba83d73dd (patch)
treeacee0fe8bede00247e9f8b10b0f17c05e50314c5 /elisp
parentd84fe6278c5bac2e9eb322ecac3e2883dd95d494 (diff)
downloadgeiser-guile-24e2adca8be0e5b4f08a3434c29591cba83d73dd.tar.gz
geiser-guile-24e2adca8be0e5b4f08a3434c29591cba83d73dd.tar.bz2
Support for multiple Scheme implementations, Chapter 2.
* The REPL is aware of multiple implementations... * and it knows how to create more than one connection for guile; * but it's not been tested with more than one implementation. * geiser-mode seems to be able to keep track of active REPLs.
Diffstat (limited to 'elisp')
-rw-r--r--elisp/geiser-guile.el11
-rw-r--r--elisp/geiser-impl.el6
-rw-r--r--elisp/geiser-mode.el2
-rw-r--r--elisp/geiser-repl.el221
-rw-r--r--elisp/geiser.el24
5 files changed, 173 insertions, 91 deletions
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index fde2954..a34e4d6 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -57,11 +57,20 @@
This function uses `geiser-guile-init-file' if it exists."
(let ((init-file (and (stringp geiser-guile-init-file)
(expand-file-name geiser-guile-init-file))))
- `("-p" "-L" ,(expand-file-name "guile/" geiser-scheme-dir)
+ `("-q" "-L" ,(expand-file-name "guile/" geiser-scheme-dir)
,@(and init-file (file-readable-p init-file) (list "-l" init-file)))))
(defconst geiser-guile-prompt-regexp "^[^() \n]+@([^)]*?)> ")
+(defun switch-to-guile (&optional ask)
+ (interactive "P")
+ (switch-to-geiser ask 'guile))
+
+(defun run-guile ()
+ "Run Geiser using Guile."
+ (interactive)
+ (run-geiser 'guile))
+
;;; Evaluation support:
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 741002a..eecdaa7 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -139,15 +139,15 @@
(defsubst geiser-impl--binary (impl)
(or (geiser-impl--call-if-bound impl "binary")
- (geiser-impl--value imp "binary")))
+ (geiser-impl--value impl "binary")))
(defsubst geiser-impl--parameters (impl)
(or (geiser-impl--call-if-bound impl "parameters")
- (ignore-errors (geiser-impl--value imp "parameters"))))
+ (ignore-errors (geiser-impl--value impl "parameters"))))
(defsubst geiser-impl--prompt-regexp (impl)
(or (geiser-impl--call-if-bound impl "prompt-regexp")
- (geiser-impl--value imp "prompt-regexp")))
+ (geiser-impl--value impl "prompt-regexp")))
;;; Access to implementation guessing function:
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 640a7e9..4f6a584 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -177,7 +177,7 @@ interacting with the Geiser REPL is at your disposal.
(define-key geiser-mode-map (vector '(control ?c) `(control ,p) k) c)
(define-key geiser-mode-map (vector '(control ?c) `(control ,p) `(control ,k)) c))
-(define-key geiser-mode-map "\C-c\C-z" 'switch-to-guile)
+(define-key geiser-mode-map "\C-c\C-z" 'switch-to-geiser)
(define-key geiser-mode-map "\C-c\C-l" 'geiser-load-current-buffer)
(define-key geiser-mode-map "\C-c\C-k" 'geiser-compile-current-buffer)
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index 7232b99..7872eb0 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -82,65 +82,68 @@ REPL buffer."
:group 'geiser-repl)
-;;; REPL history:
-
-(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))
- (comint-write-input-ring)
- (when (buffer-name (current-buffer))
- (insert "\nIt's been nice interacting with you!\n")
- (insert "Press C-cz to bring me back.\n" ))))))
-
-(defun geiser-repl--input-filter (str)
- (and (not (string-match "^\\s *$" str))
- (not (string-match "^,quit *$" str))))
-
-(defun geiser-repl--history-setup ()
- (set (make-local-variable 'comint-input-ring-file-name) geiser-repl-history-filename)
- (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
- (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
- (add-hook 'kill-buffer-hook 'comint-write-input-ring nil t)
- (comint-read-input-ring t)
- (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel))
-
-
-;;; Geiser REPL buffer/process:
-
-(defvar geiser-repl--buffer nil
- "The buffer in which the Guile REPL is running.")
-
-(defconst geiser-repl--prompt-regex "^[^() \n]+@([^)]*?)> ")
-
-(defun geiser-repl--buffer ()
- (if (buffer-live-p geiser-repl--buffer) geiser-repl--buffer
- (with-current-buffer (get-buffer-create "*Geiser REPL*")
- (geiser-repl-mode)
- (setq geiser-repl--buffer (current-buffer)))))
-
-(defun geiser-repl--start-process ()
- (let* ((guile geiser-repl-guile-binary)
- (args `("-q" "-L" ,(concat geiser-scheme-dir "/guile/")))
- (init-file (and geiser-repl-guile-init-file
- (expand-file-name geiser-repl-guile-init-file)))
- (args (if (and init-file (file-readable-p init-file))
- `(,@args "-l" ,init-file)
- args)))
- (message "Starting Geiser REPL ...")
- (pop-to-buffer (geiser-repl--buffer))
- (apply 'make-comint-in-buffer `("Geiser REPL" ,(current-buffer) ,guile nil ,@args))
+;;; Geiser REPL buffers and processes:
+
+(defvar geiser-repl--repls nil)
+
+(make-variable-buffer-local
+ (defvar geiser-repl--repl nil))
+
+(defsubst geiser-repl--this-buffer-repl ()
+ geiser-repl--repl)
+
+(defsubst geiser-repl--set-this-buffer-repl (r)
+ (setq geiser-repl--repl r))
+
+(defun geiser-repl--repl/impl (impl)
+ (catch 'repl
+ (dolist (repl geiser-repl--repls)
+ (with-current-buffer repl
+ (when (eq geiser-impl--implementation impl)
+ (throw 'repl repl))))))
+
+(defun geiser-repl--get-repl (&optional impl)
+ (or geiser-repl--repl
+ (setq geiser-repl--repl
+ (let ((impl (or impl
+ geiser-impl--implementation
+ (geiser-impl--guess))))
+ (when impl (geiser-repl--repl/impl impl))))))
+
+(defun geiser-repl--active-impls ()
+ (let ((act))
+ (dolist (repl geiser-repl--repls act)
+ (with-current-buffer repl
+ (add-to-list 'act geiser-impl--implementation)))))
+
+(defun geiser-repl--to-repl-buffer (impl)
+ (unless (and (eq major-mode 'geiser-repl-mode)
+ (not (get-buffer-process (current-buffer))))
+ (pop-to-buffer (generate-new-buffer (format "*Geiser REPL (%s)*" impl))))
+ (geiser-impl--set-buffer-implementation impl)
+ (geiser-repl-mode))
+
+(defun geiser-repl--start-repl (impl)
+ (message "Starting Geiser REPL for %s ..." impl)
+ (geiser-repl--to-repl-buffer impl)
+ (let ((binary (geiser-impl--binary impl))
+ (args (geiser-impl--parameters impl))
+ (prompt-rx (geiser-impl--prompt-regexp impl))
+ (cname (format "Geiser REPL (%s)" impl)))
+ (unless (and binary 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)
+ (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,binary nil ,@args))
(geiser-repl--wait-for-prompt 10000)
(geiser-repl--history-setup)
- (geiser-con--setup-connection (current-buffer) geiser-repl--prompt-regex)))
+ (geiser-con--setup-connection (current-buffer) prompt-rx)
+ (add-to-list 'geiser-repl--repls (current-buffer))
+ (geiser-repl--set-this-buffer-repl (current-buffer))))
-(defun geiser-repl--process (&optional start)
- (or (and (buffer-live-p (geiser-repl--buffer))
- (get-buffer-process (geiser-repl--buffer)))
- (if (not start)
- (error "No running Guile REPL (try M-x run-guile)")
- (geiser-repl--start-process)
- (geiser-repl--process))))
+(defun geiser-repl--process ()
+ (let ((buffer (geiser-repl--get-repl)))
+ (or (and (buffer-live-p buffer) (get-buffer-process buffer))
+ (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
(setq geiser-eval--default-proc-function 'geiser-repl--process)
@@ -157,21 +160,42 @@ REPL buffer."
;;; Interface: starting and interacting with geiser REPL:
-(defalias 'switch-to-guile 'run-guile)
-
-(defun run-guile ()
- "Run Geiser using Guile."
- (interactive)
- (geiser 'guile))
-
-(defun geiser (&optional implementation)
- "Show the geiser-repl buffer, starting the process if needed."
- (interactive)
- (let ((buf (process-buffer (geiser-repl--process t)))
- (pop-up-windows geiser-repl-window-allow-split))
- (if geiser-repl-use-other-window
- (pop-to-buffer buf)
- (switch-to-buffer buf))))
+(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)))))))
+
+(defun run-geiser (impl)
+ "Start a new Geiser REPL."
+ (interactive
+ (list (geiser-repl--read-impl "Start Geiser for scheme implementation: ")))
+ (geiser-repl--start-repl impl))
+
+(defun switch-to-geiser (&optional ask impl)
+ "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* ((repl (cond ((and (not ask) (not impl)
+ (or (geiser-repl--this-buffer-repl)
+ (car geiser-repl--repls))))
+ ((and (not ask) impl (geiser-repl--repl/impl impl)))
+ ((= 1 (length geiser-repl--repls)) (car geiser-repl--repls))))
+ (impl (or impl (and (not repl)
+ (geiser-repl--read-impl "Switch to scheme REPL: "))))
+ (pop-up-windows geiser-repl-window-allow-split))
+ (if repl (pop-to-buffer repl) (run-geiser impl))))
+
+(defalias 'geiser 'switch-to-geiser)
(defun geiser-repl-nuke ()
"Try this command if the REPL becomes unresponsive."
@@ -182,6 +206,40 @@ REPL buffer."
(geiser-con--setup-connection geiser-repl--buffer geiser-repl--prompt-regex))
+;;; REPL history and clean-up:
+
+(defun geiser-repl--on-quit ()
+ (comint-write-input-ring)
+ (let ((cb (current-buffer)))
+ (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))))))
+
+(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))
+ (geiser-repl--on-quit)
+ (when (buffer-name (current-buffer))
+ (insert "\nIt's been nice interacting with you!\n")
+ (insert "Press C-cz to bring me back.\n" ))))))
+
+(defun geiser-repl--input-filter (str)
+ (and (not (string-match "^\\s *$" str))
+ (not (string-match "^,quit *$" str))))
+
+(defun geiser-repl--history-setup ()
+ (set (make-local-variable 'comint-input-ring-file-name) geiser-repl-history-filename)
+ (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
+ (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
+ (add-hook 'kill-buffer-hook 'geiser-repl--on-quit nil t)
+ (comint-read-input-ring t)
+ (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel))
+
+
;;; geiser-repl mode:
(defun geiser-repl--bol ()
@@ -200,14 +258,11 @@ REPL buffer."
"Major mode for interacting with an inferior Guile repl process.
\\{geiser-repl-mode-map}"
(set (make-local-variable 'mode-line-process) nil)
- (set (make-local-variable 'comint-prompt-regexp) geiser-repl--prompt-regex)
(set (make-local-variable 'comint-use-prompt-regexp) t)
(set (make-local-variable 'comint-prompt-read-only) t)
(set (make-local-variable 'beginning-of-defun-function)
'geiser-repl--beginning-of-defun)
(set-syntax-table scheme-mode-syntax-table)
- ;;; TODO: fix this call when we add support to multiple implementations
- (geiser-impl--set-buffer-implementation)
(setq geiser-eval--get-module-function 'geiser-repl--module-function)
(when geiser-repl-autodoc-p (geiser-autodoc-mode 1)))
@@ -234,13 +289,21 @@ REPL buffer."
;;; Unload:
-(defun geiser-repl--live-p ()
- (buffer-live-p geiser-repl--buffer))
+(defun geiser-repl--repl-list ()
+ (let (lst)
+ (dolist (repl geiser-repl--repls lst)
+ (when (buffer-live-p repl)
+ (with-current-buffer repl
+ (push geiser-impl--implementation) lst)))))
+
+(defun geiser-repl--restore (impls)
+ (dolist (impl impls)
+ (when impl (geiser impl))))
(defun geiser-repl-unload-function ()
- (when (geiser-repl--live-p)
- (kill-buffer geiser-repl--buffer))
- t)
+ (dolist (repl geiser-repl--repls)
+ (when (buffer-live-p repl)
+ (kill-buffer repl))))
(provide 'geiser-repl)
diff --git a/elisp/geiser.el b/elisp/geiser.el
index f7917f4..61411dc 100644
--- a/elisp/geiser.el
+++ b/elisp/geiser.el
@@ -48,10 +48,16 @@
(autoload 'geiser "geiser-repl.el"
"Start a Geiser REPL, or switch to a running one." t)
-(autoload 'run-guile "geiser-repl.el"
+(autoload 'run-geiser "geiser-repl.el"
+ "Start a Geiser REPL." t)
+
+(autoload 'switch-to-geiser "geiser-guile.el"
+ "Switch to a running one Geiser REPL." t)
+
+(autoload 'run-guile "geiser-guile.el"
"Start a Geiser Guile REPL, or switch to a running one." t)
-(autoload 'switch-to-guile "geiser-repl.el"
+(autoload 'switch-to-guile "geiser-guile.el"
"Start a Geiser Guile REPL, or switch to a running one." t)
(autoload 'geiser-mode "geiser-mode.el"
@@ -75,7 +81,11 @@
(eval-after-load "scheme"
'(add-hook 'scheme-mode-hook 'turn-on-geiser-mode)))
-(defun geiser-setup ()
+(defun geiser-setup-implementations (impls)
+ (setq geiser-impl--impls (append '(guile) impls)))
+
+(defun geiser-setup (&rest impls)
+ (geiser-setup-implementations impls)
(geiser-setup-scheme-mode))
@@ -124,7 +134,7 @@ loaded."
geiser-root-dir))
(geiser-main-file (expand-file-name "elisp/geiser.el" dir))
(impls (and (featurep 'geiser-impl) geiser-impl--impls))
- (repl (and (featurep 'geiser-repl) (geiser-repl--live-p)))
+ (repls (and (featurep 'geiser-repl) (geiser-repl--repl-list)))
(buffers (and (featurep 'geiser-mode) (geiser-mode--buffers))))
(unless (file-exists-p geiser-main-file)
(error "%s does not contain Geiser!" dir))
@@ -134,9 +144,9 @@ loaded."
(geiser-setup)
(dolist (feature (reverse (geiser--features-list)))
(load-library (format "%s" feature)))
- (when impls (geiser-impl--reload-implementations impls))
- (when repl (geiser 'repl))
- (when buffers (geiser-mode--restore buffers))
+ (geiser-impl--reload-implementations impls)
+ (geiser-repl--restore repls)
+ (geiser-mode--restore buffers)
(message "Geiser reloaded!")))