diff options
Diffstat (limited to 'elisp/geiser-repl.el')
| -rw-r--r-- | elisp/geiser-repl.el | 379 |
1 files changed, 190 insertions, 189 deletions
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index a05346c..9136db5 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -13,6 +13,7 @@ (require 'geiser-autodoc) (require 'geiser-edit) (require 'geiser-completion) +(require 'geiser-inf) (require 'geiser-impl) (require 'geiser-eval) (require 'geiser-connection) @@ -106,6 +107,34 @@ expression, if any." :group 'geiser-repl) +;;; Implementation-dependent parameters + +(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.") + +(geiser-impl--define-caller + geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () + "A variable (or thunk returning a value) giving the regular +expression for this implementation's debugging prompt.") + +(geiser-impl--define-caller geiser-repl--startup startup () + "Function taking no parameters that is called after the REPL +has been initialised. All Geiser functionality is available to +you at that point.") + +(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) + "Function taking a module designator and returning a REPL enter +module command as a string") + +(geiser-impl--define-caller geiser-repl--import-cmd import-command (module) + "Function taking a module designator and returning a REPL import +module command as a string") + +(geiser-impl--define-caller geiser-repl--exit-cmd exit-command () + "Function returning the REPL exit command as a string") + + ;;; Geiser REPL buffers and processes: (defvar geiser-repl--repls nil) @@ -161,50 +190,35 @@ expression, if any." (geiser-repl-mode) (geiser-impl--set-buffer-implementation impl))))) -(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 scheme prompt.") +(defun geiser-repl--read-impl (prompt &optional active) + (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) -(geiser-impl--define-caller - geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () - "A variable (or thunk returning a value) giving the regular -expression for this implementation's debugging prompt.") +(defsubst geiser-repl--only-impl-p () + (and (null (cdr geiser-active-implementations)) + (car geiser-active-implementations))) -(geiser-impl--define-caller - geiser-repl--debugger-preamble-regexp debugger-preamble-regexp () - "A variable (or thunk returning a value) used to determine whether -the REPL has entered debugging mode.") +(defun geiser-repl--get-impl (prompt) + (or (geiser-repl--only-impl-p) + (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation) + (geiser-repl--read-impl prompt))) -(geiser-impl--define-caller geiser-repl--startup startup () - "Function taking no parameters that is called after the REPL -has been initialised. All Geiser functionality is available to -you at that point.") + +;;; REPL connections -(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) - "Function taking a module designator and returning a REPL enter -module command as a string") +(make-variable-buffer-local + (defvar geiser-repl--address nil)) -(geiser-impl--define-caller geiser-repl--import-cmd import-command (module) - "Function taking a module designator and returning a REPL import -module command as a string") +(make-variable-buffer-local + (defvar geiser-repl--connection nil)) -(geiser-impl--define-caller geiser-repl--exit-cmd exit-command () - "Function returning the REPL exit command as a string") +(make-variable-buffer-local + (defvar geiser-repl--remote-p nil)) (make-variable-buffer-local - (defvar geiser-repl--address nil)) + (defvar geiser-repl--inferior-buffer nil)) (defsubst geiser-repl--host () (car geiser-repl--address)) (defsubst geiser-repl--port () (cdr geiser-repl--address)) -(defsubst geiser-repl--remote-p () geiser-repl--address) (defun geiser-repl--get-address (&optional host port) (let ((defhost (or (geiser-repl--host) geiser-repl-default-host)) @@ -214,124 +228,53 @@ module command as a string") nil nil defhost)) (or port (read-number "Port: " defport))))) -(defun geiser-repl--save-remote-data (remote address) - (setq geiser-repl--address (and remote address)) +(defun geiser-repl--save-remote-data (address remote) + (setq geiser-repl--address address) + (setq geiser-repl--remote-p remote) (setq header-line-format (and remote (format "Host: %s Port: %s" (geiser-repl--host) (geiser-repl--port))))) -(defun geiser-repl--start-repl (impl &optional remote host port) +(defun geiser-repl--start-repl (impl host port remote) (message "Starting Geiser REPL for %s ..." impl) (geiser-repl--to-repl-buffer impl) - (let ((program (if remote (geiser-repl--get-address host port) - (geiser-repl--binary impl))) - (args (geiser-repl--arglist impl)) + (goto-char (point-max)) + (let ((address (geiser-repl--get-address host port)) (prompt-rx (geiser-repl--prompt-regexp impl)) (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl)) - (deb-preamble-rx (geiser-repl--debugger-preamble-regexp impl)) (cname (geiser-repl--repl-name impl))) - (unless (and program prompt-rx) + (unless 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) - (geiser-repl--save-remote-data remote program) + (geiser-repl--save-remote-data address remote) (condition-case err - (apply 'make-comint-in-buffer - `(,cname ,(current-buffer) ,program nil ,@args)) + (progn + (setq geiser-repl--connection + (geiser-con--open-connection (car address) + (cdr address) + prompt-rx + deb-prompt-rx)) + (set (make-local-variable 'comint-prompt-regexp) + (geiser-con--connection-eot geiser-repl--connection)) + (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-repl--wait-for-prompt 10000) + (geiser-inf--wait-for-prompt 10000) (geiser-repl--history-setup) - (geiser-con--setup-connection (current-buffer) - prompt-rx - deb-prompt-rx - deb-preamble-rx) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) (geiser-repl--startup impl) - (message "Geiser REPL up and running!"))) + (message "%s up and running!" (geiser-repl--repl-name impl)))) -(defun geiser-repl--process () +(defun geiser-repl--connection () (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) - (or (and (buffer-live-p buffer) (get-buffer-process buffer)) + (or (and (buffer-live-p buffer) + (get-buffer-process buffer) + (with-current-buffer buffer geiser-repl--connection)) (error "No Geiser REPL for this buffer (try M-x run-geiser)")))) -(setq geiser-eval--default-proc-function 'geiser-repl--process) - -(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 "No prompt found!")))) - - -;;; Interface: starting and interacting with geiser REPL: - -(defun geiser-repl--read-impl (prompt &optional active) - (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) - -(defsubst geiser-repl--only-impl-p () - (and (null (cdr geiser-active-implementations)) - (car geiser-active-implementations))) - -(defun run-geiser (impl) - "Start a new Geiser REPL." - (interactive - (list (or (geiser-repl--only-impl-p) - (and (eq major-mode 'geiser-repl-mode) - geiser-impl--implementation) - (geiser-repl--read-impl - "Start Geiser for scheme implementation: ")))) - (geiser-repl--start-repl impl)) - -(defun geiser-connect (impl &optional host port) - "Start a new Geiser REPL connected to a remote Scheme process." - (interactive - (list (or (geiser-repl--only-impl-p) - (and (eq major-mode 'geiser-repl-mode) - geiser-impl--implementation) - (geiser-repl--read-impl - "Scheme implementation: ")))) - (geiser-repl--start-repl impl t host port)) - -(make-variable-buffer-local - (defvar geiser-repl--last-scm-buffer nil)) - -(defun switch-to-geiser (&optional ask impl buffer) - "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* ((impl (or impl geiser-impl--implementation)) - (in-repl (eq major-mode 'geiser-repl-mode)) - (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) - (repl (cond ((and (not ask) - (not impl) - (not in-repl) - (or geiser-repl--repl (car geiser-repl--repls)))) - ((and (not ask) - (not in-repl) - impl - (geiser-repl--repl/impl impl))))) - (pop-up-windows geiser-repl-window-allow-split)) - (cond ((or in-live-repl - (and (eq (current-buffer) repl) (not (eq repl buffer)))) - (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)) - (t (run-geiser impl))) - (when (and buffer (eq major-mode 'geiser-repl-mode)) - (setq geiser-repl--last-scm-buffer buffer)))) - -(defalias 'geiser 'switch-to-geiser) +(setq geiser-eval--default-connection-function 'geiser-repl--connection) (defun geiser-repl--send (cmd) (when (and cmd (eq major-mode 'geiser-repl-mode)) @@ -341,64 +284,25 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (let ((comint-input-filter (lambda (x) nil))) (comint-send-input nil t)))) -(defun switch-to-geiser-module (&optional module buffer) - "Switch to running Geiser REPL and try to enter a given module." - (interactive) - (let* ((module (or module - (geiser-completion--read-module - "Switch to module (default top-level): "))) - (cmd (and module - (geiser-repl--enter-cmd geiser-impl--implementation - module)))) - (unless (eq major-mode 'geiser-repl-mode) - (switch-to-geiser nil nil (or buffer (current-buffer)))) - (geiser-repl--send cmd))) - -(defun geiser-repl-import-module (&optional module) - "Import a given module in the current namespace of the REPL." - (interactive) - (let* ((module (or module - (geiser-completion--read-module "Import module: "))) - (cmd (and module - (geiser-repl--import-cmd geiser-impl--implementation - module)))) - (switch-to-geiser nil nil (current-buffer)) - (geiser-repl--send cmd))) - -(defun geiser-repl-exit (&optional arg) - "Exit the current REPL. -With a prefix argument, force exit by killing the scheme process." - (interactive "P") - (when (or (not geiser-repl-query-on-exit-p) - (y-or-n-p "Really quit this REPL? ")) - (let ((cmd (and (not arg) - (geiser-repl--exit-cmd geiser-impl--implementation)))) - (if cmd - (when (stringp cmd) (geiser-repl--send cmd)) - (comint-kill-subjob))))) - -(defun geiser-repl-nuke () - "Try this command if the REPL becomes unresponsive." - (interactive) - (goto-char (point-max)) - (comint-kill-region comint-last-input-start (point)) - (comint-redirect-cleanup) - (geiser-con--setup-connection (current-buffer) - comint-prompt-regexp - geiser-con--debugging-prompt-regexp - geiser-con--debugging-preamble-regexp)) - ;;; REPL history and clean-up: (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) (setq geiser-repl--repls (remove cb geiser-repl--repls)) (dolist (buffer (buffer-list)) (when (buffer-live-p buffer) @@ -415,10 +319,10 @@ With a prefix argument, force exit by killing the scheme process." (comint-input-ring-file-name (geiser-repl--history-file))) (geiser-repl--on-quit) (push pb geiser-repl--closed-repls) - (when (buffer-name (current-buffer)) - (comint-kill-region comint-last-input-start (point)) - (insert "\nIt's been nice interacting with you!\n") - (insert "Press C-c C-z to bring me back.\n" ))))))) + (goto-char (point-max)) + (comint-kill-region comint-last-input-start (point)) + (insert "\nIt's been nice interacting with you!\n") + (insert "Press C-c C-z to bring me back.\n" )))))) (defun geiser-repl--on-kill () (geiser-repl--on-quit) @@ -426,7 +330,7 @@ With a prefix argument, force exit by killing the scheme process." (remove (current-buffer) geiser-repl--closed-repls))) (defun geiser-repl--input-filter (str) - (not (or (geiser-con--is-debugging) + (not (or ;; (geiser-con--is-debugging) (string-match "^\\s *$" str) (string-match "^,quit *$" str)))) @@ -497,7 +401,8 @@ With a prefix argument, force exit by killing the scheme process." (intxt (and pmark (buffer-substring pmark (point))))) (when intxt (when (and geiser-repl-forget-old-errors-p - (not (geiser-con--is-debugging))) +;;; (not (geiser-con--is-debugging))) + ) (compilation-forget-errors)) (comint-send-input) (when (string-match "^\\s-*$" intxt) @@ -545,7 +450,6 @@ buffer." (setq geiser-eval--get-module-function 'geiser-repl--module-function) (when geiser-repl-autodoc-p (geiser--save-msg (geiser-autodoc-mode 1))) - (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging) (geiser-company--setup geiser-repl-company-p) ;; enabling compilation-shell-minor-mode without the annoying highlighter (compilation-setup t)) @@ -588,15 +492,104 @@ buffer." ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit :enable (geiser-repl--live-p)) ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p))) - ("Revive REPL" "\C-c\C-k" geiser-repl-nuke - "Use this command if the REPL becomes irresponsive" - :enable (geiser-repl--live-p)) -- (custom "REPL options" geiser-repl)) (define-key geiser-repl-mode-map [menu-bar completion] 'undefined) +;;; User commands + +(defun run-geiser (impl) + "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)))) + +(defalias 'geiser 'run-geiser) + +(defun geiser-connect (impl &optional host port) + "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)) + +(make-variable-buffer-local + (defvar geiser-repl--last-scm-buffer nil)) + +(defun switch-to-geiser (&optional ask impl buffer) + "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* ((impl (or impl geiser-impl--implementation)) + (in-repl (eq major-mode 'geiser-repl-mode)) + (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) + (repl (cond ((and (not ask) + (not impl) + (not in-repl) + (or geiser-repl--repl (car geiser-repl--repls)))) + ((and (not ask) + (not in-repl) + impl + (geiser-repl--repl/impl impl))))) + (pop-up-windows geiser-repl-window-allow-split)) + (cond ((or in-live-repl + (and (eq (current-buffer) repl) (not (eq repl buffer)))) + (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)) + (t (run-geiser impl))) + (when (and buffer (eq major-mode 'geiser-repl-mode)) + (setq geiser-repl--last-scm-buffer buffer)))) + +(defun switch-to-geiser-module (&optional module buffer) + "Switch to running Geiser REPL and try to enter a given module." + (interactive) + (let* ((module (or module + (geiser-completion--read-module + "Switch to module (default top-level): "))) + (cmd (and module + (geiser-repl--enter-cmd geiser-impl--implementation + module)))) + (unless (eq major-mode 'geiser-repl-mode) + (switch-to-geiser nil nil (or buffer (current-buffer)))) + (geiser-repl--send cmd))) + +(defun geiser-repl-import-module (&optional module) + "Import a given module in the current namespace of the REPL." + (interactive) + (let* ((module (or module + (geiser-completion--read-module "Import module: "))) + (cmd (and module + (geiser-repl--import-cmd geiser-impl--implementation + module)))) + (switch-to-geiser nil nil (current-buffer)) + (geiser-repl--send cmd))) + +(defun geiser-repl-exit (&optional arg) + "Exit the current REPL. +With a prefix argument, force exit by killing the scheme process." + (interactive "P") + (when (or (not geiser-repl-query-on-exit-p) + (y-or-n-p "Really quit this REPL? ")) + (let ((cmd (and (not arg) + (geiser-repl--exit-cmd geiser-impl--implementation)))) + (if cmd + (when (stringp cmd) (geiser-repl--send cmd)) + (comint-kill-subjob))))) + + ;;; Unload: (defun geiser-repl--repl-list () @@ -604,17 +597,25 @@ buffer." (dolist (repl geiser-repl--repls lst) (when (buffer-live-p repl) (with-current-buffer repl - (push geiser-impl--implementation lst)))))) + (push (cons geiser-impl--implementation + (when geiser-repl--remote-p + (list geiser-repl--host geiser-repl--port))) + lst)))))) (defun geiser-repl--restore (impls) (dolist (impl impls) - (when impl (run-geiser impl)))) + (when impl + (if (cdr impl) + (geiser-connect (car impl) (cadr impl) (caddr impl)) + (run-geiser (car impl)))))) (defun geiser-repl-unload-function () (dolist (repl geiser-repl--repls) (when (buffer-live-p repl) - (kill-buffer repl)))) + (with-current-buffer repl + (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit)) + (sit-for 0.05) + (kill-buffer))))) (provide 'geiser-repl) -;;; geiser-repl.el ends here |