diff options
| -rw-r--r-- | elisp/geiser-autodoc.el | 16 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 4 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 12 | ||||
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 31 |
4 files changed, 52 insertions, 11 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 4e8a5bf..d6424b4 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -46,6 +46,10 @@ 'font-lock-function-name-face geiser-autodoc "highlighting procedure name in autodoc messages") +(geiser-custom--defface autodoc-optional-arg-marker + 'font-lock-keyword-face + geiser-autodoc "highlighting #:opt marker in autodoc messages") + (defcustom geiser-autodoc-delay 0.2 "Delay before autodoc messages are fetched and displayed, in seconds." :type 'number @@ -75,7 +79,8 @@ when `geiser-autodoc-display-module-p' is on." (if (equal (car geiser-autodoc--last) form) (cdr geiser-autodoc--last) (when form (let ((res (geiser-eval--send/result - `(:eval ((:ge autodoc) (quote (:scm ,form))))))) + `(:eval ((:ge autodoc) (quote (:scm ,form)))) + 500))) (when (and res (listp res)) (setq geiser-autodoc--last (cons form @@ -86,14 +91,17 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--insert-arg (arg current pos) (let ((p (point)) - (str (format "%s" (if (eq arg '\#:rest) "." arg)))) + (str (format "%s" (if (eq arg '\#:rest) "." arg))) + (face (or (and (eq '\#:opt arg) + 'geiser-font-lock-autodoc-optional-arg-marker) + (and (= current pos) + 'geiser-font-lock-autodoc-current-arg)))) (insert str) (when (listp arg) (save-excursion (replace-regexp "(quote \\(.*\\))" "'\\1" nil p (point)) (replace-string "nil" "()" t p (point)))) - (when (= current pos) - (put-text-property p (point) 'face 'geiser-font-lock-autodoc-current-arg)))) + (when face (put-text-property p (point) 'face face)))) (defsubst geiser-autodoc--proc-name (proc module) (let ((str (if module diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 9d01835..c542a66 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -132,7 +132,7 @@ REPL buffer." (apply 'make-comint-in-buffer `("Geiser REPL" ,(current-buffer) ,guile nil ,@args)) (geiser-repl--wait-for-prompt 10000) (geiser-repl--history-setup) - (geiser-con--setup-connection (current-buffer) geiser-repl--prompt-regex))) + (geiser-con--setup-connection (current-buffer) geiser-repl--prompt-regex))) (defun geiser-repl--process (&optional start) (or (and (buffer-live-p (geiser-repl--buffer)) @@ -175,7 +175,7 @@ REPL buffer." (goto-char (point-max)) (comint-kill-region comint-last-input-start (point)) (comint-redirect-cleanup) - (geiser-con--setup-connection geiser-repl--buffer)) + (geiser-con--setup-connection geiser-repl--buffer geiser-repl--prompt-regex)) ;;; geiser-repl mode: diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index e050503..01dd151 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -83,12 +83,14 @@ (when (not (eq (char-after (point)) ?\()) (skip-syntax-backward "-<>") (delete-region (point) (point-max))) - (let ((pps (parse-partial-sexp (point-min) (point)))) - (when (nth 8 pps) ;; inside a comment or string - (delete-region (nth 8 pps) (point-max)))) + (let ((p (nth 8 (syntax-ppss)))) + (when p ;; inside a comment or string + (let ((str (nth 3 (syntax-ppss)))) + (delete-region p (point-max)) + (when str (insert "XXXpointXXX"))))) (when (cond ((eq (char-after (1- (point))) ?\)) (geiser-syntax--del-sexp -1) t) ((eq (char-after (point)) ?\() (delete-region (point) (point-max)) t) - ((memq (char-after (1- (point))) (list ?. ?@ ?, ?\' ?\` ?\#)) + ((memq (char-after (1- (point))) (list ?. ?@ ?, ?\' ?\` ?\# ?\\)) (skip-syntax-backward "^-(") (delete-region (point) (point-max)) t)) @@ -101,7 +103,7 @@ (defsubst geiser-syntax--get-partial-sexp () (unless (zerop (nth 0 (syntax-ppss))) (let* ((end (if (eq (char-after (point)) ?\() (1+ (point)) - (save-excursion (skip-syntax-forward "^-()") (point)))) + (save-excursion (skip-syntax-forward "^-\"<>()") (point)))) (begin (save-excursion (beginning-of-defun) (point)))) (geiser-syntax--complete-partial-sexp (current-buffer) begin end)))) diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index e2fdaca..f446fde 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -32,6 +32,7 @@ #:use-module (system vm program) #:use-module (ice-9 session) #:use-module (ice-9 documentation) + #:use-module (ice-9 regex) #:use-module (oop goops) #:use-module (srfi srfi-1)) @@ -108,6 +109,7 @@ ((procedure-property proc 'arglist) => arglist->args) ((procedure-source proc) => source->args) ((program? proc) ((@ (system vm program) program-arguments) proc)) + ((doc->args (object-documentation proc))) ((procedure-property proc 'arity) => arity->args) (else #f))) @@ -139,6 +141,35 @@ (keyword . ,(caddr arglist)) (rest . ,(car (cddddr arglist))))) +(define (doc->args doc) + (define proc-rx "-- Scheme Procedure: ([^[\n]+)\n") + (define proc-rx2 "-- Scheme Procedure: ([^[\n]+\\[[^\n]*(\n[\n]+]+)?)") + (and doc + (let ((match (or (string-match proc-rx doc) (string-match proc-rx2 doc)))) + (and match (parse-signature-string (match:substring match 1)))))) + +(define (parse-signature-string str) + (define opt-arg-rx "\\[([^] ]+)\\]?") + (define opt-arg-rx2 "([^ ])+\\]+") + (let ((tokens (string-tokenize str))) + (if (< (length tokens) 2) + '() + (let loop ((tokens (cdr tokens)) (req '()) (opt '()) (rest #f)) + (cond ((null? tokens) `((required ,@(map string->symbol (reverse! req))) + (optional ,@(map string->symbol (reverse! opt))) + ,@(if rest + (list (cons 'rest (string->symbol rest))) + '()))) + ((string=? "." (car tokens)) + (if (not (null? (cdr tokens))) + (loop (cddr tokens) req opt (cadr tokens)) + (loop '() req opt "rest"))) + ((or (string-match opt-arg-rx (car tokens)) + (string-match opt-arg-rx2 (car tokens))) + => (lambda (m) + (loop (cdr tokens) req (cons (match:substring m 1) opt) rest))) + (else (loop (cdr tokens) (cons (car tokens) req) opt rest))))))) + (define (generic-args gen) (define (src> src1 src2) (> (length (cadr src1)) (length (cadr src2)))) |