summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--elisp/geiser-connection.el29
-rw-r--r--elisp/geiser-debug.el69
-rw-r--r--elisp/geiser-eval.el22
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) "'()")