summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-10-23 06:26:29 +0100
committerjao <jao@gnu.org>2022-10-23 06:26:29 +0100
commit4f8b5d17ba2436ca08e6ba442ef8dd5a8fa5a714 (patch)
treea35811a34e57c16755121f36ba990f1e68649903
parentd3e7dc792069724880356c4e0f8c1749b90ef1bb (diff)
downloadgeiser-chez-4f8b5d17ba2436ca08e6ba442ef8dd5a8fa5a714.tar.gz
geiser-chez-4f8b5d17ba2436ca08e6ba442ef8dd5a8fa5a714.tar.bz2
all relevant condition locations, not just the last one
-rw-r--r--geiser-chez.el11
-rw-r--r--src/geiser/geiser.ss9
2 files changed, 12 insertions, 8 deletions
diff --git a/geiser-chez.el b/geiser-chez.el
index 9491a65..b0a668c 100644
--- a/geiser-chez.el
+++ b/geiser-chez.el
@@ -186,15 +186,16 @@ Return its local name."
(when msg
(save-excursion
(insert (car msg))
- (when-let (loc (cdr msg))
+ (insert "\n")
+ (dolist (loc (reverse (cdr msg)))
(let ((file (cdr (assoc "file" loc)))
(line (or (cdr (assoc "line" loc)) ""))
(col (or (cdr (assoc "column" loc)) (cdr (assoc "char" loc))))
(name (cdr (assoc "name" loc))))
- (insert "\n\n" file (format ":%s" line))
- (when col (insert (format ":%s" col)))
- (when name (insert (format " (%s)" name))))
- (insert "\n")))
+ (unless (string-prefix-p geiser-chez-scheme-dir file)
+ (insert "\n" file (format ":%s" line))
+ (when col (insert (format ":%s" col)))
+ (when name (insert (format " (%s)" name)))))))
(geiser-edit--buttonize-files)
t))
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index f040413..0644b4d 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -39,7 +39,7 @@
(define (code-location obj)
(let* ((i (inspect/object obj))
- (c (and i (i 'code))))
+ (c (and i (not (eq? 'simple (i 'type))) (i 'code))))
(if c
(let ((name `("name" . ,(or (c 'name) (write-to-string obj)))))
(call-with-values (lambda () (c 'source-path))
@@ -53,8 +53,11 @@
(define (condition-location c)
(let ((finder (make-object-finder procedure? c (collect-maximum-generation))))
- (let loop ((obj (finder)))
- (if obj (or (code-location (car obj)) (loop (finder))) '()))))
+ (let loop ((obj (finder)) (res '()))
+ (if obj
+ (let ((loc (code-location (car obj))))
+ (loop (finder) (if loc (cons loc res) res)))
+ res))))
(define (call-with-result thunk)
(let ((output-string (open-output-string)))