diff options
| -rw-r--r-- | elisp/geiser-autodoc.el | 54 | ||||
| -rw-r--r-- | elisp/geiser-doc.el | 5 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 20 | ||||
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 16 | ||||
| -rw-r--r-- | scheme/plt/geiser/autodoc.ss | 6 |
5 files changed, 54 insertions, 47 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 16ca9ac..1d876dd 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -79,8 +79,7 @@ when `geiser-autodoc-display-module-p' is on." (push f missing))))) (unless cached (setq geiser-autodoc--cached-signatures nil)) - (if (not missing) - geiser-autodoc--cached-signatures + (if (not missing) geiser-autodoc--cached-signatures (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc) (quote ,missing))) 500))) @@ -111,33 +110,34 @@ when `geiser-autodoc-display-module-p' is on." (propertize str 'face 'geiser-font-lock-autodoc-procedure-name))) (defun geiser-autodoc--str (proc desc signature) - ;; (message "composing %s with desc %s and signature %s" proc desc signature) - (let ((cpos 1) - (pos (second desc)) - (prev (third desc)) - (module (cdr (assoc 'module signature))) - (reqs (cdr (assoc 'required signature))) - (opts (cdr (assoc 'optional signature))) - (keys (cdr (assoc 'key signature)))) - (save-current-buffer - (set-buffer (geiser-syntax--font-lock-buffer)) - (erase-buffer) - (insert (format "(%s " (geiser-autodoc--proc-name proc module))) - (setq cpos - (geiser-autodoc--insert-args reqs cpos (and (not (zerop pos)) pos))) - (when opts - (insert " [") - (setq cpos (geiser-autodoc--insert-args opts cpos pos)) - (when keys - (insert " [") - (geiser-autodoc--insert-args keys prev nil) - (insert "]")) - (insert "]")) - (insert ")") - (buffer-string)))) + (let ((args (cdr (assoc 'args signature))) + (module (cdr (assoc 'module signature)))) + (if (not args) (geiser-autodoc--proc-name proc module) + (let ((cpos 1) + (pos (or (second desc) 0)) + (prev (third desc)) + (reqs (cdr (assoc 'required args))) + (opts (cdr (assoc 'optional args))) + (keys (cdr (assoc 'key args)))) + (save-current-buffer + (set-buffer (geiser-syntax--font-lock-buffer)) + (erase-buffer) + (insert (format "(%s " (geiser-autodoc--proc-name proc module))) + (setq cpos + (geiser-autodoc--insert-args reqs cpos (and (not (zerop pos)) pos))) + (when opts + (insert " [") + (setq cpos (geiser-autodoc--insert-args opts cpos pos)) + (when keys + (insert " [") + (geiser-autodoc--insert-args keys prev nil) + (insert "]")) + (insert "]")) + (insert ")") + (buffer-string)))))) (defun geiser-autodoc--autodoc (path) - (let* ((funs (nreverse (mapcar 'car path))) + (let* ((funs (mapcar 'car path)) (signs (geiser-autodoc--get-signatures funs))) (when signs (catch 'signature diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index adef4c6..61c50f5 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -26,6 +26,7 @@ (require 'geiser-impl) (require 'geiser-completion) +(require 'geiser-autodoc) (require 'geiser-eval) (require 'geiser-syntax) (require 'geiser-popup) @@ -174,7 +175,9 @@ (message "No documentation available for '%s'" symbol) (geiser-doc--with-buffer (erase-buffer) - (geiser-doc--insert-title (cdr (assoc 'signature ds))) + (geiser-doc--insert-title (geiser-autodoc--str (format "%s" symbol) + nil + (cdr (assoc 'signature ds)))) (newline) (insert (or (cdr (assoc 'docstring ds)) "")) (goto-line (point-min)) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 475a556..6cadf61 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -97,29 +97,31 @@ (defun geiser-syntax--scan-sexp () (let ((p (point)) (n -1) - prev - head) + prev head) (ignore-errors (backward-up-list) (save-excursion (forward-char) - (skip-syntax-forward "^_w" p) + (skip-syntax-forward "^_w(" p) (when (setq head (symbol-at-point)) (while (< (point) p) (setq n (1+ n)) (setq prev (symbol-at-point)) (forward-sexp)))) - (if head (list head n prev) 'skip)))) + (if head (list head n (and (> n 1) prev)) 'skip)))) (defun geiser-syntax--scan-sexps () (save-excursion (goto-char (or (nth 8 (syntax-ppss)) (point))) (let* ((sap (symbol-at-point)) - (path (and sap `((,sap 0)))) - s) - (while (setq s (geiser-syntax--scan-sexp)) - (when (listp s) (push s path))) - path))) + (fst (and sap (geiser-syntax--scan-sexp))) + (path (and fst + (cond ((not (listp fst)) `((,sap 0))) + ((eq sap (car fst)) (list fst)) + (t (list fst (list sap 0))))))) + (while (setq fst (geiser-syntax--scan-sexp)) + (when (listp fst) (push fst path))) + (nreverse path)))) (defun geiser-syntax--complete-partial-sexp (buffer begin end) (geiser-syntax--with-buffer diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index d951f1c..bc4acd9 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -37,6 +37,8 @@ #:use-module (oop goops) #:use-module (srfi srfi-1)) +(define *an-object* #t) + (define (autodoc ids) (if (not (list? ids)) '() @@ -59,17 +61,19 @@ ((list? args) args) (else (list args))))) `(,id - (required ,@(arglst 'required)) - (optional ,@(arglst 'optional) - ,@(let ((rest (assq-ref args 'rest))) - (if rest (list "...") '()))) - (key ,@(arglst 'keyword)))) + (args ,@(if (list? args) + `((required ,@(arglst 'required)) + (optional ,@(arglst 'optional) + ,@(let ((rest (assq-ref args 'rest))) + (if rest (list "...") '()))) + (key ,@(arglst 'keyword))) + '())))) (define (obj-args obj) (cond ((not obj) #f) ((or (procedure? obj) (program? obj)) (arguments obj)) ((macro? obj) (or (obj-args (macro-transformer obj)) '((required ...)))) - (else #f))) + (else 'variable))) (define (arguments proc) (cond diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss index 2fe3a83..c43f8c9 100644 --- a/scheme/plt/geiser/autodoc.ss +++ b/scheme/plt/geiser/autodoc.ss @@ -46,7 +46,7 @@ (and sgn `(,id (name . ,name) - ,@(format-signature sgn) + (args ,@(format-signature sgn)) (module . ,(module-path-name->name path))))))) (define (format-signature sign) @@ -64,9 +64,7 @@ (define (find-signature path name local-name) (let ((path (if (path? path) (path->string path) path))) - (hash-ref! (hash-ref! signatures - path - (lambda () (parse-signatures path))) + (hash-ref! (hash-ref! signatures path (lambda () (parse-signatures path))) name (lambda () (infer-signature local-name))))) |