From 841766449b9dc14d40186a67cdceda26fc6ca4ff Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Fri, 19 Jun 2009 16:52:03 +0200
Subject: Guile: backtrace buttonization.

---
 elisp/geiser-guile.el         | 38 ++++++++++++++++++++++++++++++++++++++
 scheme/guile/geiser/emacs.scm |  3 ++-
 scheme/guile/geiser/xref.scm  |  9 ++++++++-
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 44a4e9f..ed2a555 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -120,6 +120,44 @@ This function uses `geiser-guile-init-file' if it exists."
            (save-excursion (skip-syntax-backward "^(>") (1- (point))))
     (save-excursion (skip-syntax-backward "^-()>") (point))))
 
+
+;;; Error display
+(defvar geiser-guile--file-cache (make-hash-table :test 'equal))
+
+(defun geiser-guile--resolve-file (file)
+  (when (and (stringp file) (not (string-equal file "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)))))
+
+(defconst geiser-guile--file-rx
+  "^In \\([^\n:]+\\):\n *\\([[:digit:]]+\\|\\?\\):")
+
+(defun geiser-guile--find-files ()
+  (save-excursion
+    (while (re-search-forward geiser-guile--file-rx nil t)
+      (let ((file (match-string 1))
+            (beg (match-beginning 1))
+            (end (match-end 1))
+            (line (string-to-number (or (match-string 2) "0"))))
+        (let ((file (geiser-guile--resolve-file file)))
+          (when file
+            (geiser-edit--make-link beg end file line 0)))))))
+
+(defun geiser-guile-display-error (module key msg)
+  (when key
+    (insert "Error: ")
+    (geiser--insert-with-face (format "%s" key) 'bold)
+    (newline 2))
+  (when msg
+    (let ((p (point)))
+      (insert msg)
+      (goto-char p)
+      (geiser-guile--find-files)))
+  t)
+
 
 ;;; Trying to ascertain whether a buffer is Guile Scheme:
 
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm
index edae487..2aa91da 100644
--- a/scheme/guile/geiser/emacs.scm
+++ b/scheme/guile/geiser/emacs.scm
@@ -39,7 +39,8 @@
                ge:module-exports
                ge:module-location
                ge:callers
-               ge:callees)
+               ge:callees
+               ge:find-file)
   #:use-module (geiser evaluation)
   #:use-module ((geiser modules) :renamer (symbol-prefix-proc 'ge:))
   #:use-module ((geiser completion) :renamer (symbol-prefix-proc 'ge:))
diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm
index f00f724..2336fb2 100644
--- a/scheme/guile/geiser/xref.scm
+++ b/scheme/guile/geiser/xref.scm
@@ -28,7 +28,8 @@
   #:export (symbol-location
             generic-methods
             callers
-            callees)
+            callees
+            find-file)
   #:use-module (geiser utils)
   #:use-module (geiser modules)
   #:use-module (geiser doc)
@@ -90,4 +91,10 @@
     (and obj
          (map procedure-xref (procedure-callees obj)))))
 
+(define (find-file path)
+  (let loop ((dirs %load-path))
+    (if (null? dirs) #f
+        (let ((candidate (string-append (car dirs) "/" path)))
+          (if (file-exists? candidate) candidate (loop (cdr dirs)))))))
+
 ;;; xref.scm ends here
-- 
cgit v1.2.3