diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-completion.el | 11 | ||||
| -rw-r--r-- | elisp/geiser-connection.el | 242 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 7 | ||||
| -rw-r--r-- | elisp/geiser-guile.el | 11 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 30 | ||||
| -rw-r--r-- | elisp/geiser-racket.el | 18 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 69 |
7 files changed, 230 insertions, 158 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index d346190..f88fae6 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -228,14 +228,19 @@ we're looking for a module name.") Perform completion similar to Emacs' complete-symbol. With prefix, complete module name." (interactive "P") + (unless (geiser-syntax--symbol-at-point) + (error "No symbol at point")) (geiser--respecting-message "Retrieving completions...") (let* ((prefix (geiser-completion--prefix arg)) - (result (geiser-completion--complete prefix arg)) + (result (and prefix (geiser-completion--complete prefix arg))) (completions (car result)) (partial (cdr result))) (cond ((null completions) - (geiser--respecting-message "Can't find completion for %S" prefix) - (geiser-completion--restore-window-cfg)) + (if (not arg) + (geiser-completion--complete-symbol t) + (geiser--respecting-message "Can't find completion for %S" + prefix) + (geiser-completion--restore-window-cfg))) (t (insert-and-inherit (substring partial (length prefix))) (cond ((= (length completions) 1) (geiser--respecting-message "Sole completion") diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index dfdb21d..dc669aa 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -17,6 +17,7 @@ (require 'geiser-log) (require 'geiser-syntax) (require 'geiser-base) +(require 'geiser-impl) (require 'comint) (require 'advice) @@ -35,12 +36,13 @@ ;;; Request datatype: -(defun geiser-con--make-request (str cont &optional sender-buffer) +(defun geiser-con--make-request (con str cont &optional sender-buffer) (list :geiser-connection-request - (cons :id (random)) + (cons :id (geiser-con--connection-inc-count con)) (cons :string str) (cons :continuation cont) - (cons :buffer (or sender-buffer (current-buffer))))) + (cons :buffer (or sender-buffer (current-buffer))) + (cons :connection con))) (defsubst geiser-con--request-p (req) (and (listp req) (eq (car req) :geiser-connection-request))) @@ -57,6 +59,9 @@ (defsubst geiser-con--request-buffer (req) (cdr (assoc :buffer req))) +(defsubst geiser-con--request-connection (req) + (cdr (assoc :connection req))) + (defsubst geiser-con--request-deactivate (req) (setcdr (assoc :continuation req) nil)) @@ -70,9 +75,23 @@ (list :geiser-connection (cons :requests (list)) (cons :current nil) + (cons :count 0) (cons :completed (make-hash-table :weakness 'value)) (cons :buffer buffer) - (cons :timer nil))) + (cons :reply (geiser-con--make-reply-buffer buffer)))) + +(defvar geiser-con--eot-regexp nil) +(geiser-impl--register-local-variable + 'geiser-con--eot-regexp 'eot-regexp nil + "A regular expression used to detect end of transmissions. +By default, Geiser uses the prompt regexp.") + +(defun geiser-con--make-reply-buffer (buffer) + (let ((name (concat " geiser-con-reply: " (buffer-name buffer))) + (eot (with-current-buffer buffer geiser-con--eot-regexp))) + (with-current-buffer (get-buffer-create name) + (setq geiser-con--eot-regexp eot) + (current-buffer)))) (defsubst geiser-con--connection-p (c) (and (listp c) (eq (car c) :geiser-connection))) @@ -89,11 +108,18 @@ (defsubst geiser-con--connection-current-request (c) (cdr (assoc :current c))) +(defsubst geiser-con--connection-reply-buffer (c) + (cdr (assoc :reply c))) + +(defsubst geiser-con--connection-completed (c r) + (geiser-con--request-deactivate r) + (puthash (geiser-con--request-id r) r (cdr (assoc :completed c)))) + (defun geiser-con--connection-clean-current-request (c) (let* ((cell (assoc :current c)) (req (cdr cell))) (when req - (puthash (geiser-con--request-id req) req (cdr (assoc :completed c))) + (geiser-con--connection-completed c req) (setcdr cell nil)))) (defun geiser-con--connection-add-request (c r) @@ -104,22 +130,23 @@ (gethash id (cdr (assoc :completed c)))) (defun geiser-con--connection-pop-request (c) - (let ((reqs (assoc :requests c)) - (current (assoc :current c))) - (setcdr current (prog1 (cadr reqs) (setcdr reqs (cddr reqs)))) - (if (and (cdr current) - (geiser-con--request-deactivated-p (cdr current))) + (let* ((reqs (assoc :requests c)) + (current (assoc :current c)) + (old-current (cdr current)) + (new-current (cadr reqs)) + (new-reqs (cddr reqs))) + (when old-current (geiser-con--connection-completed c old-current)) + (setcdr reqs new-reqs) + (if (and new-current + (geiser-con--request-deactivated-p new-current)) (geiser-con--connection-pop-request c) - (cdr current)))) - -(defun geiser-con--connection-start-timer (c) - (let ((cell (assoc :timer c))) - (when (cdr cell) (cancel-timer (cdr cell))) - (setcdr cell (run-at-time t 0.5 'geiser-con--process-next c)))) + (setcdr current new-current)))) -(defun geiser-con--connection-cancel-timer (c) - (let ((cell (assoc :timer c))) - (when (cdr cell) (cancel-timer (cdr cell))))) +(defun geiser-con--connection-inc-count (c) + (let* ((cnt (assoc :count c)) + (new (1+ (cdr cnt)))) + (setcdr cnt new) + new)) ;;; Connection setup: @@ -132,60 +159,55 @@ (make-variable-buffer-local (defvar geiser-con--debugging-preamble-regexp nil)) -(defun geiser-con--is-debugging () - (and geiser-con--debugging-prompt-regexp - geiser-con--debugging-inhibits-eval - comint-last-prompt-overlay - (string-match-p geiser-con--debugging-prompt-regexp - (buffer-substring (overlay-start - comint-last-prompt-overlay) - (overlay-end - comint-last-prompt-overlay))))) - -(defsubst geiser-con--has-entered-debugger () - (and geiser-con--debugging-prompt-regexp - (re-search-backward geiser-con--debugging-prompt-regexp nil t) - (or (null geiser-con--debugging-preamble-regexp) - (save-excursion - (re-search-backward geiser-con--debugging-preamble-regexp nil t))))) - -(defun geiser-con--cleanup-connection (c) - (geiser-con--connection-cancel-timer c)) +(defun geiser-con--is-debugging (&optional con) + (with-current-buffer (or (and con (geiser-con--connection-buffer con)) + (current-buffer)) + (and geiser-con--debugging-prompt-regexp + geiser-con--debugging-inhibits-eval + comint-last-prompt-overlay + (string-match-p geiser-con--debugging-prompt-regexp + (buffer-substring (overlay-start + comint-last-prompt-overlay) + (overlay-end + comint-last-prompt-overlay)))))) + +(defsubst geiser-con--has-entered-debugger (con) + (with-current-buffer (geiser-con--connection-buffer con) + (and geiser-con--debugging-prompt-regexp + (re-search-backward geiser-con--debugging-prompt-regexp nil t) + (or (null geiser-con--debugging-preamble-regexp) + (save-excursion + (re-search-backward geiser-con--debugging-preamble-regexp + nil t)))))) + +(defun geiser-con--connection-teardown () + (when geiser-con--connection + (kill-buffer + (geiser-con--connection-reply-buffer geiser-con--connection)))) (defun geiser-con--setup-connection (buffer prompt-regexp &optional debug-prompt-regexp debug-preamble-regexp) (with-current-buffer buffer - (when geiser-con--connection - (geiser-con--cleanup-connection geiser-con--connection)) + (geiser-con--connection-teardown) (setq geiser-con--debugging-prompt-regexp debug-prompt-regexp) (setq geiser-con--debugging-preamble-regexp debug-preamble-regexp) (setq geiser-con--connection (geiser-con--make-connection buffer)) - (geiser-con--setup-comint prompt-regexp debug-prompt-regexp) - (geiser-con--connection-start-timer geiser-con--connection) - (message "Geiser REPL up and running!"))) - -(defun geiser-con--setup-comint (prompt-regexp debug-prompt-regexp) - (set (make-local-variable 'comint-redirect-insert-matching-regexp) - (not (null debug-prompt-regexp))) - (set (make-local-variable 'comint-redirect-finished-regexp) - (if debug-prompt-regexp - (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp) - prompt-regexp)) - (setq comint-prompt-regexp comint-redirect-finished-regexp) - (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t)) + (set (make-local-variable 'comint-redirect-insert-matching-regexp) t) + (setq comint-prompt-regexp + (if debug-prompt-regexp + (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp) + prompt-regexp)) + (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t))) ;;; Requests handling: -(defsubst geiser-con--comint-buffer () - (get-buffer-create " *geiser connection retort*")) - -(defun geiser-con--comint-buffer-form () - (with-current-buffer (geiser-con--comint-buffer) +(defun geiser-con--comint-buffer-form (con) + (with-current-buffer (geiser-con--connection-reply-buffer con) (goto-char (point-max)) - (if (geiser-con--has-entered-debugger) + (if (geiser-con--has-entered-debugger con) `((error (key . geiser-debugger)) (output . ,(buffer-substring (point-min) (point)))) (condition-case nil @@ -201,56 +223,52 @@ (defun geiser-con--process-next (con) (when (not (geiser-con--connection-current-request con)) (let* ((buffer (geiser-con--connection-buffer con)) - (debug-prompt (with-current-buffer buffer - geiser-con--debugging-prompt-regexp)) - (debug-preamble (with-current-buffer buffer - geiser-con--debugging-preamble-regexp)) (req (geiser-con--connection-pop-request con)) (str (and req (geiser-con--request-string req))) - (cbuf (geiser-con--comint-buffer))) - (if (not (buffer-live-p buffer)) - (geiser-con--connection-cancel-timer con) - (when (and buffer req str) - (with-current-buffer cbuf - (setq comint-redirect-echo-input nil) - (setq geiser-con--debugging-prompt-regexp debug-prompt) - (setq geiser-con--debugging-preamble-regexp debug-preamble) - (delete-region (point-min) (point-max))) - (set-buffer buffer) - (if (geiser-con--is-debugging) - (geiser-con--request-deactivate req) - (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str) - (comint-redirect-send-command (format "%s" str) cbuf nil t))))))) + (rbuffer (geiser-con--connection-reply-buffer con))) + (when (and buffer (buffer-live-p buffer) req str) + (with-current-buffer rbuffer + (delete-region (point-min) (point-max))) + (set-buffer buffer) + (if (geiser-con--is-debugging) + (geiser-con--connection-completed con req) + (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str) + (comint-redirect-send-command (format "%s" str) rbuffer nil t)))))) (defun geiser-con--process-completed-request (req) - (let ((cont (geiser-con--request-continuation req)) - (id (geiser-con--request-id req)) - (rstr (geiser-con--request-string req)) - (buffer (geiser-con--request-buffer req))) + (let* ((cont (geiser-con--request-continuation req)) + (id (geiser-con--request-id req)) + (rstr (geiser-con--request-string req)) + (buffer (geiser-con--request-buffer req)) + (con (geiser-con--request-connection req)) + (form (geiser-con--comint-buffer-form con))) (if (not cont) - (geiser-log--warn "<%s> Droping result for request %S (%s)" - id rstr req) + (geiser-log--warn "<%s> Droping result for request %S: %s" + id rstr form) (condition-case cerr (with-current-buffer (or buffer (current-buffer)) - (funcall cont (geiser-con--comint-buffer-form)) + (funcall cont form) + (geiser-con--request-deactivate req) (geiser-log--info "<%s>: processed" id)) (error (geiser-log--error - "<%s>: continuation failed %S \n\t%s" id rstr cerr)))))) + "<%s>: continuation failed %S \n\t%s" id rstr cerr)))) + (geiser-con--connection-clean-current-request con))) (defun geiser-con--comint-redirect-hook () (if (not geiser-con--connection) (geiser-log--error "No connection in buffer") (let ((req (geiser-con--connection-current-request geiser-con--connection))) - (if (not req) (geiser-log--error "No current request") - (geiser-con--process-completed-request req) - (geiser-con--connection-clean-current-request - geiser-con--connection))))) + (if (not req) + (geiser-log--error "No current request") + (geiser-con--process-completed-request req))))) (defadvice comint-redirect-setup (after geiser-con--advice (output-buffer comint-buffer finished-regexp &optional echo)) (with-current-buffer comint-buffer + (when geiser-con--eot-regexp + (setq comint-redirect-finished-regexp geiser-con--eot-regexp)) (when geiser-con--connection (setq mode-line-process nil)))) (ad-activate 'comint-redirect-setup) @@ -259,43 +277,27 @@ (defconst geiser-con--error-message "Geiser connection not active") -(defun geiser-con--send-string (buffer/proc str cont &optional sender-buffer) - (save-current-buffer - (let ((con (geiser-con--get-connection buffer/proc))) - (unless con (error geiser-con--error-message)) - (let ((req (geiser-con--make-request str cont sender-buffer))) - (geiser-con--connection-add-request con req) - (geiser-con--process-next con) - req)))) - (defvar geiser-connection-timeout 30000 "Time limit, in msecs, blocking on synchronous evaluation requests") -(defun geiser-con--send-string/wait (buffer/proc str cont - &optional timeout sbuf) +(defun geiser-con--send-string/wait (b/p str cont &optional timeout sbuf) (save-current-buffer - (let ((con (geiser-con--get-connection buffer/proc))) - (unless (geiser-con--connection-process con) - (error geiser-con--error-message)) - (with-current-buffer (geiser-con--connection-buffer con) - (when (geiser-con--is-debugging) - (error "Geiser REPL is in debug mode"))) - (let* ((req (geiser-con--send-string buffer/proc str cont sbuf)) - (id (and req (geiser-con--request-id req))) - (time (or timeout geiser-connection-timeout)) - (step 100) - (waitsecs (/ step 1000.0))) - (when id + (let* ((con (geiser-con--get-connection b/p)) + (proc (and con (geiser-con--connection-process con)))) + (unless proc (error geiser-con--error-message)) + (when (geiser-con--is-debugging con) (error "REPL is in debug mode")) + (let* ((req (geiser-con--make-request con str cont sbuf)) + (id (geiser-con--request-id req)) + (timeout (/ (or timeout geiser-connection-timeout) 1000.0)) + (waitsecs 0.1)) + (geiser-con--connection-add-request con req) + (with-timeout (timeout (geiser-con--request-deactivate req)) (condition-case nil - (while (and (> time 0) - (geiser-con--connection-process con) + (while (and (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) - (accept-process-output nil waitsecs) - (setq time (- time step))) - (error (setq time 0))) - (or (> time 0) - (geiser-con--request-deactivate req) - nil)))))) + (geiser-con--process-next con) + (accept-process-output proc waitsecs nil t)) + (error (geiser-con--request-deactivate req)))))))) (provide 'geiser-connection) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index df31594..3534312 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -113,6 +113,7 @@ module-exports, autodoc, callers, callees and generic-methods.") (mapconcat 'geiser-eval--scheme-str code " ") ")")))) ((symbolp code) (format "%s" code)) + ((stringp code) (format "%S" (substring-no-properties code))) (t (format "%S" code)))) @@ -135,12 +136,6 @@ module-exports, autodoc, callers, callees and generic-methods.") (defun geiser-eval--set-sync-retort (s) (setq geiser-eval--sync-retort (geiser-eval--log s))) -(defsubst geiser-eval--send (code cont &optional buffer) - (geiser-con--send-string (geiser-eval--proc) - (geiser-eval--code-str code) - `(lambda (s) (,cont (geiser-eval--log s))) - buffer)) - (defun geiser-eval--send/wait (code &optional timeout buffer) (setq geiser-eval--sync-retort nil) (geiser-con--send-string/wait (geiser-eval--proc) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 93d1237..f410674 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -144,8 +144,9 @@ This function uses `geiser-guile-init-file' if it exists." :f))) ((listp module) module) ((stringp module) - (or (ignore-errors (car (geiser-syntax--read-from-string module))) - :f)) + (condition-case nil + (car (geiser-syntax--read-from-string module)) + (error :f))) (t :f))) (defun geiser-guile--module-cmd (module fmt &optional def) @@ -198,10 +199,14 @@ This function uses `geiser-guile-init-file' if it exists." ;;; Trying to ascertain whether a buffer is Guile Scheme: +(defconst geiser-guile--guess-re + (format "\\(%s\\|#! *.+\\(/\\| \\)guile\\( *\\\\\\)?\\)" + geiser-guile--module-re)) + (defun geiser-guile--guess () (save-excursion (goto-char (point-min)) - (re-search-forward geiser-guile--module-re nil t))) + (re-search-forward geiser-guile--guess-re nil t))) ;;; Compilation shell regexps diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index e9e5563..719176d 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -176,6 +176,35 @@ With prefix, try to enter the current's buffer module." (goto-char (point-max)) (pop-to-buffer b))) +(defun geiser-squarify (n) + "Toggle between () and [] for current form. +With numeric prefix, perform that many toggles, forward for +positive values and backward for negative." + (interactive "p") + (let ((pared (and (boundp 'paredit-mode) paredit-mode)) + (fwd (> n 0)) + (steps (abs n))) + (when (and pared (fboundp 'paredit-mode)) (paredit-mode -1)) + (unwind-protect + (save-excursion + (unless (looking-at-p "\\s(") (backward-up-list)) + (while (> steps 0) + (let ((p (point)) + (round (looking-at-p "("))) + (forward-sexp) + (backward-delete-char 1) + (insert (if round "]" ")")) + (goto-char p) + (delete-char 1) + (insert (if round "[" "(")) + (setq steps (1- steps)) + (backward-char) + (condition-case nil + (progn (when fwd (forward-sexp 2)) + (backward-sexp)) + (error (setq steps 0)))))) + (when (and pared (fboundp 'paredit-mode)) (paredit-mode 1))))) + ;;; Geiser mode: @@ -258,6 +287,7 @@ interacting with the Geiser REPL is at your disposal. ("Complete module name" ((kbd "M-`") (kbd "C-.")) geiser-completion--complete-module) ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module) + ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify) -- ("Callers" ((kbd "C-c <")) geiser-xref-callers :enable (and (geiser-eval--supported-p 'callers) (symbol-at-point))) diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index c32bcc9..8c66e67 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -150,7 +150,8 @@ This function uses `geiser-racket-init-file' if it exists." (format "(require %s)" module))) (defun geiser-racket--exit-command () - (not (geiser-eval--send/result '(:eval (exit) geiser/emacs)))) + (comint-send-eof) + (get-buffer-process (current-buffer))) (defconst geiser-racket--binding-forms '(for for/list for/hash for/hasheq for/and for/or @@ -168,7 +169,7 @@ This function uses `geiser-racket-init-file' if it exists." (defsubst geiser-racket--get-help (symbol module) (geiser-eval--send/wait - `(:eval (get-help ',symbol (:module ,module)) geiser/autodoc))) + `(:eval (get-help ',symbol '(:module ,module)) geiser/autodoc))) (defun geiser-racket--external-help (id module) (message "Requesting help for '%s'..." id) @@ -222,6 +223,18 @@ This function uses `geiser-racket-init-file' if it exists." (geiser-racket--explicit-module))) +;;; Remote REPLs + +(defun connect-to-racket () + "Start a Racket REPL connected to a remote process. + +The remote process needs to be running a REPL server started +using start-geiser, a procedure in the geiser/server module." + (interactive) + (geiser-connect 'racket)) + + + ;;; Implementation definition: (define-geiser-implementation racket @@ -229,6 +242,7 @@ This function uses `geiser-racket-init-file' if it exists." (binary geiser-racket--binary) (arglist geiser-racket--parameters) (startup) + (eot-regexp "\0") (prompt-regexp geiser-racket--prompt-regexp) (marshall-procedure geiser-racket--geiser-procedure) (find-module geiser-racket--get-module) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 57111f4..a05346c 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -156,9 +156,10 @@ expression, if any." (pop-to-buffer (or old (generate-new-buffer (format "* %s *" - (geiser-repl--repl-name impl))))))) - (geiser-repl-mode) - (geiser-impl--set-buffer-implementation impl)) + (geiser-repl--repl-name impl))))) + (unless old + (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 @@ -205,23 +206,25 @@ module command as a string") (defsubst geiser-repl--port () (cdr geiser-repl--address)) (defsubst geiser-repl--remote-p () geiser-repl--address) -(defun geiser-repl--get-address () +(defun geiser-repl--get-address (&optional host port) (let ((defhost (or (geiser-repl--host) geiser-repl-default-host)) (defport (or (geiser-repl--port) geiser-repl-default-port))) - (cons (read-string (format "Host (default %s): " defhost) nil nil defhost) - (read-number "Port: " defport)))) + (cons (or host + (read-string (format "Host (default %s): " defhost) + nil nil defhost)) + (or port (read-number "Port: " defport))))) (defun geiser-repl--save-remote-data (remote address) (setq geiser-repl--address (and remote address)) - (when remote - (setq header-line-format (format "Host: %s Port: %s" - (geiser-repl--host) - (geiser-repl--port))))) + (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) +(defun geiser-repl--start-repl (impl &optional remote host port) (message "Starting Geiser REPL for %s ..." impl) (geiser-repl--to-repl-buffer impl) - (let ((program (if remote (geiser-repl--get-address) + (let ((program (if remote (geiser-repl--get-address host port) (geiser-repl--binary impl))) (args (geiser-repl--arglist impl)) (prompt-rx (geiser-repl--prompt-regexp impl)) @@ -246,7 +249,8 @@ module command as a string") deb-preamble-rx) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) - (geiser-repl--startup impl))) + (geiser-repl--startup impl) + (message "Geiser REPL up and running!"))) (defun geiser-repl--process () (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) @@ -287,7 +291,7 @@ module command as a string") "Start Geiser for scheme implementation: ")))) (geiser-repl--start-repl impl)) -(defun geiser-connect (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) @@ -295,7 +299,7 @@ module command as a string") geiser-impl--implementation) (geiser-repl--read-impl "Scheme implementation: ")))) - (geiser-repl--start-repl impl t)) + (geiser-repl--start-repl impl t host port)) (make-variable-buffer-local (defvar geiser-repl--last-scm-buffer nil)) @@ -306,14 +310,21 @@ 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)) - (repl (cond ((and (not ask) (not impl) + (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) impl (geiser-repl--repl/impl impl))))) + ((and (not ask) + (not in-repl) + impl + (geiser-repl--repl/impl impl))))) (pop-up-windows geiser-repl-window-allow-split)) - (cond ((and (eq (current-buffer) repl) - (not (eq repl buffer)) - (buffer-live-p geiser-repl--last-scm-buffer)) - (pop-to-buffer geiser-repl--last-scm-buffer)) + (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))) @@ -334,7 +345,8 @@ If no REPL is running, execute `run-geiser' to start a fresh one." "Switch to running Geiser REPL and try to enter a given module." (interactive) (let* ((module (or module - (geiser-completion--read-module "Switch to module: "))) + (geiser-completion--read-module + "Switch to module (default top-level): "))) (cmd (and module (geiser-repl--enter-cmd geiser-impl--implementation module)))) @@ -505,11 +517,19 @@ With a prefix argument, force exit by killing the scheme process." (insert "\n")))))) (defun geiser-repl--tab (n) + "If we're after the last prompt, complete symbol or indent (if +there's no symbol at point). Otherwise, go to next error in the REPL +buffer." (interactive "p") (if (> (point) (geiser-repl--last-prompt-end)) (geiser-completion--maybe-complete) (compilation-next-error n))) +(defun geiser-repl--previous-error (n) + "Go to previous error in the REPL buffer." + (interactive "p") + (compilation-next-error (- n))) + (define-derived-mode geiser-repl-mode comint-mode "REPL" "Major mode for interacting with an inferior scheme repl process. \\{geiser-repl-mode-map}" @@ -535,13 +555,14 @@ With a prefix argument, force exit by killing the scheme process." (define-key geiser-repl-mode-map [return] 'geiser-repl--maybe-send) (define-key geiser-repl-mode-map "\C-j" 'geiser-repl--newline-and-indent) (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-repl--tab) +(define-key geiser-repl-mode-map [backtab] 'geiser-repl--previous-error) (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol) (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol) (geiser-menu--defmenu repl geiser-repl-mode-map - ("Complete symbol" ((kbd "TAB") (kbd "M-TAB")) - geiser-completion--complete-symbol :enable (symbol-at-point)) + ("Complete symbol" ((kbd "M-TAB")) + geiser-repl--tab :enable (symbol-at-point)) ("Complete module name" ((kbd "C-.") (kbd "M-`")) geiser-completion--complete-module :enable (symbol-at-point)) ("Edit symbol" "\M-." geiser-edit-symbol-at-point |