diff options
| -rw-r--r-- | elisp/geiser-connection.el | 29 | ||||
| -rw-r--r-- | elisp/geiser-debug.el | 69 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 22 |
3 files changed, 64 insertions, 56 deletions
diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 1068330..344fbe2 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -157,9 +157,9 @@ new)) (defun geiser-con--has-entered-debugger (con answer) - (and (not (geiser-con--connection-is-debugging con)) - (let ((p (car (last (split-string answer "\n" t))))) - (and p (geiser-con--connection-update-debugging con p))))) + (when-let ((p (car (last (split-string answer "\n" t))))) + (geiser-con--connection-update-debugging con p)) + (geiser-con--connection-is-debugging con)) (defun geiser-con--connection-eot-p (con txt) (and txt @@ -199,17 +199,18 @@ ;;; Requests handling: (defun geiser-con--req-form (req answer) - (let ((con (geiser-con--request-connection req))) - (if (geiser-con--has-entered-debugger con answer) - `((error (key . geiser-debugger)) - (output . ,answer)) - (condition-case err - (let ((start (string-match "((\\(?:result)?\\|error\\) " answer))) - (or (and start (car (read-from-string answer start))) - `((error (key . retort-syntax)) (output . ,answer)))) - (error `((error (key . geiser-con-error)) - (output . ,(format "%s\n(%s)" - answer (error-message-string err))))))))) + (let* ((con (geiser-con--request-connection req)) + (debugging (geiser-con--has-entered-debugger con answer))) + (condition-case err + (let ((start (string-match "((\\(?:result)?\\|error\\) " answer))) + (or (and start (car (read-from-string answer start))) + `((error (key . retort-syntax)) + (output . ,answer) + (debug . ,debugging)))) + (error `((error (key . geiser-con-error)) + (debug . debugging) + (output . ,(format "%s\n(%s)" + answer (error-message-string err)))))))) (defun geiser-con--process-completed-request (req answer) (let ((cont (geiser-con--request-continuation req)) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index e1f37b7..f73b6cd 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -107,45 +107,57 @@ all ANSI sequences." (buffer-disable-undo) (set-syntax-table scheme-mode-syntax-table) (setq next-error-function 'geiser-edit--open-next) + (compilation-minor-mode 1) (setq buffer-read-only t)) -(defun geiser-debug--button-p (nextp) - (let ((m (funcall (if nextp 'next-button 'previous-button) (point)))) - (and m (funcall (if nextp '< '>) (point) (marker-position m))))) - (defvar-local geiser-debug--debugger-active-p nil) (defvar-local geiser-debug--sender-buffer nil) (geiser-menu--defmenu debug geiser-debug-mode-map - ("Next error" "n" forward-button :enable (geiser-debug--button-p t)) - ("Previous error" "p" backward-button :enable (geiser-debug--button-p t)) - ("Debugger command" "," - geiser-debug--debugger-transient :enable geiser-debug--debugger-active-p) + ("Next error" "n" compilation-next-error) + ("Previous error" "p" compilation-previous-error) + ("Debugger command" "," geiser-debug--debugger-transient + :enable geiser-debug--debugger-active-p) + ("Source buffer" ("z" (kbd "C-c C-z")) geiser-debug-switch-to-buffer) -- ("Quit" nil View-quit)) (defun geiser-debug--send-to-repl (thing) - (unless geiser-debug--sender-buffer (error "Debugger not active")) - (with-current-buffer geiser-debug--sender-buffer - (let* ((ret (geiser-eval--send/wait (list :debug thing))) - (res (geiser-eval--retort-result-str ret nil))) - (geiser-debug--display-retort "" ret res)))) + (unless (and geiser-debug--debugger-active-p geiser-debug--sender-buffer) + (error "Debugger not active")) + (save-window-excursion + (with-current-buffer geiser-debug--sender-buffer + (let* ((ret (geiser-eval--send/wait (cons :debug thing))) + (res (geiser-eval--retort-result-str ret nil))) + (geiser-debug--display-retort (format ",%s" thing) ret res))))) + +(defun geiser-debug-switch-to-buffer () + "Return to the scheme buffer that pooped this debug window." + (interactive) + (when geiser-debug--sender-buffer + (geiser-repl--switch-to-buffer geiser-debug--sender-buffer))) (defun geiser-debug-debugger-quit () "Quit the current debugging session level" (interactive) - (geiser-debug--send-to-repl ",q")) + (geiser-debug--send-to-repl 'quit)) (defun geiser-debug-debugger-backtrace () "Quit the current debugging session level" (interactive) - (geiser-debug--send-to-repl ",bt")) + (geiser-debug--send-to-repl 'bt)) (transient-define-prefix geiser-debug--debugger-transient () "Debugging meta-commands" - ["Debugger" + [:description (lambda () (format "%s debugger" (geiser-impl--impl-str))) + :if (lambda () geiser-debug--debugger-active-p) ("q" "Quit current debugger level" geiser-debug-debugger-quit) - ("bt" "Display backtrace" geiser-debug-debugger-quit)]) + ("bt" "Display backtrace" geiser-debug-debugger-backtrace)]) + + +;;; Implementation-dependent functionality +(geiser-impl--define-caller geiser-debug--clean-up-output clean-up-output (output) + "Clean up output from an evaluation for display.") ;;; Buffer for displaying evaluation results: @@ -188,31 +200,28 @@ buffer.") (declare-function switch-to-geiser "geiser-repl") -(defun geiser-debug--remove-prompt (impl str) - (replace-regexp-in-string (or (geiser-repl--debugger-prompt-regexp impl) "^$") - "" - str)) - (defun geiser-debug--display-retort (what ret &optional res auto-p) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) - (output (geiser-eval--retort-output ret)) - (output (and (stringp output) (not (string= output "")) output)) + (debug (alist-get 'debug ret)) (impl geiser-impl--implementation) + (output (geiser-eval--retort-output ret)) + (output (and (stringp output) + (not (string= output "")) + (or (geiser-debug--clean-up-output impl output) output))) (module (geiser-eval--get-module)) (img nil) (dir default-directory) (buffer (current-buffer)) - (debug (eq key 'geiser-debugger)) - (output (if debug (geiser-debug--remove-prompt impl output) output)) - (debug-entered (when debug - (switch-to-geiser nil nil buffer) - (geiser-debug--enter-debugger impl))) + (debug-entered (when debug (geiser-debug--enter-debugger impl))) (after (geiser-debug--display-after what))) (unless debug-entered (geiser-debug--with-buffer + (when (and (not debug) geiser-debug--debugger-active-p) + (message "Debugger exited")) (setq geiser-debug--debugger-active-p debug - geiser-debug--sender-buffer buffer) + geiser-debug--sender-buffer buffer + geiser-impl--implementation impl) (erase-buffer) (when dir (setq default-directory dir)) (unless after (insert what "\n\n")) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 7b7ab64..f5cbccd 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -1,6 +1,6 @@ ;;; geiser-eval.el -- sending scheme code for evaluation -;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 2021 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -35,9 +35,11 @@ an optional argument, for cases where we want to force its value.") (defun geiser-eval--get-module (&optional module) - (if geiser-eval--get-module-function - (funcall geiser-eval--get-module-function module) - (funcall geiser-eval--get-impl-module module))) + (cond (geiser-eval--get-module-function + (funcall geiser-eval--get-module-function module)) + (geiser-eval--get-impl-module + (funcall geiser-eval--get-impl-module module)) + (t module))) (defvar geiser-eval--geiser-procedure-function) (geiser-impl--register-local-method @@ -70,16 +72,13 @@ module-exports, autodoc, callers, callees and generic-methods.") ;;; Code formatting: (defsubst geiser-eval--debug (cmd) - (geiser-eval--form 'debug - (geiser-eval--scheme-str file))) + (geiser-eval--form 'debug (geiser-eval--scheme-str cmd))) (defsubst geiser-eval--load-file (file) - (geiser-eval--form 'load-file - (geiser-eval--scheme-str file))) + (geiser-eval--form 'load-file (geiser-eval--scheme-str file))) (defsubst geiser-eval--comp-file (file) - (geiser-eval--form 'compile-file - (geiser-eval--scheme-str file))) + (geiser-eval--form 'compile-file (geiser-eval--scheme-str file))) (defsubst geiser-eval--module (code) (geiser-eval--scheme-str @@ -99,8 +98,7 @@ module-exports, autodoc, callers, callees and generic-methods.") (geiser-eval--scheme-str (nth 0 code)))) (defsubst geiser-eval--ge (proc args) - (apply 'geiser-eval--form (cons proc - (mapcar 'geiser-eval--scheme-str args)))) + (apply 'geiser-eval--form (cons proc (mapcar 'geiser-eval--scheme-str args)))) (defun geiser-eval--scheme-str (code) (cond ((null code) "'()") |