From 692eb942c39fd42ffe61f1408a4998d738c88933 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 5 Mar 2009 02:14:01 +0100 Subject: generic-methods implemented in scheme (no emacs side yet). --- scheme/guile/geiser/xref.scm | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) (limited to 'scheme/guile/geiser/xref.scm') diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm index 2cd4d80..232d692 100644 --- a/scheme/guile/geiser/xref.scm +++ b/scheme/guile/geiser/xref.scm @@ -28,10 +28,38 @@ #:export (symbol-location generic-methods) #:use-module (geiser utils) - #:use-module (geiser modules)) + #:use-module (geiser modules) + #:use-module (geiser doc) + #:use-module (oop goops) + #:use-module (system vm program)) (define (symbol-location sym) (cond ((symbol-module sym) => module-location) (else '()))) +(define (generic-methods sym) + (let* ((gen (symbol->object sym)) + (methods (if (is-a? gen ) (generic-function-methods gen) '()))) + (filter (lambda (x) (not (null? x))) + (map (lambda (m) (describe-method sym m)) methods)))) + +(define (describe-method name m) + (let ((proc (method-procedure m))) + (if proc + `((location . ,(program-location proc)) + (signature . ,(object-signature name proc))) + '()))) + +(define (program-location p) + (cond ((program-source p 0) => + (lambda (s) (make-location (program-path p) (source:line s)))) + ((program-path p) => + (lambda (s) (make-location (program-path p) #f))) + (else '()))) + +(define (program-path p) + (let* ((mod (program-module p)) + (name (and mod (module-name mod)))) + (and name (module-filename name)))) + ;;; xref.scm ends here -- cgit v1.2.3