summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--elisp/geiser-completion.el5
-rw-r--r--elisp/geiser-syntax.el101
-rw-r--r--scheme/guile/geiser/completion.scm25
-rw-r--r--scheme/plt/geiser/completions.ss27
4 files changed, 62 insertions, 96 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index 799280e..28aef12 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -148,9 +148,8 @@ terminates a current completion."
(defsubst geiser-completion--symbol-list (prefix)
(delete-duplicates
- (geiser-eval--send/result
- `(:eval ((:ge completions) ,prefix
- (quote (:scm ,(or (geiser-syntax--get-partial-sexp) "()"))))))
+ (append (mapcar (lambda (s) (format "%s" s)) (geiser-syntax--locals-around-point))
+ (geiser-eval--send/result `(:eval ((:ge completions) ,prefix))))
:test 'string=))
(defsubst geiser-completion--module-list (prefix)
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 6cadf61..6af04a1 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -84,15 +84,11 @@
(geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode)
-(defsubst geiser-syntax--del-sexp (arg)
- (let ((p (point)))
- (forward-sexp arg)
- (delete-region p (point))))
+(defsubst geiser-syntax--skip-comment/string ()
+ (goto-char (or (nth 8 (syntax-ppss)) (point))))
-(defconst geiser-syntax--placeholder (format "___%s___" (random 100)))
-
-(defsubst geiser-syntax--beginning-of-form ()
- (memq (char-after (point)) '(?\" ?\()))
+(defsubst geiser-syntax--nesting-level ()
+ (or (nth 0 (syntax-ppss)) 0))
(defun geiser-syntax--scan-sexp ()
(let ((p (point))
@@ -112,7 +108,7 @@
(defun geiser-syntax--scan-sexps ()
(save-excursion
- (goto-char (or (nth 8 (syntax-ppss)) (point)))
+ (geiser-syntax--skip-comment/string)
(let* ((sap (symbol-at-point))
(fst (and sap (geiser-syntax--scan-sexp)))
(path (and fst
@@ -123,46 +119,55 @@
(when (listp fst) (push fst path)))
(nreverse path))))
-(defun geiser-syntax--complete-partial-sexp (buffer begin end)
- (geiser-syntax--with-buffer
- (erase-buffer)
- (insert-buffer-substring-no-properties buffer begin end)
- (when (not (geiser-syntax--beginning-of-form))
- (skip-syntax-backward "-<>")
- (delete-region (point) (point-max)))
- (let ((p (nth 8 (syntax-ppss))))
- (when p ;; inside a comment or string
- (delete-region p (point-max))
- (insert geiser-syntax--placeholder)))
- (when (cond ((eq (char-after (1- (point))) ?\))
- (geiser-syntax--del-sexp -1) t)
- ((geiser-syntax--beginning-of-form)
- (delete-region (point) (point-max)) t)
- ((memq (char-after (1- (point))) (list ?. ?@ ?, ?\' ?\` ?\# ?\\))
- (skip-syntax-backward "^-(")
- (delete-region (point) (point-max))
- t))
- (insert geiser-syntax--placeholder))
+(defun geiser-syntax--read-list (p)
+ (let ((list (ignore-errors (read (current-buffer)))))
+ (if (and list (< (point) p))
+ list
+ (goto-char p)
+ nil)))
+
+(defconst geiser-syntax--delim-regexp "\\(?:[\s-\s<\s>$\n]+\\)")
+
+(defconst geiser-syntax--ident-regexp
+ (format "\\(?:%s\\([^ (]+?\\)\\)" geiser-syntax--delim-regexp))
+
+(defconst geiser-syntax--let-regexp
+ (format "\\=(let\\(?:\\*\\|rec\\|%s\\|%s\\)%s*("
+ geiser-syntax--ident-regexp
+ geiser-syntax--delim-regexp
+ geiser-syntax--delim-regexp))
+
+(defconst geiser-syntax--ldefine-regexp
+ (format "\\=(define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp))
+
+(defconst geiser-syntax--define-regexp
+ (format "\\=(\\(?:define\\|lambda\\)%s(" geiser-syntax--delim-regexp))
+
+(defun geiser-syntax--locals-around-point ()
+ (when (eq major-mode 'scheme-mode)
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward "[.@,'`#\\\\]" nil t)
- (replace-match "" nil nil))
- (goto-char (point-min))
- (while (re-search-forward "\\[" nil t)
- (replace-match "(" nil nil))
- (goto-char (point-min))
- (while (re-search-forward "\\]" nil t)
- (replace-match ")" nil nil)))
- (let ((depth (nth 0 (parse-partial-sexp (point-min) (point)))))
- (unless (zerop depth) (insert (make-string depth ?\)))))
- (when (< (point-min) (point)) (buffer-substring (point-min) (point)))))
-
-(defsubst geiser-syntax--get-partial-sexp ()
- (unless (zerop (nth 0 (syntax-ppss)))
- (let* ((end (if (geiser-syntax--beginning-of-form) (1+ (point))
- (save-excursion (skip-syntax-forward "^-\"<>()") (point))))
- (begin (save-excursion (beginning-of-defun) (point))))
- (geiser-syntax--complete-partial-sexp (current-buffer) begin end))))
+ (geiser-syntax--skip-comment/string)
+ (let ((ids))
+ (while (not (zerop (geiser-syntax--nesting-level)))
+ (let ((p (point)))
+ (backward-up-list)
+ (save-excursion
+ (while (< (point) p)
+ (cond ((re-search-forward geiser-syntax--let-regexp p t)
+ (when (match-string 1) (push (intern (match-string 1)) ids))
+ (backward-char 1)
+ (dolist (l (nreverse (geiser-syntax--read-list p)))
+ (when (and (listp l) (symbolp (car l)))
+ (push (car l) ids))))
+ ((re-search-forward geiser-syntax--ldefine-regexp p t)
+ (when (match-string 1) (push (intern (match-string 1)) ids)))
+ ((re-search-forward geiser-syntax--define-regexp p t)
+ (backward-char 1)
+ (dolist (s (nreverse (geiser-syntax--read-list p)))
+ (let ((sn (if (listp s) (car s) s)))
+ (when (symbolp sn) (push sn ids)))))
+ (t (goto-char (1+ p))))))))
+ (nreverse ids)))))
;;; Fontify strings as Scheme code:
diff --git a/scheme/guile/geiser/completion.scm b/scheme/guile/geiser/completion.scm
index f4342bb..564b8f5 100644
--- a/scheme/guile/geiser/completion.scm
+++ b/scheme/guile/geiser/completion.scm
@@ -31,28 +31,9 @@
#:use-module (ice-9 session)
#:use-module (ice-9 regex))
-(define (completions prefix . context)
- (let ((context (and (not (null? context)) (car context)))
- (prefix (string-append "^" (regexp-quote prefix))))
- (append (filter (lambda (s) (string-match prefix s))
- (map symbol->string (local-bindings context)))
- (sort! (map symbol->string (apropos-internal prefix)) string<?))))
-
-(define (local-bindings form)
- (define (body f) (if (> (length f) 2) (cddr f) '()))
- (let loop ((form form) (bindings '()))
- (cond ((not (pair? form)) bindings)
- ((list? (car form))
- (loop (cdr form) (append (local-bindings (car form)) bindings)))
- ((and (list? form) (< (length form) 2)) bindings)
- ((memq (car form) '(define define* lambda))
- (loop (body form) (append (pair->list (cadr form)) bindings)))
- ((and (memq (car form) '(let let* letrec letrec*))
- (list? (cadr form)))
- (loop (body form) (append (map car (cadr form)) bindings)))
- ((and (eq? 'let (car form)) (symbol? (cadr form)))
- (loop (cons 'let (body form)) (cons (cadr form) bindings)))
- (else (loop (cdr form) bindings)))))
+(define (completions prefix)
+ (let ((prefix (string-append "^" (regexp-quote prefix))))
+ (sort! (map symbol->string (apropos-internal prefix)) string<?)))
(define (module-completions prefix)
(let* ((prefix (string-append "^" (regexp-quote prefix)))
diff --git a/scheme/plt/geiser/completions.ss b/scheme/plt/geiser/completions.ss
index 4537feb..15bc081 100644
--- a/scheme/plt/geiser/completions.ss
+++ b/scheme/plt/geiser/completions.ss
@@ -35,29 +35,10 @@
(filter (lambda (s) (string-prefix? prefix s))
(if sort? (sort lst string<?) lst)))
-(define (symbol-completions prefix (context #f))
- (append (filter-prefix prefix
- (map symbol->string (local-bindings context))
- #f)
- (filter-prefix prefix
- (map symbol->string (namespace-mapped-symbols))
- #t)))
-
-(define (local-bindings form)
- (define (body f) (if (> (length f) 2) (cddr f) '()))
- (let loop ((form form) (bindings '()))
- (cond ((not (pair? form)) bindings)
- ((list? (car form))
- (loop (cdr form) (append (local-bindings (car form)) bindings)))
- ((and (list? form) (< (length form) 2)) bindings)
- ((memq (car form) '(define define* lambda))
- (loop (body form) (append (pair->list (cadr form)) bindings)))
- ((and (memq (car form) '(let let* letrec letrec*))
- (list? (cadr form)))
- (loop (body form) (append (map car (cadr form)) bindings)))
- ((and (eq? 'let (car form)) (symbol? (cadr form)))
- (loop (cons 'let (body form)) (cons (cadr form) bindings)))
- (else (loop (cdr form) bindings)))))
+(define (symbol-completions prefix)
+ (filter-prefix prefix
+ (map symbol->string (namespace-mapped-symbols))
+ #t))
(define (module-completions prefix)
(filter-prefix prefix (module-list) #f))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 18:59:49 +0000