diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-completion.el | 6 | ||||
| -rw-r--r-- | elisp/geiser-racket.el | 20 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 83 |
3 files changed, 70 insertions, 39 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index 0deb76c..c63813d 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -49,10 +49,8 @@ "A list of forms introducing nested local bindings, a la let*.") (defsubst geiser-completion--locals () - (mapcar (lambda (s) (and (symbolp s) (symbol-name s))) - (geiser-syntax--locals-around-point - geiser-completion--binding-forms - geiser-completion--binding-forms*))) + (geiser-syntax--locals-around-point geiser-completion--binding-forms + geiser-completion--binding-forms*)) (defun geiser-completion--symbol-list (prefix) (geiser--del-dups diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index a349d6e..19301ce 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -84,7 +84,8 @@ This function uses `geiser-racket-init-file' if it exists." (rackdir (expand-file-name "racket/" geiser-scheme-dir))) `("-i" "-q" "-S" ,rackdir - ,@(apply 'append (mapcar (lambda (p) (list "-S" p)) geiser-racket-collects)) + ,@(apply 'append (mapcar (lambda (p) (list "-S" p)) + geiser-racket-collects)) ,@(and (listp binary) (cdr binary)) ,@(and init-file (file-readable-p init-file) (list "-f" init-file)) "-f" ,(expand-file-name "geiser/startup.rkt" rackdir)))) @@ -161,16 +162,17 @@ This function uses `geiser-racket-init-file' if it exists." (get-buffer-process (current-buffer))) (defconst geiser-racket--binding-forms - '(for for/list for/hash for/hasheq for/and for/or - for/lists for/first for/last for/fold - for: for/list: for/hash: for/hasheq: for/and: for/or: - for/lists: for/first: for/last: for/fold:)) + '("for" "for/list" "for/hash" "for/hasheq" "for/and" "for/or" + "for/lists" "for/first" "for/last" "for/fold" + "for:" "for/list:" "for/hash:" "for/hasheq:" "for/and:" "for/or:" + "for/lists:" "for/first:" "for/last:" "for/fold:" + "define-syntax-rule")) (defconst geiser-racket--binding-forms* - '(for* for*/list for*/lists for*/hash for*/hasheq for*/and - for*/or for*/first for*/last for*/fold - for*: for*/list: for*/lists: for*/hash: for*/hasheq: for*/and: - for*/or: for*/first: for*/last: for*/fold:)) + '("for*" "for*/list" "for*/lists" "for*/hash" "for*/hasheq" "for*/and" + "for*/or" "for*/first" "for*/last" "for*/fold" + "for*:" "for*/list:" "for*/lists:" "for*/hash:" "for*/hasheq:" "for*/and:" + "for*/or:" "for*/first:" "for*/last:" "for*/fold:")) ;;; External help diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index d6c6f91..8c90a7b 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -125,7 +125,7 @@ implementation-specific entries for font-lock-keywords.") (defun geiser-syntax--read/symbol () (with-syntax-table scheme-mode-syntax-table (when (re-search-forward "\\(\\sw\\|\\s_\\)+" nil t) - (make-symbol (match-string 0))))) + (make-symbol (match-string-no-properties 0))))) (defun geiser-syntax--read/matching (open close) (let ((count 1) @@ -323,64 +323,95 @@ implementation-specific entries for font-lock-keywords.") (nreverse path)))) (defsubst geiser-syntax--binding-form-p (bfs sbfs f) - (or (memq f '(define define* define-syntax define-syntax-rule - lambda let let* letrec parameterize)) - (memq f bfs) - (memq f sbfs))) + (and (symbolp f) + (let ((f (symbol-name f))) + (or (member f '("define" "define*" "define-syntax" + "syntax-rules" "lambda" "case-lambda" + "let" "let*" "letrec" "parameterize")) + (member f bfs) + (member f sbfs))))) (defsubst geiser-syntax--binding-form*-p (sbfs f) - (or (eq 'let* f) (memq f sbfs))) + (and (symbolp f) + (let ((f (symbol-name f))) + (or (member f '("let*")) + (member f sbfs))))) (defsubst geiser-syntax--if-symbol (x) (and (symbolp x) x)) (defsubst geiser-syntax--if-list (x) (and (listp x) x)) + (defsubst geiser-syntax--normalize (vars) - (mapcar (lambda (i) (if (listp i) (car i) i)) vars)) + (mapcar (lambda (i) + (let ((i (if (listp i) (car i) i))) + (and (symbolp i) (symbol-name i)))) + vars)) (defun geiser-syntax--linearize (form) (cond ((not (listp form)) (list form)) ((null form) nil) (t (cons (car form) (geiser-syntax--linearize (cdr form)))))) -(defun geiser-syntax--scan-locals (bfs sbfs form partial locals) +(defun geiser-syntax--scan-locals (bfs sbfs form partial nesting locals) (if (or (null form) (not (listp form))) (geiser-syntax--normalize locals) (if (not (geiser-syntax--binding-form-p bfs sbfs (car form))) (geiser-syntax--scan-locals bfs sbfs - (car (last form)) partial locals) + (car (last form)) + partial (1- nesting) locals) (let* ((head (car form)) (name (geiser-syntax--if-symbol (cadr form))) (names (if name (geiser-syntax--if-list (caddr form)) (geiser-syntax--if-list (cadr form)))) - (rest (if name (cdddr form) (cddr form))) - (use-names (or rest - (not partial) - (geiser-syntax--binding-form*-p sbfs - head)))) + (bns (and name + (geiser-syntax--binding-form-p bfs sbfs (car names)))) + (rest (if (and name (not bns)) (cdddr form) (cddr form))) + (use-names (and (or rest + (not partial) + (geiser-syntax--binding-form*-p sbfs head)) + (not bns)))) (when name (push name locals)) + (when (geiser-syntax--symbol-eq head 'case-lambda) + (dolist (n (and (> nesting 0) (caar (last form)))) + (when n (push n locals))) + (setq rest (and partial (cdr form))) + (setq use-names nil)) + (when (geiser-syntax--symbol-eq head 'syntax-rules) + (dolist (n (and (> nesting 0) (cdaar (last form)))) + (when n (push n locals))) + (setq rest (and partial (cdr form)))) (when use-names (dolist (n (geiser-syntax--linearize names)) - (push n locals))) + (when n (push n locals)))) (dolist (f (butlast rest)) - (when (and (listp f) (eq (car f) 'define)) + (when (and (listp f) + (geiser-syntax--symbol-eq (car f) 'define) + (cadr f)) (push (cadr f) locals))) (geiser-syntax--scan-locals bfs sbfs (car (last (or rest names))) partial + (1- nesting) locals))))) (defun geiser-syntax--locals-around-point (bfs sbfs) (when (eq major-mode 'scheme-mode) (save-excursion - (let* ((sym (unless (geiser-syntax--skip-comment/string) - (symbol-at-point))) - (boundary (point))) - (while (not (zerop (geiser-syntax--nesting-level))) - (backward-up-list)) - (multiple-value-bind (form end) - (geiser-syntax--form-after-point boundary) - (delq sym - (geiser-syntax--scan-locals bfs sbfs form - (> end boundary) '()))))))) + (let ((sym (unless (geiser-syntax--skip-comment/string) + (thing-at-point 'symbol)))) + (skip-syntax-forward "->") + (let ((boundary (point)) + (nesting (geiser-syntax--nesting-level))) + (while (not (zerop (geiser-syntax--nesting-level))) + (backward-up-list)) + (multiple-value-bind (form end) + (geiser-syntax--form-after-point boundary) + (delete sym + (geiser-syntax--scan-locals bfs + sbfs + form + (> end boundary) + (1- nesting) + '())))))))) ;;; Fontify strings as Scheme code: |