diff options
| -rw-r--r-- | elisp/geiser-syntax.el | 40 |
1 files changed, 25 insertions, 15 deletions
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index f5d8cfa..52f0d8f 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -228,26 +228,36 @@ (defsubst geiser-syntax--pair-length (p) (if (cdr (last p)) (1+ (safe-length p)) (length p))) +(defun geiser-syntax--shallow-form (boundary) + (when (looking-at-p "\\s(") + (save-excursion + (forward-char) + (let ((elems)) + (ignore-errors + (while (< (point) boundary) + (skip-syntax-forward "-<>") + (when (<= (point) boundary) + (forward-sexp) + (let ((s (symbol-at-point))) + (when (not (eq s '.)) (push (symbol-at-point) elems)))))) + (nreverse elems))))) + (defun geiser-syntax--scan-sexps (&optional begin) - (let* ((start (point)) - (go-on t) - (fst (geiser-syntax--symbol-at-point)) + (let* ((fst (geiser-syntax--symbol-at-point)) (smth (or fst (not (looking-at-p "[\s \s)\s>\s<\n]")))) (path (and fst `((,fst 0))))) (save-excursion - (geiser-syntax--skip-comment/string) - (while (and go-on (not (zerop (geiser-syntax--nesting-level)))) - (let ((boundary (1+ (point)))) + (while (not (zerop (geiser-syntax--nesting-level))) + (let ((boundary (point))) + (geiser-syntax--skip-comment/string) (backward-up-list) - (when (setq go-on (< (- start (point)) 2000)) - (let ((form - (nth-value 0 (geiser-syntax--form-after-point boundary)))) - (when (and (listp form) (car form) (symbolp (car form))) - (let* ((len (geiser-syntax--pair-length form)) - (pos (if smth (1- len) (progn (setq smth t) len))) - (prev (and (> pos 1) (nth (1- pos) form))) - (prev (and (keywordp prev) (list prev)))) - (push `(,(car form) ,pos ,@prev) path)))))))) + (let ((form (geiser-syntax--shallow-form boundary))) + (when (and (listp form) (car form) (symbolp (car form))) + (let* ((len (geiser-syntax--pair-length form)) + (pos (if smth (1- len) (progn (setq smth t) len))) + (prev (and (> pos 1) (nth (1- pos) form))) + (prev (and (keywordp prev) (list prev)))) + (push `(,(car form) ,pos ,@prev) path))))))) (nreverse path))) (defsubst geiser-syntax--binding-form-p (bfs sbfs f) |