From 7763b169589be534220e1ffc3e0fd08304124914 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 11 Mar 2009 04:06:57 +0100 Subject: 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. --- elisp/geiser-repl.el | 221 +++++++++++++++++++++++++++++++++------------------ 1 file changed, 142 insertions(+), 79 deletions(-) (limited to 'elisp/geiser-repl.el') 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." @@ -181,6 +205,40 @@ REPL buffer." (comint-redirect-cleanup) (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: @@ -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) -- cgit v1.2.3