[nongnu] elpa/geiser-guile 1c9457a 116/284: Guile: heuristically resolving relative paths in REPL errors.

[Philip Kaludercic]

branch: elpa/geiser-guile
commit 1c9457aa15b00a9a9f058a5677370305aa68da79
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>

    Guile: heuristically resolving relative paths in REPL errors.
---
 elisp/geiser-guile.el | 37 +++++++++++++++++++++++++++++++++++--
 1 file changed, 35 insertions(+), 2 deletions(-)

diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 0523dfe..db4b27d 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -150,11 +150,44 @@ This function uses `geiser-guile-init-file' if it exists."
 
 
 ;;; Compilation shell regexps
+
+(defconst geiser-guile--path-rx "^In \\([^:\n]+\\):\n")
+
+(defconst geiser-guile--rel-path-rx
+  "^In \\([^/\n]+.+?/module/\\([^:\n]+\\)\\):\n")
+
+(make-variable-buffer-local
+ (defvar geiser-guile--load-path nil))
+
+(defun geiser-guile--load-path ()
+  (geiser-eval--send/result `(:eval (:scm "%load-path"))))
+
+(defun geiser-guile--find-in-load-path (f ps)
+  (when ps
+    (let ((c (expand-file-name f (car ps))))
+      (or (and (file-exists-p c) c)
+          (geiser-guile--find-in-load-path f (cdr ps))))))
+
+(defun geiser-guile--resolve-file-x ()
+  (let ((f (match-string-no-properties 1)))
+    (if (file-name-absolute-p f)
+        (list f)
+      (let ((p (match-string-no-properties 0)))
+        (when (string-match geiser-guile--rel-path-rx p)
+          (let ((f (geiser-guile--find-in-load-path
+                    (match-string-no-properties 2 p)
+                    geiser-guile--load-path)))
+            (and f (list f))))))))
+
 (defun geiser-guile--startup ()
   (set (make-local-variable 'compilation-error-regexp-alist)
-       '(("^In \\(/[^:\n]+\\):\n +\\([0-9]+\\): +" 1 2)
+       `((,geiser-guile--path-rx geiser-guile--resolve-file-x)
+         ("^ +\\([0-9]+\\): +" nil 1)
          ("at \\(/[^:\n]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)" 1 2 3)))
-  (compilation-setup t))
+  (setq geiser-guile--load-path (geiser-guile--load-path))
+  (compilation-setup t)
+  (font-lock-add-keywords
+   nil `((,geiser-guile--path-rx 1 compilation-error-face))))
 
 
 ;;; Implementation definition: