diff options
| -rw-r--r-- | scheme/chibi/geiser/geiser.scm | 132 | ||||
| -rw-r--r-- | 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")) |