diff options
| -rw-r--r-- | elisp/geiser-debug.el | 42 | ||||
| -rw-r--r-- | elisp/geiser-edit.el | 14 | ||||
| -rw-r--r-- | elisp/geiser-guile.el | 12 | ||||
| -rw-r--r-- | elisp/geiser-racket.el | 16 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 4 |
5 files changed, 53 insertions, 35 deletions
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 909dffb..7f70d19 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -65,29 +65,33 @@ and the accompanying error message) and should display error was successfully displayed, the call should evaluate to a non-null value.") +(geiser-impl--define-caller geiser-debug--enter-debugger + enter-debugger () + "This method is called upon entering the debugger, in the REPL +buffer.") + (defun geiser-debug--display-retort (what ret &optional res) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) (output (geiser-eval--retort-output ret)) (impl geiser-impl--implementation) - (module (geiser-eval--get-module))) - (if (eq key 'geiser-debugger) - (progn - (switch-to-geiser nil nil (current-buffer)) - (geiser-debug--display-error impl module key output)) - (geiser-debug--with-buffer - (erase-buffer) - (insert what) - (newline 2) - (when (and res (not err)) - (insert res) - (newline 2)) - (unless (geiser-debug--display-error impl module key output) - (when err (insert (geiser-eval--error-str err) "\n\n")) - (when output (insert output "\n\n"))) - (goto-char (point-min))) - (when (or err (and output (> (length output) 0))) - (geiser-debug--pop-to-buffer))))) + (module (geiser-eval--get-module)) + (jump nil) + (buffer (current-buffer)) + (debug (eq key 'geiser-debugger))) + (when debug + (switch-to-geiser nil nil buffer) + (geiser-debug--enter-debugger impl)) + (geiser-debug--with-buffer + (erase-buffer) + (insert what) + (newline 2) + (when (and res (not err)) + (insert res) + (newline 2)) + (setq jump (geiser-debug--display-error impl module key output)) + (goto-char (point-min))) + (when jump (geiser-debug--pop-to-buffer)))) (defsubst geiser-debug--wrap-region (str) (format "(begin %s)" str)) @@ -107,7 +111,7 @@ non-null value.") (geiser-autodoc--clean-cache) (when and-go (funcall and-go)) (when (not err) (message "%s" res)) - (geiser-debug--display-retort str ret res))) + (geiser-debug--display-retort (geiser-syntax--scheme-str str) ret res))) (defun geiser-debug--expand-region (start end all wrap) (let* ((str (buffer-substring-no-properties start end)) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index e63a91b..55106d3 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -142,6 +142,20 @@ or following links in error buffers.") (geiser-edit--make-location 'error file line col) 'help-echo "Go to error location")) +(defconst geiser-edit--default-file-rx + "^\\([^<>:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)") + +(defun geiser-edit--buttonize-files (&optional rx) + (let ((rx (or rx geiser-edit--default-file-rx))) + (save-excursion + (while (re-search-forward rx nil t) + (geiser-edit--make-link (match-beginning 1) + (match-end 1) + (match-string 1) + (match-string 2) + (match-string 3) + 'window))))) + ;;; Commands: diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 8561df7..640ef02 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -134,7 +134,7 @@ This function uses `geiser-guile-init-file' if it exists." ;;; Error display -(defun geiser-guile--display-error (module key msg) +(defun geiser-guile--enter-debugger () (when (eq key 'geiser-debugger) (let ((bt-cmd (format ",%s\n" (if geiser-guile-debug-show-bt-p "bt" "fr")))) @@ -148,8 +148,13 @@ This function uses `geiser-guile-init-file' if it exists." (when geiser-guile-jump-on-debug-p (accept-process-output (get-buffer-process (current-buffer)) 0.2 nil t) - (ignore-errors (next-error))))) - t) + (ignore-errors (next-error)))))) + +(defun geiser-guile--display-error (module key msg) + (newline) + (save-excursion (insert msg)) + (geiser-edit--buttonize-files) + (and (not key) msg (not (zerop (length msg))))) ;;; Trying to ascertain whether a buffer is Guile Scheme: @@ -201,6 +206,7 @@ This function uses `geiser-guile-init-file' if it exists." (arglist geiser-guile--parameters) (startup geiser-guile--startup) (prompt-regexp geiser-guile--prompt-regexp) + (enter-debugger geiser-guile--enter-debugger) (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp) (debugger-preamble-regexp geiser-guile--debugger-preamble-regexp) (marshall-procedure geiser-guile--geiser-procedure) diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index d876714..6d04858 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -154,7 +154,7 @@ This function uses `geiser-racket-init-file' if it exists." ;;; Error display (defconst geiser-racket--file-rxs - '("^\\([^:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)" + '(nil "path:\"?\\([^>\"\n]+\\)\"?>" "module: \"\\([^>\"\n]+\\)\"")) @@ -166,16 +166,6 @@ This function uses `geiser-racket-init-file' if it exists." (while (re-search-forward geiser-racket--geiser-file-rx nil t) (kill-whole-line)))) -(defun geiser-racket--find-files (rx) - (save-excursion - (while (re-search-forward rx nil t) - (geiser-edit--make-link (match-beginning 1) - (match-end 1) - (match-string 1) - (match-string 2) - (match-string 3) - 'window)))) - (defun geiser-racket--display-error (module key msg) (when key (insert "Error: ") @@ -188,10 +178,10 @@ This function uses `geiser-racket-init-file' if it exists." (let ((end (point))) (goto-char p) (geiser-racket--purge-trace) - (mapc 'geiser-racket--find-files geiser-racket--file-rxs) + (mapc 'geiser-edit--buttonize-files geiser-racket--file-rxs) (goto-char end) (newline))))) - t) + (or key (not (zerop (length msg))))) ;;; Trying to ascertain whether a buffer is mzscheme scheme: diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 1247cf6..551ee6a 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -47,6 +47,7 @@ (let+ 1) (let: 1) (letrec: 1) + (letrec* 1) (letrec-values 1) (letrec-values: 1) (let-values 1) @@ -73,6 +74,9 @@ (unless 1) (when 1) (while 1) + (with-fluid* 1) + (with-fluids 1) + (with-fluids* 1) (with-handlers 1) (with-handlers: 1) (with-method 1) |