From 631d43de316ac010ac8d8bcc165b64dd75a328a1 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 16 Jun 2009 22:36:15 +0200
Subject: Elimination of dead code in stack trace display.

---
 elisp/geiser-debug.el | 46 +++++++++++++++-------------------------------
 elisp/geiser-eval.el  |  3 +--
 2 files changed, 16 insertions(+), 33 deletions(-)

diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index 7ebd0b5..f0dc6ec 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -32,15 +32,23 @@
 
 ;;; Debug buffer mode:
 
-(defconst geiser-debug--error-alist
-  '(("^\\(In file +\\| +\\)\\([^ \n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 2 3 4)
-    ("^Error.+$" nil nil nil 0)))
+(defvar geiser-debug-mode-map
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
+    (set-keymap-parent map button-buffer-map)
+    map))
 
-(define-derived-mode geiser-debug-mode compilation-mode "Geiser Dbg"
+(defun geiser-debug-mode ()
   "A major mode for displaying Scheme compilation and evaluation results.
 \\{geiser-debug-mode-map}"
-  (set (make-local-variable 'compilation-error-regexp-alist)
-       geiser-debug--error-alist))
+  (interactive)
+  (kill-all-local-variables)
+  (buffer-disable-undo)
+  (use-local-map geiser-debug-mode-map)
+  (set-syntax-table scheme-mode-syntax-table)
+  (setq mode-name "Geiser DBG")
+  (setq major-mode 'geiser-debug-mode)
+  (setq buffer-read-only t))
 
 
 ;;; Buffer for displaying evaluation results:
@@ -52,40 +60,16 @@
 
 (defun geiser-debug--display-retort (what ret)
   (let* ((err (geiser-eval--retort-error ret))
-         (output (geiser-eval--retort-output ret))
-         (stack (geiser-eval--retort-stack ret)))
+         (output (geiser-eval--retort-output ret)))
     (geiser-debug--with-buffer
       (erase-buffer)
       (insert what)
       (newline 2)
       (when err (insert (geiser-eval--error-str err) "\n\n"))
       (when output (insert output "\n\n"))
-      (when stack (geiser-debug--display-stack stack))
       (goto-char (point-min)))
     (when err (geiser-debug--pop-to-buffer))))
 
-(defsubst geiser-debug--frame-proc (frame) (cdr (assoc 'procedure frame)))
-(defsubst geiser-debug--frame-desc (frame) (cdr (assoc 'description frame)))
-(defsubst geiser-debug--frame-source (frame) (cdr (assoc 'source frame)))
-(defsubst geiser-debug--frame-source-file (src) (car src))
-(defsubst geiser-debug--frame-source-line (src) (or (cadr src) 1))
-(defsubst geiser-debug--frame-source-column (src) (or (caddr src) 0))
-
-(defun geiser-debug--display-stack (stack)
-  (mapc 'geiser-debug--display-stack-frame (reverse (cdr stack))))
-
-(defun geiser-debug--display-stack-frame (frame)
-  (let ((procedure (geiser-debug--frame-proc frame))
-        (source (geiser-debug--frame-source frame))
-        (description (geiser-debug--frame-desc frame)))
-    (if source
-        (insert (format "In file %s:%s:%s\n"
-                        (geiser-debug--frame-source-file source)
-                        (geiser-debug--frame-source-line source)
-                        (1+ (geiser-debug--frame-source-column source))))
-      (insert "In expression:\n"))
-    (insert (format "%s\n" description))))
-
 (defsubst geiser-debug--wrap-region (str)
   (format "(begin %s)" str))
 
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index c493092..90be67c 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -149,7 +149,6 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
 
 (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret)))
 (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret)))
-(defsubst geiser-eval--retort-stack (ret) (cdr (assoc 'stack ret)))
 
 (defsubst geiser-eval--error-key (err) (cdr (assoc 'key err)))
 (defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err)))
@@ -160,7 +159,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
   (let* ((key (geiser-eval--error-key err))
          (key-str (if key (format ": %s" key) ":"))
          (subr (geiser-eval--error-subr err))
-         (subr-str (if subr (format " (%s):" subr) ":"))
+         (subr-str (if subr (format " (%s):" subr) ""))
          (msg (geiser-eval--error-msg err))
          (msg-str (if msg (format "\n  %s" msg) ""))
          (rest (geiser-eval--error-rest err))
-- 
cgit v1.2.3