From af8296f04700d0b0c2ba16cc4fd91ecae0256477 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 5 Mar 2009 02:14:01 +0100
Subject: generic-methods implemented in scheme (no emacs side yet).

---
 geiser/doc.scm  |  7 ++++++-
 geiser/xref.scm | 30 +++++++++++++++++++++++++++++-
 2 files changed, 35 insertions(+), 2 deletions(-)

(limited to 'geiser')

diff --git a/geiser/doc.scm b/geiser/doc.scm
index 01b9ce3..f655fd6 100644
--- a/geiser/doc.scm
+++ b/geiser/doc.scm
@@ -26,7 +26,8 @@
 
 (define-module (geiser doc)
   #:export (autodoc
-            symbol-documentation)
+            symbol-documentation
+            object-signature)
   #:use-module (geiser utils)
   #:use-module (geiser modules)
   #:use-module (system vm program)
@@ -51,6 +52,10 @@
                  (else (describe-application form)))))
         (else #f)))
 
+(define (object-signature name obj)
+  (let ((args (obj-args obj)))
+    (and args (signature name args))))
+
 (define (describe-application form)
   (let* ((fun (car form))
          (args (obj-args (symbol->object fun))))
diff --git a/geiser/xref.scm b/geiser/xref.scm
index 2cd4d80..232d692 100644
--- a/geiser/xref.scm
+++ b/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>) (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