[nongnu] elpa/geiser-chibi e57722a 14/38: Add a first version of geiser:symbol-location for local files.

[Philip Kaludercic]

branch: elpa/geiser-chibi
commit e57722a2335e7ece831bec318a7488d7bf776618
Author: Lockywolf <lockywolf@gmail.com>
Commit: Lockywolf <lockywolf@gmail.com>

    Add a first version of geiser:symbol-location for local files.
---
 scheme/chibi/geiser/geiser.scm | 132 ++++++++++++++++++++++++++++++++++++-----
 scheme/chibi/geiser/geiser.sld |   7 ++-
 2 files changed, 123 insertions(+), 16 deletions(-)

diff --git a/scheme/chibi/geiser/geiser.scm b/scheme/chibi/geiser/geiser.scm
index 9218646..a147b36 100644
--- a/scheme/chibi/geiser/geiser.scm
+++ b/scheme/chibi/geiser/geiser.scm
@@ -19,6 +19,11 @@
     (write form out)
     (get-output-string out)))
 
+(define (geiser:write/ss-to-string form)
+  (let ((out (open-output-string)))
+    (write/ss form out)
+    (get-output-string out)))
+
 ;;> Evaluate a \var{form} in the namespace of the \var{module}.
 ;;> The meaning of \var{rest} is unknown.
 ;;> Return the alist with the first field, \scheme{result}, holds
@@ -30,15 +35,20 @@
   rest
   (guard (err (else (write `((result ,(show #f err))))))
     (let* ((output (open-output-string))
-          (result (parameterize ((current-output-port output))
-                   (if module
-                      (let ((mod (module-env (find-module module))))
-                        (eval form mod))
-                      (eval form)))))
+          (result (parameterize ((current-output-port output))
+                    (if module
+                        (let ((mod (module-env (find-module module))))
+                          (eval form mod))
+                        (eval form))
+                    )
+                  ))
       (write `((result ,(write-to-string result))
                (output . ,(get-output-string output))))))
   (values))
 
+
+; (display "debug:Hello\n")
+
 (define (geiser:module-completions prefix . rest)
   ;; (available-modules) walks the directory tree and is too slow
   (let ((modules (map car *modules*)))
@@ -107,12 +117,104 @@
 ;;> \var{line} is the line number starting from 0 (scheme way).
 
 (define (make-location file line)
-  (list (cons "file" (if (string? file) file '()))
-        (cons "line" (if (number? line) (+ 1 line) '()))))
-
-
-;TODO: (define (geiser:symbol-location) ; implement this method in order to 
make
+  (list (cons "file"
+             (if (string? file)
+                 (path-resolve
+                  file
+                  (current-directory))
+                 '()))
+        (cons "line" (if (number? line) (+ 1 line) '())))
+)
+
+
+;TODO: (define (geiser:symbol-location)
+; implement this method in order to make
 ; xref work better in Chibi. For reference, see [[geiser:module-location]]
+; (analyze-module (caar (modules-exporting-identifier 'symbol-in-question)))
+;(module-ast (analyze-module (caar (modules-exporting-identifier 'ckind))))
+(define (geiser:symbol-location symbol-in-question . rest)
+  (let* (
+        (result (tree-walker
+                (module-ast
+                 (analyze-module
+                  (caar
+                   (modules-exporting-identifier
+                    symbol-in-question))))
+                symbol-in-question))
+        (location
+         (make-location
+          (car result)
+          (- (cdr result) 1))) ; Ehh... line numbering in 'make-location 
starts from 0
+        )
+    location
+    )
+)
+
+(define (tree-walker node . symbol-in-question)
+; The reason this function used  a (let), not a (begin) is that (begin)
+; for some reason does not allow (display)s inside. It 
+; works in xfce4-terminal, but not here. I decided not to
+; debug it, since (do) "just worked". TODO.
+  
+  (if (pair? node)
+       (let ((result
+              (tree-walker
+               (car node)
+               (car symbol-in-question)))
+             )
+         (if result
+               result
+               (tree-walker (cdr node) (car symbol-in-question))
+             )
+         )
+      (let () ; we have leaf
+       (if (set? node)
+           (if (equal? (ref-name (set-var node)) (car symbol-in-question))
+               (let ((thingy (set-value node)))
+                 (if (lambda? thingy)
+                     (lambda->lcons thingy)
+                     (set-node->lcons/dirty-trick node)
+                     )
+                 )
+               #f
+               )
+           #f
+           )
+       )
+      )
+  )
+
+(define (lambda->lcons thingy)
+  (let* ((l-source (lambda-source thingy))
+        (l-location
+         (cons
+          (car l-source)
+          (cdr l-source))))
+    l-location
+    ))
+
+(define (set-node->lcons/dirty-trick node)
+  (let* ((exam2 (geiser:write/ss-to-string node))
+        (strl (string-length exam2))
+        (l-matches
+         (regexp-search
+          '(: "(\""
+              (-> filename (*? graphic) )
+              "\" . "
+              (-> lineno (+ num) )
+              ")}")
+          exam2 ))
+        (l-filename
+         (regexp-match-submatch l-matches 'filename))
+        (l-lineno
+         (string->number
+          (regexp-match-submatch l-matches 'lineno)))
+        (l-location
+         (cons l-filename l-lineno)))
+    l-location))
+
+;(geiser:symbol-location 'run-application)
+
 
 
 ;;> A function to find the file where the symbol
@@ -120,9 +222,11 @@
 
 (define (geiser:module-location symbol-representing-module)
   (make-location
-   (string-append (current-directory) "/"
-    (find-module-file
+   (find-module-file
     (module-name->file
      (module-name
-      (find-module symbol-representing-module)))))
-   0 ) )
+      (find-module symbol-representing-module))))
+   0 )
+)
+
+
diff --git a/scheme/chibi/geiser/geiser.sld b/scheme/chibi/geiser/geiser.sld
index 8e43fb8..86f871a 100644
--- a/scheme/chibi/geiser/geiser.sld
+++ b/scheme/chibi/geiser/geiser.sld
@@ -5,7 +5,7 @@
           geiser:autodoc
           geiser:module-completions
           geiser:no-values
-;TODO:   geiser:symbol-location ; implement this interface in 
[[file://./geiser.scm#geiser:symbol-location]] in order to make proper 
cross-referencing working.
+         geiser:symbol-location ; implement this interface in 
[[file://./geiser.scm#geiser:symbol-location]] in order to make proper 
cross-referencing working.
          geiser:module-location
           geiser:newline)
   (import
@@ -13,10 +13,13 @@
     (chibi modules)
     (chibi)
     (chibi filesystem)
+    (chibi pathname)
     (meta)
     (chibi ast)
     (chibi string)
     (srfi 1)
     (srfi 95)
-    (chibi show))
+    (srfi 38)
+    (chibi show)
+    (srfi 115))
   (include "geiser.scm"))