summaryrefslogtreecommitdiff
path: root/geiser-guile.el
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2021-12-19 03:50:17 +0000
committerjao <jao@gnu.org>2021-12-19 03:50:17 +0000
commit63a8812adae91358cae550dd8ac72be31266ddd4 (patch)
treec5318fa00c4cefba114aa5eafa3e551b70782597 /geiser-guile.el
parent5fb0129c962558bd5e70ac3a739e566627277a09 (diff)
downloadgeiser-guile-63a8812adae91358cae550dd8ac72be31266ddd4.tar.gz
geiser-guile-63a8812adae91358cae550dd8ac72be31266ddd4.tar.bz2
New debugger support for ,q and ,bt
Diffstat (limited to 'geiser-guile.el')
-rw-r--r--geiser-guile.el91
1 files changed, 56 insertions, 35 deletions
diff --git a/geiser-guile.el b/geiser-guile.el
index c4dffc2..9a8d4b7 100644
--- a/geiser-guile.el
+++ b/geiser-guile.el
@@ -164,6 +164,11 @@ This function uses `geiser-guile-init-file' if it exists."
(defconst geiser-guile--debugger-prompt-regexp
"^[^@(\n]+@([^)]*?) \\[[0-9]+\\]> ")
+(defconst geiser-guile--clean-rx
+ (format "\\(%s\\)\\|\\(^\\$[0-9]+ = [^\n]+$\\)"
+ (geiser-con--combined-prompt geiser-guile--prompt-regexp
+ geiser-guile--debugger-prompt-regexp)))
+
;;; Evaluation support:
(defsubst geiser-guile--linearize-args (args)
@@ -179,8 +184,12 @@ This function uses `geiser-guile-init-file' if it exists."
(if (cddr args) "" " ()")))
((load-file compile-file) (format ",geiser-load-file %s" (car args)))
((no-values) ",geiser-no-values")
+ ((debug) (concat "," (geiser-guile--linearize-args args) "\n\"\""))
(t (format "ge:%s (%s)" proc (geiser-guile--linearize-args args)))))
+(defun geiser-guile--clean-up-output (str)
+ (replace-regexp-in-string geiser-guile--clean-rx "" str))
+
(defconst geiser-guile--module-re
"(define-module +\\(([^)]+)\\)")
@@ -234,8 +243,50 @@ This function uses `geiser-guile-init-file' if it exists."
(save-excursion (skip-syntax-backward "^'-()>") (point))))
+;;; Compilation shell regexps
+
+(defconst geiser-guile--path-rx "^In \\([^:\n]+\\):\n")
+
+(defconst geiser-guile--rel-path-rx "^In +\\([^/\n:]+\\):\n")
+
+(defvar geiser-guile--file-cache (make-hash-table :test 'equal)
+ "Internal cache.")
+
+(defun geiser-guile--find-file (file)
+ (or (gethash file geiser-guile--file-cache)
+ (with-current-buffer (or geiser-debug--sender-buffer (current-buffer))
+ (when-let (r geiser-repl--repl)
+ (with-current-buffer r
+ (geiser-eval--send/result `(:eval (:ge find-file ,file))))))))
+
+(defun geiser-guile--resolve-file (file)
+ "Find the given FILE, if it's indeed a file."
+ (when (and (stringp file)
+ (not (member file '("socket" "stdin" "unknown file"))))
+ (message "Resolving %s" file)
+ (cond ((file-name-absolute-p file) file)
+ ((string= "current input" file)
+ (when geiser-debug--sender-buffer
+ (buffer-file-name geiser-debug--sender-buffer)))
+ (t (when-let (f (geiser-guile--find-file file))
+ (puthash file f geiser-guile--file-cache))))))
+
+(defun geiser-guile--resolve-file-x ()
+ "Check if last match contain a resolvable file."
+ (let ((f (geiser-guile--resolve-file (match-string-no-properties 1))))
+ (and (stringp f) (list f))))
+
+
;;; Error display
+(defun geiser-guile--set-up-error-links ()
+ (setq-local compilation-error-regexp-alist
+ `((,geiser-guile--path-rx geiser-guile--resolve-file-x)
+ ("^ +\\([0-9]+\\):\\([0-9]+\\)" nil 1 2)
+ ("^\\(/.*\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3)))
+ (font-lock-add-keywords nil
+ `((,geiser-guile--path-rx 1 compilation-error-face))))
+
(defun geiser-guile--enter-debugger ()
"Tell Geiser to interact with the debugger."
(when geiser-guile-show-debug-help-p
@@ -245,8 +296,8 @@ This function uses `geiser-guile-init-file' if it exists."
(defun geiser-guile--display-error (_module key msg)
"Display error with given KEY and message MSG."
(when (stringp msg)
- (save-excursion (insert msg))
- (geiser-edit--buttonize-files))
+ (geiser-guile--set-up-error-links)
+ (save-excursion (insert msg)))
(not (zerop (length msg))))
@@ -329,31 +380,6 @@ This function uses `geiser-guile-init-file' if it exists."
(with-throw-handler 1))
-;;; Compilation shell regexps
-
-(defconst geiser-guile--path-rx "^In \\([^:\n ]+\\):\n")
-
-(defconst geiser-guile--rel-path-rx "^In +\\([^/\n :]+\\):\n")
-
-(defvar geiser-guile--file-cache (make-hash-table :test 'equal)
- "Internal cache.")
-
-(defun geiser-guile--resolve-file (file)
- "Find the given FILE, if it's indeed a file."
- (when (and (stringp file)
- (not (member file '("socket" "stdin" "unknown file"))))
- (if (file-name-absolute-p file) file
- (or (gethash file geiser-guile--file-cache)
- (puthash file
- (geiser-eval--send/result `(:eval (:ge find-file ,file)))
- geiser-guile--file-cache)))))
-
-(defun geiser-guile--resolve-file-x ()
- "Check if last match contain a resolvable file."
- (let ((f (geiser-guile--resolve-file (match-string-no-properties 1))))
- (and (stringp f) (list f))))
-
-
;;; REPL startup
(defconst geiser-guile-minimum-version "2.2")
@@ -397,18 +423,12 @@ See `geiser-guile-use-declarative-modules-p'."
(defun geiser-guile--startup (remote)
"Startup function, for a remote connection if REMOTE is t."
- (set (make-local-variable 'compilation-error-regexp-alist)
- `((,geiser-guile--path-rx geiser-guile--resolve-file-x)
- ("^ +\\([0-9]+\\):\\([0-9]+\\)" nil 1 2)
- ("^\\(/.*\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3)))
- (compilation-setup t)
- (font-lock-add-keywords nil `((,geiser-guile--path-rx
- 1 compilation-error-face)))
+ (geiser-guile--set-up-error-links)
(let ((geiser-log-verbose-p t)
(g-load-path (buffer-local-value 'geiser-guile-load-path
(or geiser-repl--last-scm-buffer
(current-buffer)))))
- (when (or geiser-guile--connection-address remote)
+ (when (or geiser-guile--conn-address remote)
(geiser-guile--set-geiser-load-path))
(geiser-guile--set-up-declarative-modules)
(geiser-eval--send/wait ",use (geiser emacs)\n'done")
@@ -459,6 +479,7 @@ See `geiser-guile-use-declarative-modules-p'."
(repl-startup geiser-guile--startup)
(connection-address geiser-guile--get-connection-address)
(prompt-regexp geiser-guile--prompt-regexp)
+ (clean-up-output geiser-guile--clean-up-output)
(debugger-prompt-regexp geiser-guile--debugger-prompt-regexp)
(enter-debugger geiser-guile--enter-debugger)
(marshall-procedure geiser-guile--geiser-procedure)