diff options
| -rw-r--r-- | elisp/geiser-impl.el | 6 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 2 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 221 | ||||
| -rw-r--r-- | elisp/geiser.el | 24 |
4 files changed, 163 insertions, 90 deletions
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!"))) |