[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/geiser-guile d69ca12 044/284: Autodoc support for GOOPS me
From: |
Philip Kaludercic |
Subject: |
[nongnu] elpa/geiser-guile d69ca12 044/284: Autodoc support for GOOPS methods. |
Date: |
Sun, 1 Aug 2021 18:29:13 -0400 (EDT) |
branch: elpa/geiser-guile
commit d69ca12060ef0eee16a59528b6ebeefbc38cdde2
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>
Autodoc support for GOOPS methods.
---
geiser/introspection.scm | 91 +++++++++++++++++++++++++++++-------------------
1 file changed, 56 insertions(+), 35 deletions(-)
diff --git a/geiser/introspection.scm b/geiser/introspection.scm
index de1020f..900a5fa 100644
--- a/geiser/introspection.scm
+++ b/geiser/introspection.scm
@@ -36,6 +36,7 @@
#:use-module (ice-9 regex)
#:use-module (ice-9 session)
#:use-module (ice-9 documentation)
+ #:use-module (oop goops)
#:use-module (srfi srfi-1))
(define (autodoc form)
@@ -104,6 +105,16 @@
(if (null? keys) 0 (+ 1 (length keys)))
(if rest 2 0))))))))
+(define (symbol-module sym)
+ (and sym
+ (call/cc
+ (lambda (k)
+ (apropos-fold (lambda (module name var init)
+ (if (eq? name sym) (k (module-name module)) init))
+ #f
+ (regexp-quote (symbol->string sym))
+ (apropos-fold-accessible (current-module)))))))
+
(define (symbol->obj sym)
(and (symbol? sym)
(module-defined? (current-module) sym)
@@ -116,46 +127,56 @@
'((required ...))))
(else #f)))
-(define (symbol-module sym)
- (and sym
- (call/cc
- (lambda (k)
- (apropos-fold (lambda (module name var init)
- (if (eq? name sym) (k (module-name module)) init))
- #f
- (regexp-quote (symbol->string sym))
- (apropos-fold-accessible (current-module)))))))
+(define (arguments proc)
+ (cond
+ ((is-a? proc <generic>) (generic-args proc))
+ ((procedure-property proc 'arglist) => arglist->args)
+ ((procedure-source proc) => source->args)
+ ((program? proc) ((@ (system vm program) program-arguments) proc))
+ ((procedure-property proc 'arity) => arity->args)
+ (else #f)))
+
+(define (source->args src)
+ (let ((formals (cadr src)))
+ (cond ((list? formals) `((required . ,formals)))
+ ((pair? formals)
+ `((required . ,(car formals)) (rest . ,(cdr formals))))
+ (else #f))))
+
+(define (arity->args art)
+ (let ((req (car art))
+ (opt (cadr art))
+ (rest (caddr art)))
+ `(,@(if (> req 0) (list (cons 'required (gen-arg-names 1 req))) '())
+ ,@(if (> opt 0) (list (cons 'optional (gen-arg-names (+ 1 req) opt)))
'())
+ ,@(if rest (list (cons 'rest 'rest)) '()))))
(define (gen-arg-names fst count)
(map (lambda (n) (string->symbol (format "arg-~A" (+ fst n))))
(iota (max count 1))))
-(define (arguments proc)
- (cond
- ((procedure-property proc 'arglist)
- => (lambda (arglist)
- `((required . ,(car arglist))
- (optional . ,(cadr arglist))
- (keyword . ,(caddr arglist))
- (rest . ,(car (cddddr arglist))))))
- ((procedure-source proc)
- => (lambda (src)
- (let ((formals (cadr src)))
- (cond ((list? formals) `((required . ,formals)))
- ((pair? formals)
- `((required . ,(car formals)) (rest . ,(cdr formals))))
- (else #f)))))
- (((@ (system vm program) program?) proc)
- ((@ (system vm program) program-arguments) proc))
- ((procedure-property proc 'arity)
- => (lambda (art)
- (let ((req (car art))
- (opt (cadr art))
- (rest (caddr art)))
- `(,@(if (> req 0) (list (cons 'required (gen-arg-names 1 req))) '())
- ,@(if (> opt 0) (list (cons 'optional (gen-arg-names (+ 1 req)
opt))) '())
- ,@(if rest (list (cons 'rest 'rest)) '())))))
- (else #f)))
+(define (arglist->args arglist)
+ `((required . ,(car arglist))
+ (optional . ,(cadr arglist))
+ (keyword . ,(caddr arglist))
+ (rest . ,(car (cddddr arglist)))))
+
+(define (generic-args gen)
+ (define (src> src1 src2)
+ (> (length (cadr src1)) (length (cadr src2))))
+ (define (src m)
+ (catch #t
+ (lambda () (method-source m))
+ (lambda (k . a) #f)))
+ (let* ((methods (generic-function-methods gen))
+ (srcs (filter identity (map src methods))))
+ (cond ((and (null? srcs) (null? methods)) '((rest . rest)))
+ ((and (null? srcs)
+ (not (null? methods))
+ (method-procedure (car methods)))
+ => arguments)
+ ((not (null? srcs)) (source->args (car (sort! srcs src>))))
+ (else '((rest . rest))))))
(define (completions prefix . context)
(let ((context (and (not (null? context)) (car context)))
- [nongnu] elpa/geiser-guile 8c8790c 029/284: Capture backtrace. Fix load/compile from Emacs., (continued)
- [nongnu] elpa/geiser-guile 8c8790c 029/284: Capture backtrace. Fix load/compile from Emacs., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 8db7920 030/284: Better stack delimitation: include only frames relevant to the eval'd expression., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile c60b2e0 035/284: Put new procedure-arguments into (geiser introspection) until it goes upstream., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 0d62495 048/284: Fix autodoc support for multiline arities in documentation., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 4a647eb 011/284: Faster, asynchronous autodoc., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 8cd5259 014/284: Small autodoc fixes., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 56671f6 015/284: New command to get docstrings (C-cC-d)., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile f857023 007/284: Edit symbol at point for programs., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile d0f98a7 036/284: Simpler handling of rest args in Emacs' side., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 221e64e 042/284: Some refactoring and new ge:macroexpand., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile d69ca12 044/284: Autodoc support for GOOPS methods.,
Philip Kaludercic <=
- [nongnu] elpa/geiser-guile 4d48077 046/284: Fix recursive require. Nicer arg names in autodoc., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 5be0195 049/284: Cache arguments parsed from documentation; don't treat quasiquote as a function., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 6ff9936 052/284: They say call/cc is slow in Guile., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile a96b437 053/284: turn-on/off-geiser-mode commands added and used in scheme-mode-hook., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile d71825c 058/284: Small bug fix., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile fe48642 008/284: M-. working for any symbol whose module can be located., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 75df3b1 024/284: Better symbol documentation., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 8cb76f1 045/284: Breakdown of schemeland into neat submodules., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 7b77380 054/284: New command to display generic methods (C-cC-dg) implemented., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-guile 33b8c53 066/284: Callers/callees (C-c <, C-c >)., Philip Kaludercic, 2021/08/01