From 0ead55f7052edb0f151e4e86c6feb30718d36bea Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 12 Feb 2009 22:07:29 +0100
Subject: Edit symbol at point for programs.

---
 scheme/guile/geiser/introspection.scm | 38 ++++++++++++++++++++++++++++++-----
 1 file changed, 33 insertions(+), 5 deletions(-)

(limited to 'scheme/guile/geiser/introspection.scm')

diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm
index 6ac3f69..03d5796 100644
--- a/scheme/guile/geiser/introspection.scm
+++ b/scheme/guile/geiser/introspection.scm
@@ -25,7 +25,7 @@
 ;;; Code:
 
 (define-module (geiser introspection)
-  #:export (proc-args completions)
+  #:export (proc-args completions symbol-location)
   #:use-module (system vm program)
   #:use-module (ice-9 session)
   #:use-module (srfi srfi-1))
@@ -81,9 +81,37 @@
               (apropos-internal (string-append "^" prefix)))
          string<?))
 
-(define (proc-location proc)
-  (let ((prog (resolve-symbol proc)))
-    (and prog
-         (program-source ))))
+(define (make-location file line)
+  (list (cons 'file (if (string? file) file '()))
+        (cons 'line (if (number? line) (+ 1 line) '()))))
+
+(define (program-line prog)
+  (let ((src (program-source prog 0)))
+    (and src (source:line src))))
+
+(define (module-filename name)
+  (let* ((name (map symbol->string name))
+         (reverse-name (reverse name))
+	 (leaf (car reverse-name))
+	 (dir-hint-module-name (reverse (cdr reverse-name)))
+	 (dir-hint (apply string-append
+                          (map (lambda (elt)
+                                 (string-append elt "/"))
+                               dir-hint-module-name))))
+    (%search-load-path (in-vicinity dir-hint leaf))))
+
+(define (program-file prog)
+  (let* ((mod (and prog (program-module prog)))
+         (name (and mod (module-name mod))))
+    (and name (module-filename name))))
+
+(define (program-location prog)
+  (make-location (program-file prog) (program-line prog)))
+
+(define (symbol-location sym)
+  (let ((prog (resolve-symbol sym)))
+    (if (program? prog)
+        (program-location prog)
+        '())))
 
 ;;; introspection.scm ends here
-- 
cgit v1.2.3